#lang plai
(define-type F1CWAE
  (num (n number?))
  (add (lhs F1CWAE?)(rhs F1CWAE?))
  (with (name symbol?)
        (named-expr F1CWAE?)
        (body F1CWAE?))
  (id (name symbol?))
  (if0 (test F1CWAE?)
      (true F1CWAE?)
      (false F1CWAE?))
  (app (fun-name symbol?)(arg F1CWAE?)))

(define (parse sexp)
  (cond
    ((number? sexp)(num sexp))
    ((symbol? sexp)(id sexp))
    ((list? sexp)
     (case (first sexp)
       ((+)(add (parse (second sexp))
                (parse (third sexp))))
       ((with)(with (caadr sexp)
                    (parse (cadadr sexp))
                    (parse (third sexp))))
       ((if0)(if0 (parse (second sexp))
                 (parse (third sexp))
                 (parse (fourth sexp))))
       (else (app (first sexp) (parse (second sexp))))
      ))
   ))

(define-type FunDef
  [fundef (fun-name symbol?)
          (arg-name symbol?)
          (body F1CWAE?)])


(define (lookup-fundef fun-name fundefs)
  (cond
    [(empty? fundefs) (error fun-name "function not found")]
    [else (if (symbol=? fun-name (fundef-fun-name (first fundefs)))
         (first fundefs)
         (lookup-fundef fun-name (rest fundefs)))]
    ))

(define-type DefrdSub
  (mtSub)
  (aSub (name symbol?)
        (value number?)
        (ds DefrdSub?))
 )

(define (lookup name ds)
  (type-case DefrdSub ds
      (mtSub () (error 'lookup "no binding for identifier"))
      (aSub (bound-name bound-value rest-ds)
          (if (eq? bound-name name)
              bound-value
              (lookup name rest-ds)))
  ))

(define (interp expr fun-defs ds)
  (type-case F1CWAE expr
     (num (n) n)
     (add (l r)(+ (interp l fun-defs ds)(interp r fun-defs ds)))
     (with (bound-id named-expr bound-body)
           (interp bound-body
                   fun-defs
                   (aSub bound-id
                         (interp named-expr
                                 fun-defs
                                 ds)
                         ds)))
     (id (v) (lookup v ds))
     (if0 (v t f)
         (if (= (interp v fun-defs ds) 0)
             (interp t fun-defs ds)
             (interp f fun-defs ds)))
     (app (fun-name arg-expr)
          (let ((the-fun-def (lookup-fundef fun-name fun-defs)))
            (interp (fundef-body the-fun-def)
                    fun-defs
                    (aSub (fundef-arg-name the-fun-def)
                          (interp arg-expr fun-defs ds)
                          (mtSub)))
                  
          ))
 ))

(define fd (list (fundef 'f 'x (parse '{+ 11 x}))
                 (fundef 'g 'x (parse '{+ {+ x x} x}))
                 (fundef 'h 'a (parse '{+ {f a} {g a}}))
                 (fundef 'sum 'n 
                     (parse '{if0 n 0
                                  {+ n {sum {+ n -1}}}
                                }))
                 ))