Done with bang.

This commit is contained in:
2026-03-03 23:04:53 -05:00
parent 2dcf5ba10f
commit efd448d78c
+14 -11
View File
@@ -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")