Добавление нескольких с аргументами и аргументами функций в схему CFWAE / L

Question

Это то, что я имею до сих пор, и я почти уверен, что это работает.Конечно, binop настроен на прием +, -, * и /.Разумное количество этого кода из книги PLAI.Мне просто нужна помощь, чтобы выяснить, как заставить это работать для тестовых случаев, подобных этому:

(test (evaluate '{{fun {x y} {* x y}} 2 3}) (numV 6))

#lang plai

(define-type CFWAE/L
    (num (n number?))
    (id (name symbol?))
    (binop (op procedure?) (lhs CFWAE/L?) (rhs CFWAE/L?))
    (fun (param symbol?) (body CFWAE/L?))
    (app (fun-expr CFWAE/L?) (arg-exprs CFWAE/L?))
    (if0 (test-expr CFWAE/L?) (then-expr CFWAE/L?) (else-expr CFWAE/L?)))

(define-type Env
   (mtEnv)
   (anEnv (id symbol?) 
     (val CFWAE/L-value?) 
     (more-subs Env?)))

(define-type CFWAE/L-value 
  (numV (n number?))
  (expV (exp CFWAE/L?) (env Env?) (cache boxed-boolean/CFWAE/L-Value?))
  (closureV (param symbol?) (body CFWAE/L?) (env Env?)))

(define binop-table
  `((+ . ,+)
    (- . ,-)
    (* . ,*)
    (/ . ,/)))

;; find-op :: symbol -> op
;; returns the procedure operation that corresponds to the given symbol
(define (find-op opr) 
    (cdr (assoc opr binop-table)))


(define (check-sexp? sexp)
  (case (first sexp)
    [(+ - * /)(if (equal? 3 (length sexp))
              #t
              #f)]
    [(with)(and (if (equal? 3 (length sexp))
                #t
                #f)
            (if (null? (second sexp))
                (error "No identifiers")
                #t))]
    [(fun)(and (if (equal? 3 (length sexp))
               #t
               #f)
           (if (null? (second sexp))
               (error "No identifiers")
               #t))]                 
    [(if0)(if (equal? 4 (length sexp))
          #t
          #f)]
    [(app)(if (equal? 2 (length sexp))
          #t
          #f)]))

(define (parse sexp)
  (cond [(number? sexp) (num sexp)]
      [(symbol? sexp) (id sexp)]
      [(list? sexp)
       (case (first sexp)
         [(+ - * /) (binop (find-op (first sexp)) (parse (second sexp))
                         (parse (third sexp)))]
         [(with) (app (fun (first (second sexp))
                         (parse (third sexp)))
                    (parse (second (second sexp))))]  
         [(fun) (fun (first (second sexp))             
                   (parse (third sexp)))]
         [(if0) (if0 (parse (second sexp))
                   (parse (third sexp))
                   (parse (fourth sexp)))]
         [else (app (parse (first sexp))           
                  (parse (second sexp)))])]))

(define (lookup name env)
  (type-case Env env
    [mtEnv () (error 'lookup "free identifier")]
    [anEnv (bound-name bound-value more-subs)
        (if (symbol=? bound-name name)
            (strict bound-value)
            (lookup name more-subs))]))


(define (boxed-boolean/CFWAE/L-Value? val)
  (and (box? val)
     (or (boolean? (unbox val))
         (and (CFWAE/L-value? (unbox val))
              (not (expV? (unbox val)))))))

;; cached? : expV? -> boolean?
(define (cached? val)
  (not (boolean? (unbox (expV-cache val)))))


(define (strict val)
  (if (expV? val)
      (if (cached? val)
          (unbox (expV-cache val))
          (begin
            ;(printf "Evaluating exp closure ~a.~n" val)
             (set-box! (expV-cache val) 
                  (strict (interp (expV-exp val) (expV-env val))))
             (unbox (expV-cache val))))val))

;; opV : procedure numV numV -> numV 
;; unwraps two numVs and applies the operator and wraps the result back into a numV
(define (binopV op n1 n2) 
       (cond
         ((and (equal? op /) (= (numV-n (strict n2)) 0))
          (error "Divide-by-zero"));
         ((or (closureV? n1) (closureV? n2))
          (error "Can't apply an operation to a closure"))
         (true
          (numV (op (numV-n (strict n1)) (numV-n (strict n2)))))))

;interp : CFAE/L Env -> CFAE/L-value
(define (interp exp env)
  (type-case CFWAE/L exp
     (num (n) (numV n))
     (binop (op left right) (binopV op (interp left env) (interp right env)))
     (id  (name) (lookup name env))
     (fun (param body) (closureV param body env))
     (if0 (test-expr then-expr else-expr) 
         (type-case CFWAE/L-value (strict(interp test-expr env))
           (numV (n) (if (zero? n) (interp then-expr env) (interp else-expr env)))
           (else (error "if0 test value value not numeric"))))
     (app (fun-expr arg-expr)
          (let ((fun-val (interp fun-expr env))
                (arg-val (expV arg-expr env (box #f))))
            (type-case CFWAE/L-value (strict fun-val)
               (closureV (param body closure-env)
                 (interp body (anEnv param 
                         arg-val
                         closure-env)))
           (else (error "You can only apply closures")))))))

(define (evaluate sexp)
  (strict (interp (parse sexp) (mtEnv))))