1%   File   : OCCUR.PL
2%   Author : R.A.O'Keefe
3%   Updated: 22 May 1983
4%   Purpose: routines for checking number/place of occurrence
5
6%   Some of the things in METUTL.PL may also be relevant, particularly
7%   subterm/2.  Maybe that should go here?  occ/3 in STRUCT.PL too.
8
9:- module(occur).			% SEPIA header
10:- export
11	contains/2,			%   Term x Term ->
12	freeof/2,			%   Term x Term ->
13	patharg/3,			%   Path x Term -> Term
14	position/3,			%   Term x Term -> Path
15	replace/4.			%   Path x Term x Term -> Term
16
17:- mode
18	contains(+, +),
19	copy_all_but_one_arg(+, +, +, +),
20	freeof(+, +),
21	    freeof(+, +, -),
22	patharg(+, +, ?),
23	position(?, +, ?),
24	position(+, ?, +, ?),
25	replace(+, +, +, -).
26
27
28
29%   contains(Kernel, Expression)
30%   is true when the given Kernel occurs somewhere in the Expression.
31%   It be only be used as a test; to generate subterms use subterm/2.
32
33contains(Kernel, Expression) :-
34	\+ freeof(Kernel, Expression).
35
36
37%   freeof(Kernel, Expression)
38%   is true when the given Kernel does not occur anywhere in the
39%   Expression.  NB: if the Expression contains an unbound variable,
40%   this must fail, as the Kernel might occur there.  Since there are
41%   infinitely many Kernels not contained in any Expression, and als
42%   infinitely many Expressions not containing any Kernel, it doesn't
43%   make sense to use this except as a test.
44
45freeof(Kernel, Kernel) :- !,
46	fail.
47freeof(Kernel, Expression) :-
48	functor(Expression, _, Arity),		%  can't be a variable!
49	freeof(Arity, Kernel, Expression).
50
51freeof(0, _Kernel, _Expression) :- !.
52freeof(N, Kernel, Expression) :-
53	arg(N, Expression, Argument),
54	freeof(Kernel, Argument),
55	M is N-1, !,
56	freeof(M, Kernel, Expression).
57
58
59
60%   patharg(Path, Exp, Term)
61%   unifies Term with the subterm of Exp found by following Path.
62%   It may be viewed as a generalisation of arg/3.  It cannot be
63%   used to discover a path to a known Term; use position/3 for that.
64
65patharg([Head|Tail], Exp, Term) :-
66	arg(Head, Exp, Arg),
67	patharg(Tail, Arg, Term).
68patharg([], Term, Term).
69
70
71
72%   position(Term, Exp, Path)
73%   is true when Term occurs in Exp at the position defined by Path.
74%   It may be at other places too, so the predicate is prepared to
75%   generate them all.  The path is a generalised Dewey number, as usual.
76%   position(x, 2*x^2+2*x+1=0, [1, 1, 2, 2]) {2*x} and
77%   position(x, 2*x^2+2*x+1=0, [1, 1, 1, 2, 1]) {x^2} are both examples.
78
79position(Term, Term, []).
80position(Term, Exp, Path) :-
81	nonvar(Exp),
82	functor(Exp, _, N),
83	position(N, Term, Exp, Path).
84
85position(0, _Term, _Exp, _Path) :- !, fail.
86position(N, Term, Exp, [N|Path]) :-
87	arg(N, Exp, Arg),
88	position(Term, Arg, Path).
89position(N, Term, Exp, Path) :-
90	M is N-1, !,
91	position(M, Term, Exp, Path).
92
93
94
95%   replace(Path, OldExpr, SubTerm, NewExpr)
96%   is true when OldExpr and NewExpr are identical except at the position
97%   identified by Path, where NewExpr has SubTerm.  There is a bug in the
98%   Dec-10 compiler, which is why the second 'arg' call follows the replace
99%   recursion.  If it weren't for that bug, replace would be tail recursive.
100%   replace([1,1,2,2], 2*x^2+2*x+1=0, y, 2*x^2+2*y+1=0) is an example.
101
102replace([M|Path], OldExpr, SubTerm, NewExpr) :- !,
103	arg(M, OldExpr, OldArg),
104	functor(OldExpr, F, N),
105	functor(NewExpr, F, N),
106	copy_all_but_one_arg(N, M, OldExpr, NewExpr),
107	replace(Path, OldArg, SubTerm, NewArg),
108	arg(M, NewExpr, NewArg).
109replace([], _, SubTerm, SubTerm).
110
111
112copy_all_but_one_arg(0, _, _, _) :- !.
113copy_all_but_one_arg(M, M, OldExpr, NewExpr) :- !,
114	L is M-1,
115	copy_all_but_one_arg(L, M, OldExpr, NewExpr).
116copy_all_but_one_arg(N, M, OldExpr, NewExpr) :-
117	arg(N, OldExpr, Arg),
118	arg(N, NewExpr, Arg),
119	L is N-1,
120	copy_all_but_one_arg(L, M, OldExpr, NewExpr).
121
122
123/*  Suppose you have a set of rewrite rules Lhs -> Rhs which you
124    want exhaustively applied to a term.  You would write
125
126	waterfall(Expr, Final) :-
127		Lhs -> Rhs,
128		position(Expr, Lhs, Path),
129		replace(Path, Expr, Rhs, Modified),
130		!,
131		waterfall(Modified, Final).
132	waterfall(Expr, Expr).
133
134*/
135