;;;; 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))))
  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 #!optional continue)
    (if (default-object? continue)
	(set! continue (lambda (x) x)))
    (matcher (list expression)
	     '()
	     (lambda (dictionary n)
	       (and (= n 1)
		    (let
			((args
			  (map (lambda (entry)
				 (match:expression-value (match:value entry)
							 dictionary))
			       (filter (lambda (entry)
					 (not (match:unknown? (car entry))))
				       dictionary))))
		      (and (or (not restriction)
			       (apply restriction args))
			   (continue (apply instantiator args))))))))
    the-rule)