; LC interpreter that uses procedures to represent environments and 
; structs 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 ::= (make-closure Proc Env)

; 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 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)
    ; (printf "Apply ~s ~s called~n" fn arg)
    (Eval (proc-body (closure-body fn)) 
          (extend (closure-env fn) (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 procedure mapping names to values
    (env name)))

(define Empty-Env (lambda (name) (error "unbound variable" name)))
        
(define (extend env name val) (lambda (a-name) (if (eq? a-name name) val (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)))