;;;; Match and Substitution Language Interpreter

(declare (usual-integrations))

(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))))
  (rule-memoize simplify-expression))

(define (try-rules expression the-rules)
  (define (scan rules)
    (if (null? rules)
	#f
	(or ((car rules) expression)
	    (scan (cdr rules)))))
  (scan the-rules))

;;;;  Rule applicator, using combinator-based matcher.

(define (rule:make matcher restriction instantiator)
  (define (the-rule expression)
    (matcher (list expression)
	     '()
	     (lambda (dictionary n)
	       (and (= n 1)
		    (let
			((args
			  (map match:value dictionary)))
		      (and (or (not restriction)
			       (apply restriction args))
			   (apply instantiator args)))))))
    the-rule)