(load "subst.ss")

(define reduce-1
  (lambda (exp lambda-proc)
    (variant-case exp
      (varref (var) exp)
      (lambda (formals body) (lambda-proc formals body))
      (app (operator operands)
	(let ((rator (reduce-1 operator make-lambda)))
	  (variant-case rator
	    (lambda (formals body)
	      (reduce-1 (subst* (map cons formals operands) body) lambda-proc))
	    (else
	      (make-app rator
		(map (lambda (x) (reduce-1 x lambda-proc)) operands))))))
      (else (error 'reduce-1 "invalid abstract tree ~s" exp)))))

(define reduce
  (lambda (x)
    (reduce-1 x (lambda (fs bd) (make-lambda fs (reduce bd))))))