1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
|
/* $Id: rewrite.pl,v 1.2 2000/05/01 11:06:42 jan Exp $
Part of XPCE
Designed and implemented by Anjo Anjewierden and Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
Copyright (C) 2000 University of Amsterdam. All rights reserved.
*/
:- module(rewrite,
[ rewrite/2, % +Rule, +Input
rew_term_expansion/2,
rew_goal_expansion/2
]).
:- use_module(library(quintus)).
:- meta_predicate
rewrite(:, +).
:- op(1200, xfx, user:(::=)).
/*******************************
* COMPILATION *
*******************************/
rew_term_expansion((Rule ::= RuleBody), (Head :- Body)) :-
translate(RuleBody, Term, Body0),
simplify(Body0, Body),
Rule =.. List,
append(List, [Term], L2),
Head =.. L2.
rew_goal_expansion(rewrite(To, From), Goal) :-
nonvar(To),
To = \Rule,
compound(Rule),
Rule =.. List,
append(List, [From], List2),
Goal =.. List2.
/*******************************
* TOPLEVEL *
*******************************/
% rewrite(?To, +From)
%
% Invoke the term-rewriting system
rewrite(To, From) :-
'$strip_module'(To, M, T),
( var(T)
-> From = T
; T = \Rule
-> call(M:Rule, From)
; match(To, M, From)
).
match(Rule, M, From) :-
translate(Rule, From, Code),
M:Code.
translate(Var, Var, true) :-
var(Var), !.
translate(\Command, Var, Goal) :- !,
( catch(Command =.. List, _, fail)
-> append(List, [Var], L2),
Goal =.. L2
; Goal = rewrite(\Command, Var)
).
translate(Atomic, Atomic, true) :-
atomic(Atomic), !.
translate(C, _, Cmd) :-
command(C, Cmd), !.
translate((A, B), T, Code) :-
( command(A, Cmd)
-> !, translate(B, T, C),
Code = (Cmd, C)
; command(B, Cmd)
-> !, translate(A, T, C),
Code = (C, Cmd)
).
translate(Term0, Term, Command) :-
functor(Term0, Name, Arity),
functor(Term, Name, Arity),
translate_args(0, Arity, Term0, Term, Command).
translate_args(N, N, _, _, true) :- !.
translate_args(I0, Arity, T0, T1, (C0,C)) :-
I is I0 + 1,
arg(I, T0, A0),
arg(I, T1, A1),
translate(A0, A1, C0),
translate_args(I, Arity, T0, T1, C).
command(0, _) :- !, % catch variables
fail.
command({A}, A).
command(!, !).
/*******************************
* SIMPLIFY *
*******************************/
% simplify(+Raw, -Simplified)
%
% Get rid of redundant `true' goals generated by translate/3.
simplify(V, V) :-
var(V), !.
simplify((A0,B), A) :-
B == true, !,
simplify(A0, A).
simplify((A,B0), B) :-
A == true, !,
simplify(B0, B).
simplify((A0, B0), C) :- !,
simplify(A0, A),
simplify(B0, B),
( ( A \== A0
; B \== B0
)
-> simplify((A,B), C)
; C = (A,B)
).
simplify(X, X).
|