; LC interpreter that uses lists of pair to represent environments and 
; structs to represent closures

; AR ::= (make-var symbol) | (make-const integer) | (make-proc var AR) |
;        (make-app (AR AR)

(require-library "core.ss")

(define-struct var (name))
(define-struct const (number))
(define-struct proc (param body))
(define-struct app (rator rand))
(define-struct add (left right))

(define-struct pair (name val))
(define-struct closure (body env))

(define Eval
  (lambda (M env)
    (cond
      ((var? M) (lookup (var-name M) env))
      ((const? M) M)
      ((proc? M) (make-closure M env))
      ((add? M) (add (Eval (add-left M) env) (Eval (add-right M) env)))
      (else (Apply (Eval (app-rator M) env) (Eval (app-rand M) env))))))
         
(define Apply
  (lambda (fn arg) ; fn is a closure, arg is value (const or proc)
    (Eval (proc-body (closure-body fn)) 
          (extend (closure-env fn) (var-name (proc-param (closure-body fn))) arg))))

(define (add c1 c2) ; c1,c2: const
  (make-const (+ (const-number c1) (const-number c2))))

(define lookup
  (lambda (name env) ; env is a list of name,value pairs
    (if (null? env) 
        (error "variable ~a is unbound" name)
        (if (eq? name (pair-name (first env)))
            (pair-val (first env))
            (lookup name (rest env))))))

(define (extend env name val) (cons (make-pair name val) env))

(define Empty-Env null)

;; twice-proc = map f to map x to f(f(x))
(define twice-proc (make-proc (make-var 'f) 
                              (make-proc (make-var 'x) 
                                         (make-app (make-var 'f) 
                                                   (make-app (make-var 'f) (make-var 'x))))))
;; double-proc = map x to x+x
(define double-proc (make-proc (make-var 'x) (make-add (make-var 'x) (make-var 'x))))

;; p1 = (twice-proc double-proc) 4
(define p1 (make-app (make-app twice-proc double-proc) (make-const 4)))

;; p2 = (map f to ((twice-proc (map x to x + f)) 5) 10)
(define p2 (make-app (make-proc (make-var 'f) 
                                (make-app (make-app twice-proc (make-proc (make-var 'x) 
                                                                (make-add (make-var 'x) (make-var 'f)))) (make-const 5)))
                     (make-const 10)))

;; ugly = (map two to (map two to two(10))(map x to two))(2)                       
(define ugly (make-app 
              (make-proc 
               (make-var 'two) 
               (make-app (make-proc 
                          (make-var 'two) 
                          (make-app (make-var 'two) (make-const 10))) 
                         (make-proc (make-var 'x) (make-var 'two))))
              (make-const 2)))