% File : OCCUR.PL
% Author : R.A.O'Keefe
% Updated: 22 May 1983
% Purpose: routines for checking number/place of occurrence
% Some of the things in METUTL.PL may also be relevant, particularly
% subterm/2. Maybe that should go here? occ/3 in STRUCT.PL too.
:- public
contains/2, % Term x Term ->
freeof/2, % Term x Term ->
patharg/3, % Path x Term -> Term
position/3, % Term x Term -> Path
replace/4. % Path x Term x Term -> Term
:- mode
contains(+, +),
copy_all_but_one_arg(+, +, +, +),
freeof(+, +),
freeof(+, +, -),
patharg(+, +, ?),
position(?, +, ?),
position(+, ?, +, ?),
replace(+, +, +, -).
% contains(Kernel, Expression)
% is true when the given Kernel occurs somewhere in the Expression.
% It be only be used as a test; to generate subterms use subterm/2.
contains(Kernel, Expression) :-
\+ freeof(Kernel, Expression).
% freeof(Kernel, Expression)
% is true when the given Kernel does not occur anywhere in the
% Expression. NB: if the Expression contains an unbound variable,
% this must fail, as the Kernel might occur there. Since there are
% infinitely many Kernels not contained in any Expression, and als
% infinitely many Expressions not containing any Kernel, it doesn't
% make sense to use this except as a test.
freeof(Kernel, Kernel) :- !,
fail.
freeof(Kernel, Expression) :-
functor(Expression, _, Arity), % can't be a variable!
freeof(Arity, Kernel, Expression).
freeof(0, Kernel, Expression) :- !.
freeof(N, Kernel, Expression) :-
arg(N, Expression, Argument),
freeof(Kernel, Argument),
M is N-1, !,
freeof(M, Kernel, Expression).
% patharg(Path, Exp, Term)
% unifies Term with the subterm of Exp found by following Path.
% It may be viewed as a generalisation of arg/3. It cannot be
% used to discover a path to a known Term; use position/3 for that.
patharg([Head|Tail], Exp, Term) :-
arg(Head, Exp, Arg),
patharg(Tail, Arg, Term).
patharg([], Term, Term).
% position(Term, Exp, Path)
% is true when Term occurs in Exp at the position defined by Path.
% It may be at other places too, so the predicate is prepared to
% generate them all. The path is a generalised Dewey number, as usual.
% position(x, 2*x^2+2*x+1=0, [1, 1, 2, 2]) {2*x} and
% position(x, 2*x^2+2*x+1=0, [1, 1, 1, 2, 1]) {x^2} are both examples.
position(Term, Term, []).
position(Term, Exp, Path) :-
nonvar(Exp),
functor(Exp, _, N),
position(N, Term, Exp, Path).
position(0, Term, Exp, Path) :- !, fail.
position(N, Term, Exp, [N|Path]) :-
arg(N, Exp, Arg),
position(Term, Arg, Path).
position(N, Term, Exp, Path) :-
M is N-1, !,
position(M, Term, Exp, Path).
% replace(Path, OldExpr, SubTerm, NewExpr)
% is true when OldExpr and NewExpr are identical except at the position
% identified by Path, where NewExpr has SubTerm. There is a bug in the
% Dec-10 compiler, which is why the second 'arg' call follows the replace
% recursion. If it weren't for that bug, replace would be tail recursive.
% replace([1,1,2,2], 2*x^2+2*x+1=0, y, 2*x^2+2*y+1=0) is an example.
replace([M|Path], OldExpr, SubTerm, NewExpr) :- !,
arg(M, OldExpr, OldArg),
functor(OldExpr, F, N),
functor(NewExpr, F, N),
copy_all_but_one_arg(N, M, OldExpr, NewExpr),
replace(Path, OldArg, SubTerm, NewArg),
arg(M, NewExpr, NewArg).
replace([], _, SubTerm, SubTerm).
copy_all_but_one_arg(0, _, _, _) :- !.
copy_all_but_one_arg(M, M, OldExpr, NewExpr) :- !,
L is M-1,
copy_all_but_one_arg(L, M, OldExpr, NewExpr).
copy_all_but_one_arg(N, M, OldExpr, NewExpr) :-
arg(N, OldExpr, Arg),
arg(N, NewExpr, Arg),
L is N-1,
copy_all_but_one_arg(L, M, OldExpr, NewExpr).
/* Suppose you have a set of rewrite rules Lhs -> Rhs which you
want exhaustively applied to a term. You would write
waterfall(Expr, Final) :-
Lhs -> Rhs,
position(Expr, Lhs, Path),
replace(Path, Expr, Rhs, Modified),
!,
waterfall(Modified, Final).
waterfall(Expr, Expr).
*/