1/* Part of SWI-Prolog 2 3 Author: David Warren and Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 2019-2024, 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 This module is based on the XSB ``basics.P`` module, licensed under 36 LGPLv2. The SWI-Prolog port has been re-licensed under BSD-2 with 37 permission from David Warren, Sep 11, 2024. 38*/ 39 40:- module(basics, 41 [ append/3, flatten/2, ith/3, 42 length/2, member/2, memberchk/2, subset/2, 43 reverse/2, select/3, 44 45 for/3, % ?I,+B1,+B2) 46 between/3, 47 48 ground/1, 49 copy_term/2, 50 copy_term_nat/2, 51 52 log_ith/3, log_ith_bound/3, log_ith_new/3, log_ith_to_list/2, 53 logk_ith/4, 54 55 comma_memberchk/2, abscomma_memberchk/2, comma_to_list/2, 56 comma_length/2, comma_member/2, comma_append/3 57 ]). 58:- 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. */

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

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

XSB basics.P emulation

XSB `basics.P` emulation