;; interp5.scm

;; added make-extended-env

(load "record.ss")

(define-record lit (datum))
(define-record varref (var))
(define-record lambda (formals body))
(define-record app (rator rands))

(define find-lexical-address-ONE
  (lambda (e cenv)
    (letrec
      ((find-lexical-address
	 (lambda (cenv)
	   (cond
	     ((eq? (car cenv) e)
	      0)
	     (else
	       (+ 1 (find-lexical-address (cdr cenv))))))))
      (find-lexical-address cenv))))

(define little-lookup
  (lambda (item item-list match-list)
    (list-ref match-list
      (find-lexical-address-ONE item item-list))))


(define apply-env
  (lambda (env sym)
    (env sym)))
     
(define make-extended-env
  (lambda (formals args env)
    (lambda (sym)
      (if (memq sym formals)
	  (little-lookup sym formals args)
	  (apply-env env sym)))))

(define global-table
  (let ((apply* (lambda (args)
		  (* (car args) (cadr args))))
	(apply+ (lambda (args)
		  (+ (car args) (cadr args))))
	(apply-cons (lambda (args)
		      (cons (car args) (cadr args))))
	(apply-car (lambda (args)
		      (car (car args))))
	(apply-cdr (lambda (args)
		      (cdr (car args)))))
    (lambda (sym)
      (case sym
	((cons) apply-cons)
	((car) apply-car)
	((cdr) apply-cdr)
	((X) 10)
	((V) 5)
	((D) 500)
	((C) 100)
	((I) 1)
	((M) 1000)
	((*) apply*)
	((+) apply+)
	(else 
	  (error 'global-table "unbound variable: ~s" sym))))))
	  

(define eval-exp
  (letrec
    ((eval-exp
       (lambda (e env)
	 (variant-case e
	   (lit (datum) datum)
	   (varref (var) (apply-env env var))
	   (app (rator rands)
	     ((eval-exp rator env)
	      (map (lambda (x)
		     (eval-exp x env))
		rands)))
	   (lambda (formals body)
	     (lambda (args)
	       (eval-exp body
		 (make-extended-env
		   formals args env))))
	   )))

     (parse-exp
       (lambda (e)
	 (cond
	   ((number? e) (make-lit e))
	   ((atom? e) (make-varref e))
	   ((and (list? e)		; a cheap hack
		 (eq? (car e) 'lambda))
	    (make-lambda (cadr e)	; formals
	      (parse-exp (caddr e))))	; body

	   (else			; else application
	     (make-app (parse-exp (car e)) ; operator
	       (map parse-exp (cdr e))))))))
    (lambda (e env) 
      (eval-exp (parse-exp e) env))))