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)  2001-2020, University of Amsterdam
    7                              SWI-Prolog Solutions b.v.
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(occurs,
   37          [ contains_term/2,            % +SubTerm, +Term
   38            contains_var/2,             % +SubTerm, +Term
   39            free_of_term/2,             % +SubTerm, +Term
   40            free_of_var/2,              % +SubTerm, +Term
   41            occurrences_of_term/3,      % +SubTerm, +Term, ?Tally
   42            occurrences_of_var/3,       % +SubTerm, +Term, ?Tally
   43            sub_term/2,                 % -SubTerm, +Term
   44            sub_var/2,                  % -SubTerm, +Term (SWI extra)
   45            sub_term_shared_variables/3 % +Sub, +Term, -Vars
   46          ]).

Finding and counting sub-terms

This is a SWI-Prolog implementation of the corresponding Quintus library, based on the generalised arg/3 predicate of SWI-Prolog.

See also
- library(terms) provides similar predicates and is probably more wide-spread than this library. */
 contains_term(+Sub, +Term) is semidet
Succeeds if Sub is contained in Term (=, deterministically)
   61contains_term(X, X) :- !.
   62contains_term(X, Term) :-
   63    compound(Term),
   64    arg(_, Term, Arg),
   65    contains_term(X, Arg),
   66    !.
 contains_var(+Sub, +Term) is semidet
Succeeds if Sub is contained in Term (==, deterministically)
   73contains_var(X0, X1) :-
   74    X0 == X1,
   75    !.
   76contains_var(X, Term) :-
   77    compound(Term),
   78    arg(_, Term, Arg),
   79    contains_var(X, Arg),
   80    !.
 free_of_term(+Sub, +Term) is semidet
Succeeds of Sub does not unify to any subterm of Term
   86free_of_term(Sub, Term) :-
   87    \+ contains_term(Sub, Term).
 free_of_var(+Sub, +Term) is semidet
Succeeds of Sub is not equal (==) to any subterm of Term
   93free_of_var(Sub, Term) :-
   94    \+ contains_var(Sub, Term).
 occurrences_of_term(@SubTerm, @Term, ?Count) is det
Count the number of SubTerms in Term that unify with SubTerm. As this predicate is implemented using backtracking, SubTerm and Term are not further instantiated. Possible constraints are enforced. For example, we can count the integers in Term using
?- freeze(S, integer(S)), occurrences_of_term(S, f(1,2,a), C).
C = 2,
freeze(S, integer(S)).
See also
- occurrences_of_var/3 for an equality (==/2) based variant.
  109occurrences_of_term(Sub, Term, Count) :-
  110    count(sub_term(Sub, Term), Count).
 occurrences_of_var(@SubTerm, @Term, ?Count) is det
Count the number of SubTerms in Term that are equal to SubTerm. Equality is tested using ==/2. Can be used to count the occurrences of a particular variable in Term.
See also
- occurrences_of_term/3 for a unification (=/2) based variant.
  120occurrences_of_var(Sub, Term, Count) :-
  121    count(sub_var(Sub, Term), Count).
 sub_term(-Sub, +Term)
Generates (on backtracking) all subterms of Term.
  127sub_term(X, X).
  128sub_term(X, Term) :-
  129    compound(Term),
  130    arg(_, Term, Arg),
  131    sub_term(X, Arg).
 sub_var(-Sub, +Term)
Generates (on backtracking) all subterms (==) of Term.
  137sub_var(X0, X1) :-
  138    X0 == X1.
  139sub_var(X, Term) :-
  140    compound(Term),
  141    arg(_, Term, Arg),
  142    sub_var(X, Arg).
 sub_term_shared_variables(+Sub, +Term, -Vars) is det
If Sub is a sub term of Term, Vars is bound to the list of variables in Sub that also appear outside Sub in Term. Note that if Sub appears twice in Term, its variables are all considered shared.

An example use-case is refactoring a large clause body by introducing intermediate predicates. This predicate can be used to find the arguments that must be passed to the new predicate.

  155sub_term_shared_variables(Sub, Term, Vars) :-
  156    term_replace_first(Term, Sub, true, Term2),
  157    term_variables(Term2, AllVars),
  158    term_variables(Sub, SubVars),
  159    intersection_eq(SubVars, AllVars, Vars).
  160
  161term_replace_first(TermIn, From, To, TermOut) :-
  162    term_replace_(TermIn, From, To, TermOut, done(_)).
  163
  164%term_replace(TermIn, From, To, TermOut) :-
  165%    term_replace_(TermIn, From, To, TermOut, all).
 term_replace_(+From, +To, +TermIn, -TermOut, +Done)
Replace instances (==/2) of From inside TermIn by To.
  171term_replace_(TermIn, _From, _To, TermOut, done(Done)) :-
  172    Done == true,
  173    !,
  174    TermOut = TermIn.
  175term_replace_(TermIn, From, To, TermOut, Done) :-
  176    From == TermIn,
  177    !,
  178    TermOut = To,
  179    (   Done = done(Var)
  180    ->  Var = true
  181    ;   true
  182    ).
  183term_replace_(TermIn, From, To, TermOut, Done) :-
  184    compound(TermIn),
  185    compound_name_arity(TermIn, Name, Arity),
  186    Arity > 0,
  187    !,
  188    compound_name_arity(TermOut, Name, Arity),
  189    term_replace_compound(1, Arity, TermIn, From, To, TermOut, Done).
  190term_replace_(Term, _, _, Term, _).
  191
  192term_replace_compound(I, Arity, TermIn, From, To, TermOut, Done) :-
  193    I =< Arity,
  194    !,
  195    arg(I, TermIn, A1),
  196    arg(I, TermOut, A2),
  197    term_replace_(A1, From, To, A2, Done),
  198    I2 is I+1,
  199    term_replace_compound(I2, Arity, TermIn, From, To, TermOut, Done).
  200term_replace_compound(_I, _Arity, _TermIn, _From, _To, _TermOut, _).
 intersection_eq(+Small, +Big, -Shared) is det
Shared are the variables in Small that also appear in Big. The variables in Shared are in the same order as Small.
  207intersection_eq([], _, []).
  208intersection_eq([H|T0], L, List) :-
  209    (   member_eq(H, L)
  210    ->  List = [H|T],
  211        intersection_eq(T0, L, T)
  212    ;   intersection_eq(T0, L, List)
  213    ).
  214
  215member_eq(E, [H|T]) :-
  216    (   E == H
  217    ->  true
  218    ;   member_eq(E, T)
  219    ).
  220
  221
  222                 /*******************************
  223                 *              UTIL            *
  224                 *******************************/
 count(:Goal, -Count)
Count number of times Goal succeeds.
  230:- meta_predicate count(0,-).  231
  232count(Goal, Count) :-
  233    State = count(0),
  234    (   Goal,
  235        arg(1, State, N0),
  236        N is N0 + 1,
  237        nb_setarg(1, State, N),
  238        fail
  239    ;   arg(1, State, Count)
  240    )