View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2019, CWI, Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(basics,
   36	  [ append/3, flatten/2, ith/3,
   37            length/2, member/2, memberchk/2, subset/2, subseq/3,
   38            reverse/2, select/3,
   39
   40            for/3,                               % ?I,+B1,+B2)
   41            between/3,
   42
   43            ground/1,
   44            copy_term/2,
   45
   46            log_ith/3, log_ith_bound/3, log_ith_new/3, log_ith_to_list/2,
   47            logk_ith/4,
   48
   49            comma_memberchk/2, abscomma_memberchk/2, comma_to_list/2,
   50            comma_length/2, comma_member/2, comma_append/3
   51	  ]).   52:- use_module(library(lists)).

XSB basics.P emulation

This module provides the XSB basics module. The implementation either simply uses SWI-Prolog built-ins and libraries or is copied from the XSB file.

license
- LGPLv2 */
   63:- license(lgpl).
 for(?I, +B1, +B2)
Nondeterministically binds I to all integer values from B1 to B2 inclusive. B1 and B2 must be integers, but either may be larger.
   70for(I, B1, B2) :-
   71    B2 >= B1,
   72    !,
   73    between(B1, B2, I).
   74for(I, B1, B2) :-
   75    End is B1 - B2,
   76    between(0, End, Diff),
   77    I is B1-Diff.
 ith(?Index, +List, ?Element)
   81ith(Index,List,Element) :-
   82    nth1(Index, List, Element).
   83
   84subseq([],[],[]).
   85subseq([H|T],[H|S],C) :- subseq(T,S,C).
   86subseq([H|T],S,[H|C]) :- subseq(T,S,C).
   87
   88log_ith(K,T,E) :-
   89	(integer(K)	% integer
   90	 ->	log_ith0(K,T,E,1)
   91	 ;	log_ith1(K,T,E,1)
   92	).
   93
   94% K is bound
   95log_ith0(K,[L|R],E,N) :-
   96	(K < N
   97	 ->	bintree0(K,L,E,N)
   98	 ;	K1 is K-N,
   99		N2 is N+N,
  100		log_ith0(K1,R,E,N2)
  101	).
  102
  103% First arg (K) is bound
  104bintree0(K,T,E,N) :-
  105	(N > 1
  106	 ->	T = [L|R],
  107		N2 is N // 2,
  108		(K < N2
  109		 ->	bintree0(K,L,E,N2)
  110		 ;	K1 is K - N2,
  111			bintree0(K1,R,E,N2)
  112		)
  113	 ;      K =:= 0,
  114		T = E
  115	).
  116
  117
  118% K is unbound
  119log_ith1(K,[L|_R],E,N) :-
  120	bintree1(K,L,E,N).
  121log_ith1(K,[_L|R],E,N) :-
  122	N1 is N + N,
  123	log_ith1(K1,R,E,N1),
  124	K is K1 + N.
  125
  126% First arg (K) is unbound
  127bintree1(0,E,E,1).
  128bintree1(K,[L|R],E,N) :-
  129	N > 1,
  130	N2 is N // 2,
  131	(bintree1(K,L,E,N2)
  132	 ;
  133	 bintree1(K1,R,E,N2),
  134	 K is K1 + N2
  135	).
  136
  137% log_ith_bound(Index,ListStr,Element) is like log_ith, but only
  138% succeeds if the Index_th element of ListStr is nonvariable and equal
  139% to Element.  This can be used in both directions, and is most useful
  140% with Index unbound, since it will then bind Index and Element for each
  141% nonvariable element in ListStr (in time proportional to N*logN, for N
  142% the number of nonvariable entries in ListStr.)
  143
  144log_ith_bound(K,T,E) :-
  145	nonvar(T),
  146	(integer(K)	% integer
  147	 ->	log_ith2(K,T,E,1)
  148	 ;	log_ith3(K,T,E,1)
  149	).
  150
  151log_ith2(K,[L|R],E,N) :-
  152	(K < N
  153	 ->	nonvar(L),bintree2(K,L,E,N)
  154	 ;	nonvar(R),
  155		K1 is K-N,
  156		N2 is N+N,
  157		log_ith2(K1,R,E,N2)
  158	).
  159
  160bintree2(0,E,E,1) :- !.
  161bintree2(K,[L|R],E,N) :-
  162	N > 1,
  163	N2 is N // 2,
  164	(K < N2
  165	 ->	nonvar(L),
  166		bintree2(K,L,E,N2)
  167	 ;	nonvar(R),
  168		K1 is K - N2,
  169		bintree2(K1,R,E,N2)
  170	).
  171
  172log_ith3(K,[L|_R],E,N) :-
  173	nonvar(L),
  174	bintree3(K,L,E,N).
  175log_ith3(K,[_L|R],E,N) :-
  176	nonvar(R),
  177	N1 is N + N,
  178	log_ith3(K1,R,E,N1),
  179	K is K1 + N.
  180
  181bintree3(0,E,E,1).
  182bintree3(K,[L|R],E,N) :-
  183	N > 1,
  184	N2 is N // 2,
  185	(nonvar(L),
  186	 bintree3(K,L,E,N2)
  187	 ;
  188	 nonvar(R),
  189	 bintree3(K1,R,E,N2),
  190	 K is K1 + N2
  191	).
  194log_ith_to_list(T,L) :- log_ith_to_list(T,0,L,[]).
  195
  196log_ith_to_list(T,K,L0,L) :-
  197	(var(T)
  198	 ->	L = L0
  199	 ;	T = [F|R],
  200		log_ith_to_list_btree(F,K,L0,L1),
  201		K1 is K+1,
  202		log_ith_to_list(R,K1,L1,L)
  203	).
  204
  205log_ith_to_list_btree(T,K,L0,L) :-
  206	(var(T)
  207	 ->	L = L0
  208	 ; K =:= 0
  209	 ->	L0 = [T|L]
  210	 ;	T = [TL|TR],
  211		K1 is K-1,
  212		log_ith_to_list_btree(TL,K1,L0,L1),
  213		log_ith_to_list_btree(TR,K1,L1,L)
  214	).
  215
  216/* log_ith_new(I,T,E) adds E to the "end" of the log_list and unifies
  217I to its index.  */
  218log_ith_new(I,T,E) :-
  219	(var(T)
  220	 ->	T = [E|_],
  221		I = 0
  222	 ;	log_ith_new_o(I,T,E,1,1)
  223	).
  224
  225log_ith_new_o(I,[L|R],E,K,NI) :-
  226	(var(R),
  227	 log_ith_new_d(I,L,E,K,NIA)
  228	 ->	I is NI + NIA - 1
  229	 ;	NNI is 2*NI,
  230		K1 is K+1,
  231		log_ith_new_o(I,R,E,K1,NNI)
  232	).
  233
  234log_ith_new_d(I,T,E,K,NIA) :-
  235	(K =< 1
  236	 ->	var(T),
  237		T=E,
  238		NIA = 0
  239	 ;	K1 is K-1,
  240		T = [L|R],
  241		(var(R),
  242		 log_ith_new_d(I,L,E,K1,NIA)
  243		 ->	true
  244		 ;	log_ith_new_d(I,R,E,K1,NNIA),
  245			NIA is NNIA + 2 ** (K1-1)
  246		)
  247	).
  248
  249
  250/* logk_ith(+KBase,+Index,?ListStr,?Element) is similar log_ith/3
  251except it uses a user specified base of KBase, which must be between 2
  252and 255.  log_ith uses binary trees with a list cons at each node;
  253logk_ith uses a term of arity KBase at each node.  KBase and Index
  254must be bound to integers. */
  255% :- mode logk_ith(+,+,?,?).
  256logk_ith(K,I,T,E) :-
  257	integer(K),
  258	integer(I),	% integer
  259	logk_ith0(K,I,T,E,K).
  260
  261% I is bound
  262logk_ith0(K,I,[L|R],E,N) :-
  263	(I < N
  264	 ->	ktree0(K,I,L,E,N)
  265	 ;	I1 is I - N,
  266		N2 is K*N,
  267		logk_ith0(K,I1,R,E,N2)
  268	).
  269
  270% First arg (I) is bound
  271ktree0(K,I,T,E,N) :-
  272	(var(T)
  273	 ->	functor(T,n,K)
  274	 ;	true
  275	),
  276	(N > K
  277	 ->	N2 is N // K,
  278		N3 is I // N2 + 1,
  279		I1 is I rem N2,  %  mod overflows?
  280		arg(N3,T,T1),
  281		ktree0(K,I1,T1,E,N2)
  282	 ;	I1 is I+1,
  283		arg(I1,T,E)
  284	).
  285
  286%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  287% Commautils.
  288%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  289
  290comma_to_list((One,Two),[One|Twol]):- !,
  291	comma_to_list(Two,Twol).
  292comma_to_list(One,[One]).
  293
  294% warning: may bind variables.
  295comma_member(A,','(A,_)).
  296comma_member(A,','(_,R)):-
  297	comma_member(A,R).
  298comma_member(A,A):- \+ (functor(A,',',2)).
  299
  300comma_memberchk(A,','(A,_)):- !.
  301comma_memberchk(A,','(_,R)):-
  302	comma_memberchk(A,R).
  303comma_memberchk(A,A):- \+ (functor(A,',',_)).
  304
  305abscomma_memberchk(A,A1):- A == A1,!.
  306abscomma_memberchk(','(A,_),A1):- A == A1,!.
  307abscomma_memberchk(','(_,R),A1):-
  308	abscomma_memberchk(R,A1).
  309
  310comma_length(','(_L,R),N1):- !,
  311	comma_length(R,N),
  312	N1 is N + 1.
  313comma_length(true,0):- !.
  314comma_length(_,1).
  315
  316comma_append(','(L,R),Cl,','(L,R1)):- !,
  317	comma_append(R,Cl,R1).
  318comma_append(true,Cl,Cl):- !.
  319comma_append(L,Cl,Out):-
  320	(Cl == true -> Out = L ; Out = ','(L,Cl))