为方案CFWAE / L添加带参数和函数参数的多个参数

时间:2012-03-14 01:46:58

标签: scheme

这是我到目前为止所做的,我很确定它有效。 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))))

0 个答案:

没有答案