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

82ith(Index,List,Element) :- 83 nth1(Index, List, Element). 84 85log_ith(K,T,E) :- 86 (integer(K) % integer 87 -> log_ith0(K,T,E,1) 88 ; log_ith1(K,T,E,1) 89 ). 90 91% K is bound 92log_ith0(K,[L|R],E,N) :- 93 (K < N 94 -> bintree0(K,L,E,N) 95 ; K1 is K-N, 96 N2 is N+N, 97 log_ith0(K1,R,E,N2) 98 ). 99 100% First arg (K) is bound 101bintree0(K,T,E,N) :- 102 (N > 1 103 -> T = [L|R], 104 N2 is N // 2, 105 (K < N2 106 -> bintree0(K,L,E,N2) 107 ; K1 is K - N2, 108 bintree0(K1,R,E,N2) 109 ) 110 ; K =:= 0, 111 T = E 112 ). 113 114 115% K is unbound 116log_ith1(K,[L|_R],E,N) :- 117 bintree1(K,L,E,N). 118log_ith1(K,[_L|R],E,N) :- 119 N1 is N + N, 120 log_ith1(K1,R,E,N1), 121 K is K1 + N. 122 123% First arg (K) is unbound 124bintree1(0,E,E,1). 125bintree1(K,[L|R],E,N) :- 126 N > 1, 127 N2 is N // 2, 128 (bintree1(K,L,E,N2) 129 ; 130 bintree1(K1,R,E,N2), 131 K is K1 + N2 132 ). 133 134% log_ith_bound(Index,ListStr,Element) is like log_ith, but only 135% succeeds if the Index_th element of ListStr is nonvariable and equal 136% to Element. This can be used in both directions, and is most useful 137% with Index unbound, since it will then bind Index and Element for each 138% nonvariable element in ListStr (in time proportional to N*logN, for N 139% the number of nonvariable entries in ListStr.) 140 141log_ith_bound(K,T,E) :- 142 nonvar(T), 143 (integer(K) % integer 144 -> log_ith2(K,T,E,1) 145 ; log_ith3(K,T,E,1) 146 ). 147 148log_ith2(K,[L|R],E,N) :- 149 (K < N 150 -> nonvar(L),bintree2(K,L,E,N) 151 ; nonvar(R), 152 K1 is K-N, 153 N2 is N+N, 154 log_ith2(K1,R,E,N2) 155 ). 156 157bintree2(0,E,E,1) :- !. 158bintree2(K,[L|R],E,N) :- 159 N > 1, 160 N2 is N // 2, 161 (K < N2 162 -> nonvar(L), 163 bintree2(K,L,E,N2) 164 ; nonvar(R), 165 K1 is K - N2, 166 bintree2(K1,R,E,N2) 167 ). 168 169log_ith3(K,[L|_R],E,N) :- 170 nonvar(L), 171 bintree3(K,L,E,N). 172log_ith3(K,[_L|R],E,N) :- 173 nonvar(R), 174 N1 is N + N, 175 log_ith3(K1,R,E,N1), 176 K is K1 + N. 177 178bintree3(0,E,E,1). 179bintree3(K,[L|R],E,N) :- 180 N > 1, 181 N2 is N // 2, 182 (nonvar(L), 183 bintree3(K,L,E,N2) 184 ; 185 nonvar(R), 186 bintree3(K1,R,E,N2), 187 K is K1 + N2 188 ).

191log_ith_to_list(T,L) :- log_ith_to_list(T,0,L,[]). 192 193log_ith_to_list(T,K,L0,L) :- 194 (var(T) 195 -> L = L0 196 ; T = [F|R], 197 log_ith_to_list_btree(F,K,L0,L1), 198 K1 is K+1, 199 log_ith_to_list(R,K1,L1,L) 200 ). 201 202log_ith_to_list_btree(T,K,L0,L) :- 203 (var(T) 204 -> L = L0 205 ; K =:= 0 206 -> L0 = [T|L] 207 ; T = [TL|TR], 208 K1 is K-1, 209 log_ith_to_list_btree(TL,K1,L0,L1), 210 log_ith_to_list_btree(TR,K1,L1,L) 211 ). 212 213/* log_ith_new(I,T,E) adds E to the "end" of the log_list and unifies 214I to its index. */ 215log_ith_new(I,T,E) :- 216 (var(T) 217 -> T = [E|_], 218 I = 0 219 ; log_ith_new_o(I,T,E,1,1) 220 ). 221 222log_ith_new_o(I,[L|R],E,K,NI) :- 223 (var(R), 224 log_ith_new_d(I,L,E,K,NIA) 225 -> I is NI + NIA - 1 226 ; NNI is 2*NI, 227 K1 is K+1, 228 log_ith_new_o(I,R,E,K1,NNI) 229 ). 230 231log_ith_new_d(I,T,E,K,NIA) :- 232 (K =< 1 233 -> var(T), 234 T=E, 235 NIA = 0 236 ; K1 is K-1, 237 T = [L|R], 238 (var(R), 239 log_ith_new_d(I,L,E,K1,NIA) 240 -> true 241 ; log_ith_new_d(I,R,E,K1,NNIA), 242 NIA is NNIA + 2 ** (K1-1) 243 ) 244 ). 245 246 247/* logk_ith(+KBase,+Index,?ListStr,?Element) is similar log_ith/3 248except it uses a user specified base of KBase, which must be between 2 249and 255. log_ith uses binary trees with a list cons at each node; 250logk_ith uses a term of arity KBase at each node. KBase and Index 251must be bound to integers. */ 252% :- mode logk_ith(+,+,?,?). 253logk_ith(K,I,T,E) :- 254 integer(K), 255 integer(I), % integer 256 logk_ith0(K,I,T,E,K). 257 258% I is bound 259logk_ith0(K,I,[L|R],E,N) :- 260 (I < N 261 -> ktree0(K,I,L,E,N) 262 ; I1 is I - N, 263 N2 is K*N, 264 logk_ith0(K,I1,R,E,N2) 265 ). 266 267% First arg (I) is bound 268ktree0(K,I,T,E,N) :- 269 (var(T) 270 -> functor(T,n,K) 271 ; true 272 ), 273 (N > K 274 -> N2 is N // K, 275 N3 is I // N2 + 1, 276 I1 is I rem N2, % mod overflows? 277 arg(N3,T,T1), 278 ktree0(K,I1,T1,E,N2) 279 ; I1 is I+1, 280 arg(I1,T,E) 281 ). 282 283%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 284% Commautils. 285%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 286 287comma_to_list((One,Two),[One|Twol]):- !, 288 comma_to_list(Two,Twol). 289comma_to_list(One,[One]). 290 291% warning: may bind variables. 292comma_member(A,','(A,_)). 293comma_member(A,','(_,R)):- 294 comma_member(A,R). 295comma_member(A,A):- \+ (functor(A,',',2)). 296 297comma_memberchk(A,','(A,_)):- !. 298comma_memberchk(A,','(_,R)):- 299 comma_memberchk(A,R). 300comma_memberchk(A,A):- \+ (functor(A,',',_)). 301 302abscomma_memberchk(A,A1):- A == A1,!. 303abscomma_memberchk(','(A,_),A1):- A == A1,!. 304abscomma_memberchk(','(_,R),A1):- 305 abscomma_memberchk(R,A1). 306 307comma_length(','(_L,R),N1):- !, 308 comma_length(R,N), 309 N1 is N + 1. 310comma_length(true,0):- !. 311comma_length(_,1). 312 313comma_append(','(L,R),Cl,','(L,R1)):- !, 314 comma_append(R,Cl,R1). 315comma_append(true,Cl,Cl):- !. 316comma_append(L,Cl,Out):- 317 (Cl == true -> Out = L ; Out = ','(L,Cl))

XSB basics.P emulation

XSB `basics.P` emulation