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) 2008-2020, University of Amsterdam, 7 VU University 8 SWI-Prolog Solutions b.v. 9 Amsterdam All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(terms, 38 [ term_hash/2, % @Term, -HashKey 39 term_hash/4, % @Term, +Depth, +Range, -HashKey 40 term_size/2, % @Term, -Size 41 term_variables/2, % @Term, -Variables 42 term_variables/3, % @Term, -Variables, +Tail 43 variant/2, % @Term1, @Term2 44 subsumes/2, % +Generic, @Specific 45 subsumes_chk/2, % +Generic, @Specific 46 cyclic_term/1, % @Term 47 acyclic_term/1, % @Term 48 term_subsumer/3, % +Special1, +Special2, -General 49 term_factorized/3, % +Term, -Skeleton, -Subsitution 50 mapargs/3, % :Goal, ?Term1, ?Term2 51 mapsubterms/3, % :Goal, ?Term1, ?Term2 52 same_functor/2, % ?Term1, ?Term2 53 same_functor/3, % ?Term1, ?Term2, -Arity 54 same_functor/4 % ?Term1, ?Term2, ?Name, ?Arity 55 ]). 56 57:- meta_predicate 58 mapargs(,,), 59 mapsubterms(,,). 60 61:- autoload(library(rbtrees), 62 [ rb_empty/1, 63 rb_lookup/3, 64 rb_insert/4, 65 rb_new/1, 66 rb_visit/2, 67 ord_list_to_rbtree/2, 68 rb_update/5 69 ]). 70:- autoload(library(error), [instantiation_error/1]). 71 72 73/** <module> Term manipulation 74 75Compatibility library for term manipulation predicates. Most predicates 76in this library are provided as SWI-Prolog built-ins. 77 78@compat YAP, SICStus, Quintus. Not all versions of this library define 79 exactly the same set of predicates, but defined predicates are 80 compatible. 81*/ 82 83%! term_size(@Term, -Size) is det. 84% 85% True if Size is the size in _cells_ occupied by Term on the 86% global (term) stack. A _cell_ is 4 bytes on 32-bit machines and 87% 8 bytes on 64-bit machines. The calculation does take _sharing_ 88% into account. For example: 89% 90% ``` 91% ?- A = a(1,2,3), term_size(A,S). 92% S = 4. 93% ?- A = a(1,2,3), term_size(a(A,A),S). 94% S = 7. 95% ?- term_size(a(a(1,2,3), a(1,2,3)), S). 96% S = 11. 97% ``` 98% 99% Note that small objects such as atoms and small integers have a 100% size 0. Space is allocated for floats, large integers, strings 101% and compound terms. 102 103term_size(Term, Size) :- 104 '$term_size'(Term, _, Size). 105 106%! variant(@Term1, @Term2) is semidet. 107% 108% Same as SWI-Prolog =|Term1 =@= Term2|=. 109 110variant(X, Y) :- 111 X =@= Y. 112 113%! subsumes_chk(@Generic, @Specific) 114% 115% True if Generic can be made equivalent to Specific without 116% changing Specific. 117% 118% @deprecated Replace by subsumes_term/2. 119 120subsumes_chk(Generic, Specific) :- 121 subsumes_term(Generic, Specific). 122 123%! subsumes(+Generic, @Specific) 124% 125% True if Generic is unified to Specific without changing 126% Specific. 127% 128% @deprecated It turns out that calls to this predicate almost 129% always should have used subsumes_term/2. Also the name is 130% misleading. In case this is really needed, one is adviced to 131% follow subsumes_term/2 with an explicit unification. 132 133subsumes(Generic, Specific) :- 134 subsumes_term(Generic, Specific), 135 Generic = Specific. 136 137%! term_subsumer(+Special1, +Special2, -General) is det. 138% 139% General is the most specific term that is a generalisation of 140% Special1 and Special2. The implementation can handle cyclic 141% terms. 142% 143% @compat SICStus 144% @author Inspired by LOGIC.PRO by Stephen Muggleton 145 146% It has been rewritten by Jan Wielemaker to use the YAP-based 147% red-black-trees as mapping rather than flat lists and use arg/3 148% to map compound terms rather than univ and lists. 149 150term_subsumer(S1, S2, G) :- 151 cyclic_term(S1), 152 cyclic_term(S2), 153 !, 154 rb_empty(Map), 155 lgg_safe(S1, S2, G, Map, _). 156term_subsumer(S1, S2, G) :- 157 rb_empty(Map), 158 lgg(S1, S2, G, Map, _). 159 160lgg(S1, S2, G, Map0, Map) :- 161 ( S1 == S2 162 -> G = S1, 163 Map = Map0 164 ; compound(S1), 165 compound(S2), 166 functor(S1, Name, Arity), 167 functor(S2, Name, Arity) 168 -> functor(G, Name, Arity), 169 lgg(0, Arity, S1, S2, G, Map0, Map) 170 ; rb_lookup(S1+S2, G0, Map0) 171 -> G = G0, 172 Map = Map0 173 ; rb_insert(Map0, S1+S2, G, Map) 174 ). 175 176lgg(Arity, Arity, _, _, _, Map, Map) :- !. 177lgg(I0, Arity, S1, S2, G, Map0, Map) :- 178 I is I0 + 1, 179 arg(I, S1, Sa1), 180 arg(I, S2, Sa2), 181 arg(I, G, Ga), 182 lgg(Sa1, Sa2, Ga, Map0, Map1), 183 lgg(I, Arity, S1, S2, G, Map1, Map). 184 185 186%! lgg_safe(+S1, +S2, -G, +Map0, -Map) is det. 187% 188% Cycle-safe version of the above. The difference is that we 189% insert compounds into the mapping table and check the mapping 190% table before going into a compound. 191 192lgg_safe(S1, S2, G, Map0, Map) :- 193 ( S1 == S2 194 -> G = S1, 195 Map = Map0 196 ; rb_lookup(S1+S2, G0, Map0) 197 -> G = G0, 198 Map = Map0 199 ; compound(S1), 200 compound(S2), 201 functor(S1, Name, Arity), 202 functor(S2, Name, Arity) 203 -> functor(G, Name, Arity), 204 rb_insert(Map0, S1+S2, G, Map1), 205 lgg_safe(0, Arity, S1, S2, G, Map1, Map) 206 ; rb_insert(Map0, S1+S2, G, Map) 207 ). 208 209lgg_safe(Arity, Arity, _, _, _, Map, Map) :- !. 210lgg_safe(I0, Arity, S1, S2, G, Map0, Map) :- 211 I is I0 + 1, 212 arg(I, S1, Sa1), 213 arg(I, S2, Sa2), 214 arg(I, G, Ga), 215 lgg_safe(Sa1, Sa2, Ga, Map0, Map1), 216 lgg_safe(I, Arity, S1, S2, G, Map1, Map). 217 218 219%! term_factorized(+Term, -Skeleton, -Substiution) 220% 221% Is true when Skeleton is Term where all subterms that appear 222% multiple times are replaced by a variable and Substitution is a 223% list of Var=Value that provides the subterm at the location Var. 224% I.e., After unifying all substitutions in Substiutions, Term == 225% Skeleton. Term may be cyclic. For example: 226% 227% == 228% ?- X = a(X), term_factorized(b(X,X), Y, S). 229% Y = b(_G255, _G255), 230% S = [_G255=a(_G255)]. 231% == 232 233term_factorized(Term, Skeleton, Substitutions) :- 234 rb_new(Map0), 235 add_map(Term, Map0, Map), 236 rb_visit(Map, Counts), 237 common_terms(Counts, Common), 238 ( Common == [] 239 -> Skeleton = Term, 240 Substitutions = [] 241 ; ord_list_to_rbtree(Common, SubstAssoc), 242 insert_vars(Term, Skeleton, SubstAssoc), 243 mk_subst(Common, Substitutions, SubstAssoc) 244 ). 245 246add_map(Term, Map0, Map) :- 247 ( primitive(Term) 248 -> Map = Map0 249 ; rb_update(Map0, Term, Old, New, Map) 250 -> New is Old+1 251 ; rb_insert(Map0, Term, 1, Map1), 252 assoc_arg_map(1, Term, Map1, Map) 253 ). 254 255assoc_arg_map(I, Term, Map0, Map) :- 256 arg(I, Term, Arg), 257 !, 258 add_map(Arg, Map0, Map1), 259 I2 is I + 1, 260 assoc_arg_map(I2, Term, Map1, Map). 261assoc_arg_map(_, _, Map, Map). 262 263primitive(Term) :- 264 var(Term), 265 !. 266primitive(Term) :- 267 atomic(Term), 268 !. 269primitive('$VAR'(_)). 270 271common_terms([], []). 272common_terms([H-Count|T], List) :- 273 !, 274 ( Count == 1 275 -> common_terms(T, List) 276 ; List = [H-_NewVar|Tail], 277 common_terms(T, Tail) 278 ). 279 280insert_vars(T0, T, _) :- 281 primitive(T0), 282 !, 283 T = T0. 284insert_vars(T0, T, Subst) :- 285 rb_lookup(T0, S, Subst), 286 !, 287 T = S. 288insert_vars(T0, T, Subst) :- 289 functor(T0, Name, Arity), 290 functor(T, Name, Arity), 291 insert_arg_vars(1, T0, T, Subst). 292 293insert_arg_vars(I, T0, T, Subst) :- 294 arg(I, T0, A0), 295 !, 296 arg(I, T, A), 297 insert_vars(A0, A, Subst), 298 I2 is I + 1, 299 insert_arg_vars(I2, T0, T, Subst). 300insert_arg_vars(_, _, _, _). 301 302mk_subst([], [], _). 303mk_subst([Val0-Var|T0], [Var=Val|T], Subst) :- 304 functor(Val0, Name, Arity), 305 functor(Val, Name, Arity), 306 insert_arg_vars(1, Val0, Val, Subst), 307 mk_subst(T0, T, Subst). 308 309 310%! mapargs(:Goal, ?Term1, ?Term2) 311% 312% Term1 and Term2 have the same functor (name/arity) and for each 313% matching pair of arguments call(Goal, A1, A2) is true. 314 315mapargs(Goal, Term1, Term2) :- 316 same_functor(Term1, Term2, Arity), 317 mapargs_(1, Arity, Goal, Term1, Term2). 318 319mapargs_(I, Arity, Goal, Term1, Term2) :- 320 I =< Arity, 321 !, 322 arg(I, Term1, A1), 323 arg(I, Term2, A2), 324 call(Goal, A1, A2), 325 I2 is I+1, 326 mapargs_(I2, Arity, Goal, Term1, Term2). 327mapargs_(_, _, _, _, _). 328 329 330%! mapsubterms(:Goal, +Term1, -Term2) is det. 331% 332% Recursively map sub terms of Term1 into subterms of Term2 for every 333% pair for which call(Goal, ST1, ST2) succeeds. Procedurably, the 334% mapping for each (sub) term pair `T1/T2` is defined as: 335% 336% - If `T1` is a variable, Unify `T2` with `T1`. 337% - If call(Goal, T1, T2) succeeds we are done. Note that the 338% mapping does not continue in `T2`. If this is desired, `Goal` 339% must call mapsubterms/3 explicitly as part of it conversion. 340% - If `T1` is a dict, map all values, i.e., the _tag_ and _keys_ 341% are left untouched. 342% - If `T1` is a list, map all elements, i.e., the list structure 343% is left untouched. 344% - If `T1` is a compound, use same_functor/3 to instantiate `T2` 345% and recurse over the term arguments left to right. 346% - Otherwise `T2` is unified with `T1`. 347 348mapsubterms(_Goal, Term1, Term2) :- 349 var(Term1), 350 !, 351 Term2 = Term1. 352mapsubterms(Goal, Term1, Term2) :- 353 call(Goal, Term1, Term2), 354 !. 355mapsubterms(Goal, Term1, Term2) :- 356 is_dict(Term1), 357 !, 358 dict_pairs(Term1, Tag, Pairs1), 359 map_dict_pairs(Pairs1, Pairs2, Goal), 360 dict_pairs(Term2, Tag, Pairs2). 361mapsubterms(Goal, Term1, Term2) :- 362 is_list(Term1), 363 !, 364 map_list_terms(Term1, Term2, Goal). 365mapsubterms(Goal, Term1, Term2) :- 366 compound(Term1), 367 !, 368 same_functor(Term1, Term2, Arity), 369 mapsubterms_(1, Arity, Goal, Term1, Term2). 370mapsubterms(_, Term, Term). 371 372map_dict_pairs([], [], _). 373map_dict_pairs([K-V0|T0], [K-V|T], Goal) :- 374 mapsubterms(Goal, V0, V), 375 map_dict_pairs(T0, T, Goal). 376 377map_list_terms([], [], _Goal). 378map_list_terms([H0|T0], [H|T], Goal) :- 379 mapsubterms(Goal, H0, H), 380 map_list_terms(T0, T, Goal). 381 382mapsubterms_(I, Arity, Goal, Term1, Term2) :- 383 I =< Arity, 384 !, 385 arg(I, Term1, A1), 386 arg(I, Term2, A2), 387 mapsubterms(Goal, A1, A2), 388 I2 is I+1, 389 mapsubterms_(I2, Arity, Goal, Term1, Term2). 390mapsubterms_(_, _, _, _, _). 391 392 393%! same_functor(?Term1, ?Term2) is semidet. 394%! same_functor(?Term1, ?Term2, -Arity) is semidet. 395%! same_functor(?Term1, ?Term2, ?Name, ?Arity) is semidet. 396% 397% True when Term1 and Term2 are terms that have the same functor 398% (Name/Arity). The arguments must be sufficiently instantiated, which 399% means either Term1 or Term2 must be bound or both Name and Arity 400% must be bound. 401% 402% If Arity is 0, Term1 and Term2 are unified with Name for 403% compatibility. 404% 405% @compat SICStus 406 407same_functor(Term1, Term2) :- 408 same_functor(Term1, Term2, _Name, _Arity). 409 410same_functor(Term1, Term2, Arity) :- 411 same_functor(Term1, Term2, _Name, Arity). 412 413same_functor(Term1, Term2, Name, Arity) :- 414 ( nonvar(Term1) 415 -> functor(Term1, Name, Arity, Type), 416 functor(Term2, Name, Arity, Type) 417 ; nonvar(Term2) 418 -> functor(Term2, Name, Arity, Type), 419 functor(Term1, Name, Arity, Type) 420 ; functor(Term2, Name, Arity), 421 functor(Term1, Name, Arity) 422 )