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]). 69 70 71/** <module> Term manipulation 72 73Compatibility library for term manipulation predicates. Most predicates 74in this library are provided as SWI-Prolog built-ins. 75 76@compat YAP, SICStus, Quintus. Not all versions of this library define 77 exactly the same set of predicates, but defined predicates are 78 compatible. 79*/ 80 81%! term_size(@Term, -Size) is det. 82% 83% True if Size is the size in _cells_ occupied by Term on the 84% global (term) stack. A _cell_ is 4 bytes on 32-bit machines and 85% 8 bytes on 64-bit machines. The calculation does take _sharing_ 86% into account. For example: 87% 88% ``` 89% ?- A = a(1,2,3), term_size(A,S). 90% S = 4. 91% ?- A = a(1,2,3), term_size(a(A,A),S). 92% S = 7. 93% ?- term_size(a(a(1,2,3), a(1,2,3)), S). 94% S = 11. 95% ``` 96% 97% Note that small objects such as atoms and small integers have a 98% size 0. Space is allocated for floats, large integers, strings 99% and compound terms. 100 101term_size(Term, Size) :- 102 '$term_size'(Term, _, Size). 103 104%! variant(@Term1, @Term2) is semidet. 105% 106% Same as SWI-Prolog =|Term1 =@= Term2|=. 107 108variant(X, Y) :- 109 X =@= Y. 110 111%! subsumes_chk(@Generic, @Specific) 112% 113% True if Generic can be made equivalent to Specific without 114% changing Specific. 115% 116% @deprecated Replace by subsumes_term/2. 117 118subsumes_chk(Generic, Specific) :- 119 subsumes_term(Generic, Specific). 120 121%! subsumes(+Generic, @Specific) 122% 123% True if Generic is unified to Specific without changing 124% Specific. 125% 126% @deprecated It turns out that calls to this predicate almost 127% always should have used subsumes_term/2. Also the name is 128% misleading. In case this is really needed, one is adviced to 129% follow subsumes_term/2 with an explicit unification. 130 131subsumes(Generic, Specific) :- 132 subsumes_term(Generic, Specific), 133 Generic = Specific. 134 135%! term_subsumer(+Special1, +Special2, -General) is det. 136% 137% General is the most specific term that is a generalisation of 138% Special1 and Special2. The implementation can handle cyclic 139% terms. 140% 141% @compat SICStus 142% @author Inspired by LOGIC.PRO by Stephen Muggleton 143 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). 182 183 184%! lgg_safe(+S1, +S2, -G, +Map0, -Map) is det. 185% 186% Cycle-safe version of the above. The difference is that we 187% insert compounds into the mapping table and check the mapping 188% table before going into a compound. 189 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). 215 216 217%! term_factorized(+Term, -Skeleton, -Substiution) 218% 219% Is true when Skeleton is Term where all subterms that appear 220% multiple times are replaced by a variable and Substitution is a 221% list of Var=Value that provides the subterm at the location Var. 222% I.e., After unifying all substitutions in Substiutions, Term == 223% Skeleton. Term may be cyclic. For example: 224% 225% == 226% ?- X = a(X), term_factorized(b(X,X), Y, S). 227% Y = b(_G255, _G255), 228% S = [_G255=a(_G255)]. 229% == 230 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). 306 307 308%! mapargs(:Goal, ?Term1, ?Term2) 309% 310% Term1 and Term2 have the same functor (name/arity) and for each 311% matching pair of arguments call(Goal, A1, A2) is true. 312 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_(_, _, _, _, _). 326 327 328%! same_functor(?Term1, ?Term2) is semidet. 329%! same_functor(?Term1, ?Term2, -Arity) is semidet. 330%! same_functor(?Term1, ?Term2, ?Name, ?Arity) is semidet. 331% 332% True when Term1 and Term2 are compound terms that have the same 333% functor (Name/Arity). The arguments must be sufficiently 334% instantiated, which means either Term1 or Term2 must be bound or 335% both Name and Arity must be bound. 336% 337% @compat SICStus 338 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 )