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-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).