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]).
?- A = a(1,2,3), term_size(A,S). S = 4. ?- A = a(1,2,3), term_size(a(A,A),S). S = 7. ?- term_size(a(a(1,2,3), a(1,2,3)), S). S = 11.
Note that small objects such as atoms and small integers have a size 0. Space is allocated for floats, large integers, strings and compound terms.
103term_size(Term, Size) :-
104 '$term_size'(Term, _, Size).
Term1 =@= Term2
. 110variant(X, Y) :-
111 X =@= Y.
120subsumes_chk(Generic, Specific) :-
121 subsumes_term(Generic, Specific).
133subsumes(Generic, Specific) :-
134 subsumes_term(Generic, Specific),
135 Generic = Specific.
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).
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).
?- X = a(X), term_factorized(b(X,X), Y, S). Y = b(_G255, _G255), S = [_G255=a(_G255)].
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).
call(Goal, A1, A2)
is true.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_(_, _, _, _, _).
call(Goal, ST1, ST2)
succeeds. Procedurably, the
mapping for each (sub) term pair T1/T2
is defined as:
call(Goal, T1, T2)
succeeds we are done. Note that the
mapping does not continue in T2. If this is desired, Goal
must call mapsubterms/3 explicitly as part of it conversion.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_(_, _, _, _, _).
If Arity is 0, Term1 and Term2 are unified with Name for compatibility.
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 )
Term manipulation
Compatibility library for term manipulation predicates. Most predicates in this library are provided as SWI-Prolog built-ins.