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 same_functor/2, % ?Term1, ?Term2 52 same_functor/3, % ?Term1, ?Term2, -Arity 53 same_functor/4 % ?Term1, ?Term2, ?Name, ?Arity 54 ]). 55 56:- meta_predicate 57 mapargs( , , ). 58 59:- autoload(library(rbtrees), 60 [ rb_empty/1, 61 rb_lookup/3, 62 rb_insert/4, 63 rb_new/1, 64 rb_visit/2, 65 ord_list_to_rbtree/2, 66 rb_update/5 67 ]). 68:- 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.
101term_size(Term, Size) :-
102 '$term_size'(Term, _, Size).
Term1 =@= Term2
.
108variant(X, Y) :-
109 X =@= Y.
118subsumes_chk(Generic, Specific) :-
119 subsumes_term(Generic, Specific).
131subsumes(Generic, Specific) :-
132 subsumes_term(Generic, Specific),
133 Generic = Specific.
144% It has been rewritten by Jan Wielemaker to use the YAP-based 145% red-black-trees as mapping rather than flat lists and use arg/3 146% to map compound terms rather than univ and lists. 147 148term_subsumer(S1, S2, G) :- 149 cyclic_term(S1), 150 cyclic_term(S2), 151 !, 152 rb_empty(Map), 153 lgg_safe(S1, S2, G, Map, _). 154term_subsumer(S1, S2, G) :- 155 rb_empty(Map), 156 lgg(S1, S2, G, Map, _). 157 158lgg(S1, S2, G, Map0, Map) :- 159 ( S1 == S2 160 -> G = S1, 161 Map = Map0 162 ; compound(S1), 163 compound(S2), 164 functor(S1, Name, Arity), 165 functor(S2, Name, Arity) 166 -> functor(G, Name, Arity), 167 lgg(0, Arity, S1, S2, G, Map0, Map) 168 ; rb_lookup(S1+S2, G0, Map0) 169 -> G = G0, 170 Map = Map0 171 ; rb_insert(Map0, S1+S2, G, Map) 172 ). 173 174lgg(Arity, Arity, _, _, _, Map, Map) :- !. 175lgg(I0, Arity, S1, S2, G, Map0, Map) :- 176 I is I0 + 1, 177 arg(I, S1, Sa1), 178 arg(I, S2, Sa2), 179 arg(I, G, Ga), 180 lgg(Sa1, Sa2, Ga, Map0, Map1), 181 lgg(I, Arity, S1, S2, G, Map1, Map).
190lgg_safe(S1, S2, G, Map0, Map) :- 191 ( S1 == S2 192 -> G = S1, 193 Map = Map0 194 ; rb_lookup(S1+S2, G0, Map0) 195 -> G = G0, 196 Map = Map0 197 ; compound(S1), 198 compound(S2), 199 functor(S1, Name, Arity), 200 functor(S2, Name, Arity) 201 -> functor(G, Name, Arity), 202 rb_insert(Map0, S1+S2, G, Map1), 203 lgg_safe(0, Arity, S1, S2, G, Map1, Map) 204 ; rb_insert(Map0, S1+S2, G, Map) 205 ). 206 207lgg_safe(Arity, Arity, _, _, _, Map, Map) :- !. 208lgg_safe(I0, Arity, S1, S2, G, Map0, Map) :- 209 I is I0 + 1, 210 arg(I, S1, Sa1), 211 arg(I, S2, Sa2), 212 arg(I, G, Ga), 213 lgg_safe(Sa1, Sa2, Ga, Map0, Map1), 214 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)].
231term_factorized(Term, Skeleton, Substitutions) :- 232 rb_new(Map0), 233 add_map(Term, Map0, Map), 234 rb_visit(Map, Counts), 235 common_terms(Counts, Common), 236 ( Common == [] 237 -> Skeleton = Term, 238 Substitutions = [] 239 ; ord_list_to_rbtree(Common, SubstAssoc), 240 insert_vars(Term, Skeleton, SubstAssoc), 241 mk_subst(Common, Substitutions, SubstAssoc) 242 ). 243 244add_map(Term, Map0, Map) :- 245 ( primitive(Term) 246 -> Map = Map0 247 ; rb_update(Map0, Term, Old, New, Map) 248 -> New is Old+1 249 ; rb_insert(Map0, Term, 1, Map1), 250 assoc_arg_map(1, Term, Map1, Map) 251 ). 252 253assoc_arg_map(I, Term, Map0, Map) :- 254 arg(I, Term, Arg), 255 !, 256 add_map(Arg, Map0, Map1), 257 I2 is I + 1, 258 assoc_arg_map(I2, Term, Map1, Map). 259assoc_arg_map(_, _, Map, Map). 260 261primitive(Term) :- 262 var(Term), 263 !. 264primitive(Term) :- 265 atomic(Term), 266 !. 267primitive('$VAR'(_)). 268 269common_terms([], []). 270common_terms([H-Count|T], List) :- 271 !, 272 ( Count == 1 273 -> common_terms(T, List) 274 ; List = [H-_NewVar|Tail], 275 common_terms(T, Tail) 276 ). 277 278insert_vars(T0, T, _) :- 279 primitive(T0), 280 !, 281 T = T0. 282insert_vars(T0, T, Subst) :- 283 rb_lookup(T0, S, Subst), 284 !, 285 T = S. 286insert_vars(T0, T, Subst) :- 287 functor(T0, Name, Arity), 288 functor(T, Name, Arity), 289 insert_arg_vars(1, T0, T, Subst). 290 291insert_arg_vars(I, T0, T, Subst) :- 292 arg(I, T0, A0), 293 !, 294 arg(I, T, A), 295 insert_vars(A0, A, Subst), 296 I2 is I + 1, 297 insert_arg_vars(I2, T0, T, Subst). 298insert_arg_vars(_, _, _, _). 299 300mk_subst([], [], _). 301mk_subst([Val0-Var|T0], [Var=Val|T], Subst) :- 302 functor(Val0, Name, Arity), 303 functor(Val, Name, Arity), 304 insert_arg_vars(1, Val0, Val, Subst), 305 mk_subst(T0, T, Subst).
call(Goal, A1, A2)
is true.313mapargs(Goal, Term1, Term2) :- 314 same_functor(Term1, Term2, Arity), 315 mapargs_(1, Arity, Goal, Term1, Term2). 316 317mapargs_(I, Arity, Goal, Term1, Term2) :- 318 I =< Arity, 319 !, 320 arg(I, Term1, A1), 321 arg(I, Term2, A2), 322 call(Goal, A1, A2), 323 I2 is I+1, 324 mapargs_(I2, Arity, Goal, Term1, Term2). 325mapargs_(_, _, _, _, _).
339same_functor(Term1, Term2) :- 340 same_functor(Term1, Term2, _Name, _Arity). 341 342same_functor(Term1, Term2, Arity) :- 343 same_functor(Term1, Term2, _Name, Arity). 344 345same_functor(Term1, Term2, Name, Arity) :- 346 ( nonvar(Term1) 347 -> compound_name_arity(Term1, Name, Arity), 348 compound_name_arity(Term2, Name, Arity) 349 ; nonvar(Term2) 350 -> compound_name_arity(Term2, Name, Arity), 351 compound_name_arity(Term1, Name, Arity) 352 ; nonvar(Name), 353 nonvar(Arity) 354 -> compound_name_arity(Term1, Name, Arity), 355 compound_name_arity(Term2, Name, Arity) 356 ; instantiation_error(Term1) 357 )
Term manipulation
Compatibility library for term manipulation predicates. Most predicates in this library are provided as SWI-Prolog built-ins.