; LC interpreter that uses lists of pairs to represent environments and 
; ignores the issue of 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 | Proc

; Env ::= (list-of Pair)

; Pair ::= (make-pair 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 Eval
  (lambda (M env)
    (cond
      ((var? M) (lookup (var-name M) env))
      ((const? M) M)
      ((proc? M) M)
      ((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) env)))))
         
(define Apply
  (lambda (fn arg env) ; fn is a proc, arg is value (const or proc)
    ;;(printf "Apply(~a,~a,~a) called~n" fn arg env)  ;; debug
    (Eval (proc-body fn) 
          (extend env (proc-param 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 'lookup "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 '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)))