View source with formatted 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-2022, 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            mapsubterms_var/3,          % :Goal, ?Term1, ?Term2
   53            foldsubterms/4,             % :Goal, +Term, +State0, -State
   54            foldsubterms/5,             % :Goal, +Term1, ?Term2, +State0, -State
   55            same_functor/2,             % ?Term1, ?Term2
   56            same_functor/3,             % ?Term1, ?Term2, -Arity
   57            same_functor/4              % ?Term1, ?Term2, ?Name, ?Arity
   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
   79/** <module> Term manipulation
   80
   81Compatibility library for term manipulation  predicates. Most predicates
   82in this library are provided as SWI-Prolog built-ins.
   83
   84@compat YAP, SICStus, Quintus.  Not all versions of this library define
   85        exactly the same set of predicates, but defined predicates are
   86        compatible.
   87*/
   88
   89%!  term_size(@Term, -Size) is det.
   90%
   91%   True if Size is the size  in   _cells_  occupied  by Term on the
   92%   global (term) stack. A _cell_ is 4  bytes on 32-bit machines and
   93%   8 bytes on 64-bit machines. The  calculation does take _sharing_
   94%   into account. For example:
   95%
   96%   ```
   97%   ?- A = a(1,2,3), term_size(A,S).
   98%   S = 4.
   99%   ?- A = a(1,2,3), term_size(a(A,A),S).
  100%   S = 7.
  101%   ?- term_size(a(a(1,2,3), a(1,2,3)), S).
  102%   S = 11.
  103%   ```
  104%
  105%   Note that small objects such as atoms  and small integers have a
  106%   size 0. Space is allocated for   floats, large integers, strings
  107%   and compound terms.
  108
  109term_size(Term, Size) :-
  110    '$term_size'(Term, _, Size).
  111
  112%!  variant(@Term1, @Term2) is semidet.
  113%
  114%   Same as SWI-Prolog =|Term1 =@= Term2|=.
  115
  116variant(X, Y) :-
  117    X =@= Y.
  118
  119%!  subsumes_chk(@Generic, @Specific)
  120%
  121%   True if Generic can be made equivalent to Specific without
  122%   changing Specific.
  123%
  124%   @deprecated Replace by subsumes_term/2.
  125
  126subsumes_chk(Generic, Specific) :-
  127    subsumes_term(Generic, Specific).
  128
  129%!  subsumes(+Generic, @Specific)
  130%
  131%   True  if  Generic  is  unified   to  Specific  without  changing
  132%   Specific.
  133%
  134%   @deprecated It turns out that calls to this predicate almost
  135%   always should have used subsumes_term/2.  Also the name is
  136%   misleading.  In case this is really needed, one is adviced to
  137%   follow subsumes_term/2 with an explicit unification.
  138
  139subsumes(Generic, Specific) :-
  140    subsumes_term(Generic, Specific),
  141    Generic = Specific.
  142
  143%!  term_subsumer(+Special1, +Special2, -General) is det.
  144%
  145%   General is the most specific term   that  is a generalisation of
  146%   Special1 and Special2. The  implementation   can  handle  cyclic
  147%   terms.
  148%
  149%   @compat SICStus
  150%   @author Inspired by LOGIC.PRO by Stephen Muggleton
  151
  152%       It has been rewritten by  Jan   Wielemaker  to use the YAP-based
  153%       red-black-trees as mapping rather than flat  lists and use arg/3
  154%       to map compound terms rather than univ and lists.
  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
  192%!  lgg_safe(+S1, +S2, -G, +Map0, -Map) is det.
  193%
  194%   Cycle-safe version of the  above.  The   difference  is  that we
  195%   insert compounds into the mapping table   and  check the mapping
  196%   table before going into a compound.
  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
  225%!  term_factorized(+Term, -Skeleton, -Substiution)
  226%
  227%   Is true when Skeleton is  Term   where  all subterms that appear
  228%   multiple times are replaced by a  variable and Substitution is a
  229%   list of Var=Value that provides the subterm at the location Var.
  230%   I.e., After unifying all substitutions  in Substiutions, Term ==
  231%   Skeleton. Term may be cyclic. For example:
  232%
  233%     ==
  234%     ?- X = a(X), term_factorized(b(X,X), Y, S).
  235%     Y = b(_G255, _G255),
  236%     S = [_G255=a(_G255)].
  237%     ==
  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
  316%!  mapargs(:Goal, ?Term1, ?Term2)
  317%
  318%   Term1 and Term2 have the  same   functor  (name/arity)  and for each
  319%   matching pair of arguments call(Goal, A1, A2) is true.
  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
  336%!  mapsubterms(:Goal, +Term1, -Term2) is det.
  337%!  mapsubterms_var(:Goal, +Term1, -Term2) is det.
  338%
  339%   Recursively map sub terms of Term1 into  subterms of Term2 for every
  340%   pair for which call(Goal,  ST1,   ST2)  succeeds.  Procedurably, the
  341%   mapping for each (sub) term pair `T1/T2` is defined as:
  342%
  343%     - If `T1` is a variable
  344%       - mapsubterms/3 unifies `T2` with `T1`.
  345%       - mapsubterms_var/3 treats variables as other terms.
  346%     - If call(Goal, T1, T2) succeeds we are done.  Note that the
  347%       mapping does not continue in `T2`.  If this is desired, `Goal`
  348%       must call mapsubterms/3 explicitly as part of its conversion.
  349%     - If `T1` is a dict, map all values, i.e., the _tag_ and _keys_
  350%       are left untouched.
  351%     - If `T1` is a list, map all elements, i.e., the list structure
  352%       is left untouched.
  353%     - If `T1` is a compound, use same_functor/3 to instantiate `T2`
  354%       and recurse over the term arguments left to right.
  355%     - Otherwise `T2` is unified with `T1`.
  356%
  357%   Both predicates are implemented using foldsubterms/5.
  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
  371%!  foldsubterms(:Goal3, +Term1, +State0, -State) is semidet.
  372%!  foldsubterms(:Goal4, +Term1, ?Term2, +State0, -State) is semidet.
  373%
  374%   The predicate foldsubterms/5 calls   call(Goal4, SubTerm1, SubTerm2,
  375%   StateIn, StateOut) for each subterm,  including variables, in Term1.
  376%   If this call fails, `StateIn`  and   `StateOut`  are  the same. This
  377%   predicate may be used to map  subterms   in  a term while collecting
  378%   state about the mapped subterms. The foldsubterms/4 variant does not
  379%   map the term.
  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
  428%!  same_functor(?Term1, ?Term2) is semidet.
  429%!  same_functor(?Term1, ?Term2, -Arity) is semidet.
  430%!  same_functor(?Term1, ?Term2, ?Name, ?Arity) is semidet.
  431%
  432%   True when Term1 and Term2  are  terms   that  have  the same functor
  433%   (Name/Arity). The arguments must be sufficiently instantiated, which
  434%   means either Term1 or Term2 must  be   bound  or both Name and Arity
  435%   must be bound.
  436%
  437%   If  Arity  is  0,  Term1  and  Term2   are  unified  with  Name  for
  438%   compatibility.
  439%
  440%   @compat SICStus
  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    )