; LC interpreter that uses procedures to represent environments and 
; procedures to represent closures

; AST ::= Var | Const | Proc | App | Add

; Var ::= (make-var symbol)

; Const ::= (make-const integer)

; Proc ::= (make-proc Var AST)

; App ::= (make-app AST AST)

; Add ::= (make-add AST AST)

; Val ::= Const | Closure

; Closure ::= Val -> Val

; Env ::= symbol -> Val

(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 (make-closure proc env)
  (lambda (val) (Eval (proc-body proc) (extend env (proc-param proc) val))))

(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)
    (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 procedure mapping names to values
    (env name)))

(define Empty-Env (lambda (name) 
                    (if (empty? name) empty
                        (error 'lookup "unbound variable ~a" name))))
        
(define (extend env name val) 
  (lambda (a-name) 
    (cond [(empty? a-name) (cons (list name val)) (env empty)]
          [(eq? a-name name) val]
          [else (env a-name)])))

;; twice-proc = map f to map x to f(f(x))
(define twice-proc (make-proc 'f
                              (make-proc '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 '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 'f 
                                (make-app (make-app twice-proc (make-proc '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 
               'two 
               (make-app (make-proc 
                          'two
                          (make-app (make-var 'two) (make-const 10))) 
                         (make-proc 'x (make-var 'two))))
              (make-const 2)))

;; double = (map x to x+x)(10)
(define double (make-app double-proc (make-const 10)))