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-2016, University of Amsterdam, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(terms, 36 [ term_hash/2, % @Term, -HashKey 37 term_hash/4, % @Term, +Depth, +Range, -HashKey 38 term_size/2, % @Term, -Size 39 term_variables/2, % @Term, -Variables 40 term_variables/3, % @Term, -Variables, +Tail 41 variant/2, % @Term1, @Term2 42 subsumes/2, % +Generic, @Specific 43 subsumes_chk/2, % +Generic, @Specific 44 cyclic_term/1, % @Term 45 acyclic_term/1, % @Term 46 term_subsumer/3, % +Special1, +Special2, -General 47 term_factorized/3 % +Term, -Skeleton, -Subsitution 48 ]). 49:- use_module(library(rbtrees)). 50 51/** <module> Term manipulation 52 53Compatibility library for term manipulation predicates. Most predicates 54in this library are provided as SWI-Prolog built-ins. 55 56@compat YAP, SICStus, Quintus. Not all versions of this library define 57 exactly the same set of predicates, but defined predicates are 58 compatible. 59*/ 60 61%! term_size(@Term, -Size) is det. 62% 63% True if Size is the size in _cells_ occupied by Term on the 64% global (term) stack. A _cell_ is 4 bytes on 32-bit machines and 65% 8 bytes on 64-bit machines. The calculation does take _sharing_ 66% into account. For example: 67% 68% ``` 69% ?- A = a(1,2,3), term_size(A,S). 70% S = 4. 71% ?- A = a(1,2,3), term_size(a(A,A),S). 72% S = 7. 73% ?- term_size(a(a(1,2,3), a(1,2,3)), S). 74% S = 11. 75% ``` 76% 77% Note that small objects such as atoms and small integers have a 78% size 0. Space is allocated for floats, large integers, strings 79% and compound terms. 80 81term_size(Term, Size) :- 82 '$term_size'(Term, _, Size). 83 84%! variant(@Term1, @Term2) is semidet. 85% 86% Same as SWI-Prolog =|Term1 =@= Term2|=. 87 88variant(X, Y) :- 89 X =@= Y. 90 91%! subsumes_chk(@Generic, @Specific) 92% 93% True if Generic can be made equivalent to Specific without 94% changing Specific. 95% 96% @deprecated Replace by subsumes_term/2. 97 98subsumes_chk(Generic, Specific) :- 99 subsumes_term(Generic, Specific). 100 101%! subsumes(+Generic, @Specific) 102% 103% True if Generic is unified to Specific without changing 104% Specific. 105% 106% @deprecated It turns out that calls to this predicate almost 107% always should have used subsumes_term/2. Also the name is 108% misleading. In case this is really needed, one is adviced to 109% follow subsumes_term/2 with an explicit unification. 110 111subsumes(Generic, Specific) :- 112 subsumes_term(Generic, Specific), 113 Generic = Specific. 114 115%! term_subsumer(+Special1, +Special2, -General) is det. 116% 117% General is the most specific term that is a generalisation of 118% Special1 and Special2. The implementation can handle cyclic 119% terms. 120% 121% @compat SICStus 122% @author Inspired by LOGIC.PRO by Stephen Muggleton 123 124% It has been rewritten by Jan Wielemaker to use the YAP-based 125% red-black-trees as mapping rather than flat lists and use arg/3 126% to map compound terms rather than univ and lists. 127 128term_subsumer(S1, S2, G) :- 129 cyclic_term(S1), 130 cyclic_term(S2), 131 !, 132 rb_empty(Map), 133 lgg_safe(S1, S2, G, Map, _). 134term_subsumer(S1, S2, G) :- 135 rb_empty(Map), 136 lgg(S1, S2, G, Map, _). 137 138lgg(S1, S2, G, Map0, Map) :- 139 ( S1 == S2 140 -> G = S1, 141 Map = Map0 142 ; compound(S1), 143 compound(S2), 144 functor(S1, Name, Arity), 145 functor(S2, Name, Arity) 146 -> functor(G, Name, Arity), 147 lgg(0, Arity, S1, S2, G, Map0, Map) 148 ; rb_lookup(S1+S2, G0, Map0) 149 -> G = G0, 150 Map = Map0 151 ; rb_insert(Map0, S1+S2, G, Map) 152 ). 153 154lgg(Arity, Arity, _, _, _, Map, Map) :- !. 155lgg(I0, Arity, S1, S2, G, Map0, Map) :- 156 I is I0 + 1, 157 arg(I, S1, Sa1), 158 arg(I, S2, Sa2), 159 arg(I, G, Ga), 160 lgg(Sa1, Sa2, Ga, Map0, Map1), 161 lgg(I, Arity, S1, S2, G, Map1, Map). 162 163 164%! lgg_safe(+S1, +S2, -G, +Map0, -Map) is det. 165% 166% Cycle-safe version of the above. The difference is that we 167% insert compounds into the mapping table and check the mapping 168% table before going into a compound. 169 170lgg_safe(S1, S2, G, Map0, Map) :- 171 ( S1 == S2 172 -> G = S1, 173 Map = Map0 174 ; rb_lookup(S1+S2, G0, Map0) 175 -> G = G0, 176 Map = Map0 177 ; compound(S1), 178 compound(S2), 179 functor(S1, Name, Arity), 180 functor(S2, Name, Arity) 181 -> functor(G, Name, Arity), 182 rb_insert(Map0, S1+S2, G, Map1), 183 lgg_safe(0, Arity, S1, S2, G, Map1, Map) 184 ; rb_insert(Map0, S1+S2, G, Map) 185 ). 186 187lgg_safe(Arity, Arity, _, _, _, Map, Map) :- !. 188lgg_safe(I0, Arity, S1, S2, G, Map0, Map) :- 189 I is I0 + 1, 190 arg(I, S1, Sa1), 191 arg(I, S2, Sa2), 192 arg(I, G, Ga), 193 lgg_safe(Sa1, Sa2, Ga, Map0, Map1), 194 lgg_safe(I, Arity, S1, S2, G, Map1, Map). 195 196 197%! term_factorized(+Term, -Skeleton, -Substiution) 198% 199% Is true when Skeleton is Term where all subterms that appear 200% multiple times are replaced by a variable and Substitution is a 201% list of Var=Value that provides the subterm at the location Var. 202% I.e., After unifying all substitutions in Substiutions, Term == 203% Skeleton. Term may be cyclic. For example: 204% 205% == 206% ?- X = a(X), term_factorized(b(X,X), Y, S). 207% Y = b(_G255, _G255), 208% S = [_G255=a(_G255)]. 209% == 210 211term_factorized(Term, Skeleton, Substitutions) :- 212 rb_new(Map0), 213 add_map(Term, Map0, Map), 214 rb_visit(Map, Counts), 215 common_terms(Counts, Common), 216 ( Common == [] 217 -> Skeleton = Term, 218 Substitutions = [] 219 ; ord_list_to_rbtree(Common, SubstAssoc), 220 insert_vars(Term, Skeleton, SubstAssoc), 221 mk_subst(Common, Substitutions, SubstAssoc) 222 ). 223 224add_map(Term, Map0, Map) :- 225 ( primitive(Term) 226 -> Map = Map0 227 ; rb_update(Map0, Term, Old, New, Map) 228 -> New is Old+1 229 ; rb_insert(Map0, Term, 1, Map1), 230 assoc_arg_map(1, Term, Map1, Map) 231 ). 232 233assoc_arg_map(I, Term, Map0, Map) :- 234 arg(I, Term, Arg), 235 !, 236 add_map(Arg, Map0, Map1), 237 I2 is I + 1, 238 assoc_arg_map(I2, Term, Map1, Map). 239assoc_arg_map(_, _, Map, Map). 240 241primitive(Term) :- 242 var(Term), 243 !. 244primitive(Term) :- 245 atomic(Term), 246 !. 247primitive('$VAR'(_)). 248 249common_terms([], []). 250common_terms([H-Count|T], List) :- 251 !, 252 ( Count == 1 253 -> common_terms(T, List) 254 ; List = [H-_NewVar|Tail], 255 common_terms(T, Tail) 256 ). 257 258insert_vars(T0, T, _) :- 259 primitive(T0), 260 !, 261 T = T0. 262insert_vars(T0, T, Subst) :- 263 rb_lookup(T0, S, Subst), 264 !, 265 T = S. 266insert_vars(T0, T, Subst) :- 267 functor(T0, Name, Arity), 268 functor(T, Name, Arity), 269 insert_arg_vars(1, T0, T, Subst). 270 271insert_arg_vars(I, T0, T, Subst) :- 272 arg(I, T0, A0), 273 !, 274 arg(I, T, A), 275 insert_vars(A0, A, Subst), 276 I2 is I + 1, 277 insert_arg_vars(I2, T0, T, Subst). 278insert_arg_vars(_, _, _, _). 279 280mk_subst([], [], _). 281mk_subst([Val0-Var|T0], [Var=Val|T], Subst) :- 282 functor(Val0, Name, Arity), 283 functor(Val, Name, Arity), 284 insert_arg_vars(1, Val0, Val, Subst), 285 mk_subst(T0, T, Subst)