Done with bang.
This commit is contained in:
+14
-11
@@ -207,11 +207,13 @@
|
|||||||
(FunV names bound-body #t env)]
|
(FunV names bound-body #t env)]
|
||||||
[(Call fun-expr arg-exprs)
|
[(Call fun-expr arg-exprs)
|
||||||
(let ([fval (eval* fun-expr)]
|
(let ([fval (eval* fun-expr)]
|
||||||
[arg-vals (map eval* arg-exprs)])
|
[arg-vals-thunk (lambda () (map eval* arg-exprs))]) ;THunk.
|
||||||
(cases fval
|
(cases fval
|
||||||
[(PrimV proc) (proc arg-vals)]
|
[(PrimV proc) (proc (arg-vals-thunk))]
|
||||||
[(FunV names body ref? fun-env)
|
[(FunV names body ref? fun-env)
|
||||||
(if ref? (eval-rfun names arg-exprs body fun-env) (eval-body body (extend names arg-vals fun-env)))]
|
(if ref?
|
||||||
|
(eval-rfun names arg-exprs body env fun-env)
|
||||||
|
(eval-body body (extend names (arg-vals-thunk) fun-env)))]
|
||||||
[else (error 'eval "function call with a non-function: ~s"
|
[else (error 'eval "function call with a non-function: ~s"
|
||||||
fval)]))]
|
fval)]))]
|
||||||
[(If cond-expr then-expr else-expr)
|
[(If cond-expr then-expr else-expr)
|
||||||
@@ -224,9 +226,9 @@
|
|||||||
(set-box! (lookup thing env) (eval* as)) ; We are not a lazy language.
|
(set-box! (lookup thing env) (eval* as)) ; We are not a lazy language.
|
||||||
(VoidV)]))
|
(VoidV)]))
|
||||||
|
|
||||||
(: eval-rfun : (Listof Symbol) (Listof TOY) (Listof TOY) ENV -> VAL)
|
(: eval-rfun : (Listof Symbol) (Listof TOY) (Listof TOY) ENV ENV -> VAL)
|
||||||
(define (eval-rfun params args body env)
|
(define (eval-rfun params args body callerenv calleeenv)
|
||||||
(eval-body body (raw-extend params (get-boxes args env) env)))
|
(eval-body body (raw-extend params (get-boxes args callerenv) calleeenv)))
|
||||||
|
|
||||||
(: get-boxes : (Listof TOY) ENV -> (Listof (Boxof VAL)))
|
(: get-boxes : (Listof TOY) ENV -> (Listof (Boxof VAL)))
|
||||||
(define (get-boxes ids env)
|
(define (get-boxes ids env)
|
||||||
@@ -254,6 +256,8 @@
|
|||||||
|
|
||||||
;;; ----------------------------------------------------------------
|
;;; ----------------------------------------------------------------
|
||||||
;;; Tests
|
;;; Tests
|
||||||
|
(test (run "{{rfun {x} x} {/ 4 0}}") =error> "non-identifier")
|
||||||
|
(test (run "{5 {/ 6 0}}") =error> "non-function")
|
||||||
(test (run "
|
(test (run "
|
||||||
{bind
|
{bind
|
||||||
{
|
{
|
||||||
@@ -274,8 +278,7 @@
|
|||||||
{swap! a b}
|
{swap! a b}
|
||||||
|
|
||||||
{+ a {* 10 b}}
|
{+ a {* 10 b}}
|
||||||
}
|
}") => 12)
|
||||||
") => 12)
|
|
||||||
|
|
||||||
(test (run "{bind {{make-counter
|
(test (run "{bind {{make-counter
|
||||||
{fun {}
|
{fun {}
|
||||||
@@ -338,11 +341,11 @@ c}}}}}
|
|||||||
|
|
||||||
;; More tests for complete coverage
|
;; More tests for complete coverage
|
||||||
(test (run "{bind x 5 x}") =error> "bad `bind' syntax")
|
(test (run "{bind x 5 x}") =error> "bad `bind' syntax")
|
||||||
(test (run "{fun x x}") =error> "bad `fun' syntax")
|
(test (run "{fun x x}") =error> "parse-sexpr: bad function syntax in (fun x x)")
|
||||||
(test (run "{if x}") =error> "bad `if' syntax")
|
(test (run "{if x}") =error> "bad `if' syntax")
|
||||||
(test (run "{}") =error> "bad syntax")
|
(test (run "{}") =error> "bad syntax")
|
||||||
(test (run "{bind {{x 5} {x 5}} x}") =error> "duplicate*bind*names")
|
(test (run "{bind {{x 5} {x 5}} x}") =error> "parse-sexpr: duplicate `bind' names: (x x)")
|
||||||
(test (run "{fun {x x} x}") =error> "duplicate*fun*names")
|
(test (run "{fun {x x} x}") =error> "parse-sexpr: bad parameters defined for function in (fun (x x) x)")
|
||||||
(test (run "{+ x 1}") =error> "no binding for")
|
(test (run "{+ x 1}") =error> "no binding for")
|
||||||
(test (run "{+ 1 {fun {x} x}}") =error> "bad input")
|
(test (run "{+ 1 {fun {x} x}}") =error> "bad input")
|
||||||
(test (run "{+ 1 {fun {x} x}}") =error> "bad input")
|
(test (run "{+ 1 {fun {x} x}}") =error> "bad input")
|
||||||
|
|||||||
Reference in New Issue
Block a user