36
37:- module(terms,
38 [ term_hash/2, 39 term_hash/4, 40 term_size/2, 41 term_variables/2, 42 term_variables/3, 43 variant/2, 44 subsumes/2, 45 subsumes_chk/2, 46 cyclic_term/1, 47 acyclic_term/1, 48 term_subsumer/3, 49 term_factorized/3, 50 mapargs/3, 51 mapsubterms/3, 52 mapsubterms_var/3, 53 foldsubterms/4, 54 foldsubterms/5, 55 same_functor/2, 56 same_functor/3, 57 same_functor/4 58 ]). 59
60:- meta_predicate
61 mapargs(2,?,?),
62 mapsubterms(2,?,?),
63 mapsubterms_var(2,?,?),
64 foldsubterms(3,+,+,-),
65 foldsubterms(4,+,?,+,-). 66
67:- autoload(library(rbtrees),
68 [ rb_empty/1,
69 rb_lookup/3,
70 rb_insert/4,
71 rb_new/1,
72 rb_visit/2,
73 ord_list_to_rbtree/2,
74 rb_update/5
75 ]). 76:- autoload(library(error), [instantiation_error/1]). 77
78
88
108
109term_size(Term, Size) :-
110 '$term_size'(Term, _, Size).
111
115
116variant(X, Y) :-
117 X =@= Y.
118
125
126subsumes_chk(Generic, Specific) :-
127 subsumes_term(Generic, Specific).
128
138
139subsumes(Generic, Specific) :-
140 subsumes_term(Generic, Specific),
141 Generic = Specific.
142
151
155
156term_subsumer(S1, S2, G) :-
157 cyclic_term(S1),
158 cyclic_term(S2),
159 !,
160 rb_empty(Map),
161 lgg_safe(S1, S2, G, Map, _).
162term_subsumer(S1, S2, G) :-
163 rb_empty(Map),
164 lgg(S1, S2, G, Map, _).
165
166lgg(S1, S2, G, Map0, Map) :-
167 ( S1 == S2
168 -> G = S1,
169 Map = Map0
170 ; compound(S1),
171 compound(S2),
172 functor(S1, Name, Arity),
173 functor(S2, Name, Arity)
174 -> functor(G, Name, Arity),
175 lgg(0, Arity, S1, S2, G, Map0, Map)
176 ; rb_lookup(S1+S2, G0, Map0)
177 -> G = G0,
178 Map = Map0
179 ; rb_insert(Map0, S1+S2, G, Map)
180 ).
181
182lgg(Arity, Arity, _, _, _, Map, Map) :- !.
183lgg(I0, Arity, S1, S2, G, Map0, Map) :-
184 I is I0 + 1,
185 arg(I, S1, Sa1),
186 arg(I, S2, Sa2),
187 arg(I, G, Ga),
188 lgg(Sa1, Sa2, Ga, Map0, Map1),
189 lgg(I, Arity, S1, S2, G, Map1, Map).
190
191
197
198lgg_safe(S1, S2, G, Map0, Map) :-
199 ( S1 == S2
200 -> G = S1,
201 Map = Map0
202 ; rb_lookup(S1+S2, G0, Map0)
203 -> G = G0,
204 Map = Map0
205 ; compound(S1),
206 compound(S2),
207 functor(S1, Name, Arity),
208 functor(S2, Name, Arity)
209 -> functor(G, Name, Arity),
210 rb_insert(Map0, S1+S2, G, Map1),
211 lgg_safe(0, Arity, S1, S2, G, Map1, Map)
212 ; rb_insert(Map0, S1+S2, G, Map)
213 ).
214
215lgg_safe(Arity, Arity, _, _, _, Map, Map) :- !.
216lgg_safe(I0, Arity, S1, S2, G, Map0, Map) :-
217 I is I0 + 1,
218 arg(I, S1, Sa1),
219 arg(I, S2, Sa2),
220 arg(I, G, Ga),
221 lgg_safe(Sa1, Sa2, Ga, Map0, Map1),
222 lgg_safe(I, Arity, S1, S2, G, Map1, Map).
223
224
238
239term_factorized(Term, Skeleton, Substitutions) :-
240 rb_new(Map0),
241 add_map(Term, Map0, Map),
242 rb_visit(Map, Counts),
243 common_terms(Counts, Common),
244 ( Common == []
245 -> Skeleton = Term,
246 Substitutions = []
247 ; ord_list_to_rbtree(Common, SubstAssoc),
248 insert_vars(Term, Skeleton, SubstAssoc),
249 mk_subst(Common, Substitutions, SubstAssoc)
250 ).
251
252add_map(Term, Map0, Map) :-
253 ( primitive(Term)
254 -> Map = Map0
255 ; rb_update(Map0, Term, Old, New, Map)
256 -> New is Old+1
257 ; rb_insert(Map0, Term, 1, Map1),
258 assoc_arg_map(1, Term, Map1, Map)
259 ).
260
261assoc_arg_map(I, Term, Map0, Map) :-
262 arg(I, Term, Arg),
263 !,
264 add_map(Arg, Map0, Map1),
265 I2 is I + 1,
266 assoc_arg_map(I2, Term, Map1, Map).
267assoc_arg_map(_, _, Map, Map).
268
269primitive(Term) :-
270 var(Term),
271 !.
272primitive(Term) :-
273 atomic(Term),
274 !.
275primitive('$VAR'(_)).
276
277common_terms([], []).
278common_terms([H-Count|T], List) :-
279 !,
280 ( Count == 1
281 -> common_terms(T, List)
282 ; List = [H-_NewVar|Tail],
283 common_terms(T, Tail)
284 ).
285
286insert_vars(T0, T, _) :-
287 primitive(T0),
288 !,
289 T = T0.
290insert_vars(T0, T, Subst) :-
291 rb_lookup(T0, S, Subst),
292 !,
293 T = S.
294insert_vars(T0, T, Subst) :-
295 functor(T0, Name, Arity),
296 functor(T, Name, Arity),
297 insert_arg_vars(1, T0, T, Subst).
298
299insert_arg_vars(I, T0, T, Subst) :-
300 arg(I, T0, A0),
301 !,
302 arg(I, T, A),
303 insert_vars(A0, A, Subst),
304 I2 is I + 1,
305 insert_arg_vars(I2, T0, T, Subst).
306insert_arg_vars(_, _, _, _).
307
308mk_subst([], [], _).
309mk_subst([Val0-Var|T0], [Var=Val|T], Subst) :-
310 functor(Val0, Name, Arity),
311 functor(Val, Name, Arity),
312 insert_arg_vars(1, Val0, Val, Subst),
313 mk_subst(T0, T, Subst).
314
315
320
321mapargs(Goal, Term1, Term2) :-
322 same_functor(Term1, Term2, Arity),
323 mapargs_(1, Arity, Goal, Term1, Term2).
324
325mapargs_(I, Arity, Goal, Term1, Term2) :-
326 I =< Arity,
327 !,
328 arg(I, Term1, A1),
329 arg(I, Term2, A2),
330 call(Goal, A1, A2),
331 I2 is I+1,
332 mapargs_(I2, Arity, Goal, Term1, Term2).
333mapargs_(_, _, _, _, _).
334
335
358
359mapsubterms(Goal, Term1, Term2) :-
360 foldsubterms(map2(Goal), Term1, Term2, _, _).
361mapsubterms_var(Goal, Term1, Term2) :-
362 foldsubterms(map2_var(Goal), Term1, Term2, _, _).
363
364map2(Goal, Term1, Term2, _, _) :-
365 nonvar(Term1),
366 call(Goal, Term1, Term2).
367
368map2_var(Goal, Term1, Term2, _, _) :-
369 call(Goal, Term1, Term2).
370
380
381foldsubterms(Goal, Term1, State0, State) :-
382 foldsubterms(fold1(Goal), Term1, _, State0, State).
383
384fold1(Goal, Term1, _Term2, State0, State) :-
385 call(Goal, Term1, State0, State).
386
387foldsubterms(Goal, Term1, Term2, State0, State) :-
388 call(Goal, Term1, Term2, State0, State),
389 !.
390foldsubterms(Goal, Term1, Term2, State0, State) :-
391 is_dict(Term1),
392 !,
393 dict_pairs(Term1, Tag, Pairs1),
394 fold_dict_pairs(Pairs1, Pairs2, Goal, State0, State),
395 dict_pairs(Term2, Tag, Pairs2).
396foldsubterms(Goal, Term1, Term2, State0, State) :-
397 is_list(Term1),
398 !,
399 fold_some(Term1, Term2, Goal, State0, State).
400foldsubterms(Goal, Term1, Term2, State0, State) :-
401 compound(Term1),
402 !,
403 same_functor(Term1, Term2, Arity),
404 foldsubterms_(1, Arity, Goal, Term1, Term2, State0, State).
405foldsubterms(_, Term, Term, State, State).
406
407fold_dict_pairs([], [], _, State, State).
408fold_dict_pairs([K-V0|T0], [K-V|T], Goal, State0, State) :-
409 foldsubterms(Goal, V0, V, State0, State1),
410 fold_dict_pairs(T0, T, Goal, State1, State).
411
412fold_some([], [], _, State, State).
413fold_some([H0|T0], [H|T], Goal, State0, State) :-
414 foldsubterms(Goal, H0, H, State0, State1),
415 fold_some(T0, T, Goal, State1, State).
416
417foldsubterms_(I, Arity, Goal, Term1, Term2, State0, State) :-
418 I =< Arity,
419 !,
420 arg(I, Term1, A1),
421 arg(I, Term2, A2),
422 foldsubterms(Goal, A1, A2, State0, State1),
423 I2 is I+1,
424 foldsubterms_(I2, Arity, Goal, Term1, Term2, State1, State).
425foldsubterms_(_, _, _, _, _, State, State).
426
427
441
442same_functor(Term1, Term2) :-
443 same_functor(Term1, Term2, _Name, _Arity).
444
445same_functor(Term1, Term2, Arity) :-
446 same_functor(Term1, Term2, _Name, Arity).
447
448same_functor(Term1, Term2, Name, Arity) :-
449 ( nonvar(Term1)
450 -> functor(Term1, Name, Arity, Type),
451 functor(Term2, Name, Arity, Type)
452 ; nonvar(Term2)
453 -> functor(Term2, Name, Arity, Type),
454 functor(Term1, Name, Arity, Type)
455 ; functor(Term2, Name, Arity),
456 functor(Term1, Name, Arity)
457 )