145 lines
		
	
	
		
			2.9 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
		
		
			
		
	
	
			145 lines
		
	
	
		
			2.9 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
|   | /*  $Id$ | ||
|  | 
 | ||
|  |     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, !)) :- !, | ||
|  | 	(   callable(Command), | ||
|  | 	    Command =.. List | ||
|  | 	->  append(List, [Var], L2), | ||
|  | 	    Goal =.. L2 | ||
|  | 	;   Goal = rewrite(\Command, Var) | ||
|  | 	). | ||
|  | translate(\Command, Var, Goal) :- !, | ||
|  | 	(   callable(Command), | ||
|  | 	    Command =.. List | ||
|  | 	->  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). | ||
|  | 
 | ||
|  | 		 /******************************* | ||
|  | 		 *	       XREF		* | ||
|  | 		 *******************************/ | ||
|  | 
 | ||
|  | :- multifile | ||
|  | 	prolog:called_by/2. | ||
|  | 
 | ||
|  | prolog:called_by(rewrite(Spec, _Term), Called) :- | ||
|  | 	findall(G+1, sub_term(\G, Spec), Called). |