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 */

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))

XSB basics.P emulation

XSB `basics.P` emulation