View source with raw comments or as raw
    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(2,?,?),
   59    mapsubterms(2,?,?).   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]).

Term manipulation

Compatibility library for term manipulation predicates. Most predicates in this library are provided as SWI-Prolog built-ins.

Compatibility
- YAP, SICStus, Quintus. Not all versions of this library define exactly the same set of predicates, but defined predicates are compatible. */
 term_size(@Term, -Size) is det
True if Size is the size in cells occupied by Term on the global (term) stack. A cell is 4 bytes on 32-bit machines and 8 bytes on 64-bit machines. The calculation does take sharing into account. For example:
?- 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).
 variant(@Term1, @Term2) is semidet
Same as SWI-Prolog Term1 =@= Term2.
  110variant(X, Y) :-
  111    X =@= Y.
 subsumes_chk(@Generic, @Specific)
True if Generic can be made equivalent to Specific without changing Specific.
deprecated
- Replace by subsumes_term/2.
  120subsumes_chk(Generic, Specific) :-
  121    subsumes_term(Generic, Specific).
 subsumes(+Generic, @Specific)
True if Generic is unified to Specific without changing Specific.
deprecated
- It turns out that calls to this predicate almost always should have used subsumes_term/2. Also the name is misleading. In case this is really needed, one is adviced to follow subsumes_term/2 with an explicit unification.
  133subsumes(Generic, Specific) :-
  134    subsumes_term(Generic, Specific),
  135    Generic = Specific.
 term_subsumer(+Special1, +Special2, -General) is det
General is the most specific term that is a generalisation of Special1 and Special2. The implementation can handle cyclic terms.
author
- Inspired by LOGIC.PRO by Stephen Muggleton
Compatibility
- SICStus
  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).
 lgg_safe(+S1, +S2, -G, +Map0, -Map) is det
Cycle-safe version of the above. The difference is that we insert compounds into the mapping table and check the mapping table before going into a compound.
  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).
 term_factorized(+Term, -Skeleton, -Substiution)
Is true when Skeleton is Term where all subterms that appear multiple times are replaced by a variable and Substitution is a list of Var=Value that provides the subterm at the location Var. I.e., After unifying all substitutions in Substiutions, Term == Skeleton. Term may be cyclic. For example:
?- 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).
 mapargs(:Goal, ?Term1, ?Term2)
Term1 and Term2 have the same functor (name/arity) and for each matching pair of arguments 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_(_, _, _, _, _).
 mapsubterms(:Goal, +Term1, -Term2) is det
Recursively map sub terms of Term1 into subterms of Term2 for every pair for which call(Goal, ST1, ST2) succeeds. Procedurably, the mapping for each (sub) term pair T1/T2 is defined as:
  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_(_, _, _, _, _).
 same_functor(?Term1, ?Term2) is semidet
 same_functor(?Term1, ?Term2, -Arity) is semidet
 same_functor(?Term1, ?Term2, ?Name, ?Arity) is semidet
True when Term1 and Term2 are terms that have the same functor (Name/Arity). The arguments must be sufficiently instantiated, which means either Term1 or Term2 must be bound or both Name and Arity must be bound.

If Arity is 0, Term1 and Term2 are unified with Name for compatibility.

Compatibility
- SICStus
  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    )