;;;;   Term-Rewriting Rule Interpreter

(define (rule-simplifier the-rules)
  (define (simplify-expression expression)
    (let ((ssubs
	   (if (list? expression)
	       (map simplify-expression
		    expression)
	       expression)))
      (let ((result
	     (try-rules ssubs the-rules)))
	(if result
	    (simplify-expression result)
	    ssubs))))
  simplify-expression)

(define (try-rules expression the-rules)
  (define (scan rules)
    (if (null? rules)
	#f
	(or (try-a-rule (car rules)
			expression)
	    (scan (cdr rules)))))
  (scan the-rules))

(define (try-a-rule rule expression)
  (let ((dictionary
	 (match? (rule-pattern rule)
		 expression)))
    (if (and dictionary
	     (OK? (rule-restriction rule)
		  dictionary))
	(instantiate
	 (rule-skeleton rule)
	 dictionary)
	#f)))

;;; Rule syntax is determined here:

(define (rule-pattern rule)
  (car rule))

(define (rule-restriction rule)
  (cadr rule))

(define (rule-skeleton rule)
  (caddr rule))


;;; All restrictions are applications of 
;;; Scheme predicates to instantiated 
;;; skeletons, except for NONE.

(define (OK? restriction dict)
  (or (eq? restriction 'none)
      (evaluate
       (cons (car restriction)
	     (map (lambda (arg)
		    (make-quotation
		     (instantiate arg
				  dict)))
		  (cdr restriction))))))


;;; You are not supposed to know about
;;; this yet!  Hmmmmm....

(define (make-quotation expr)
  (list 'quote expr))

(define (evaluate expression)
  (eval expression
	user-initial-environment))