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