From 560dec57836f2983dee37cc850216e61f6e1bc64 Mon Sep 17 00:00:00 2001 From: Jacob Signorovitch Date: Tue, 3 Mar 2026 21:40:56 -0500 Subject: [PATCH] Stuff. --- 13-bang/main.rkt | 51 ++++++++++++++++++++++++++++++++++++------------ 1 file changed, 38 insertions(+), 13 deletions(-) diff --git a/13-bang/main.rkt b/13-bang/main.rkt index 3e2e052..9813f22 100644 --- a/13-bang/main.rkt +++ b/13-bang/main.rkt @@ -7,8 +7,9 @@ #| The AST: ::= | - | { bind {{ } ... } } - | { fun { ... } } + | { bind {{ } ... } ... } + | { bindrec {{ } ... } ... } + | { fun { ... } ... } | { ... } | { if } | { set! } @@ -18,8 +19,9 @@ (define-type TOY [Num Number] [Id Symbol] - [Bind (Listof Symbol) (Listof TOY) TOY] - [Fun (Listof Symbol) TOY] + [Bind (Listof Symbol) (Listof TOY) (Listof TOY)] + [Bindrec (Listof Symbol) (Listof TOY) (Listof TOY)] + [Fun (Listof Symbol) (Listof TOY)] [Call TOY (Listof TOY)] [If TOY TOY TOY] [Set Symbol TOY]) @@ -42,16 +44,19 @@ [(number: n) (Num n)] [(symbol: name) (Id name)] - ; Bind. - [(cons 'bind more) + ; Bindrec. + [(cons (and binder (or 'bind 'bindrec)) more) ; `binder` bound to 'bind or 'bindrec. (match sexpr - [(list 'bind (list (list (symbol: names) (sexpr: nameds)) - ...) - body) - (if (unique-list? names) - (Bind names (map parse-sexpr nameds) (parse-sexpr body)) - (error 'parse-sexpr "duplicate `bind' names: ~s" names))] - [else (error 'parse-sexpr "bad `bind' syntax in ~s" sexpr)])] + [(list b (list (list (symbol: names) (sexpr: nameds)) ...) body ...) + (if (not (null? body)) + (if (unique-list? names) + ((if (symbol=? b 'bind) Bind Bindrec) + names + (map parse-sexpr nameds) + (last (map parse-sexpr body))) + (error 'parse-sexpr "duplicate `~s' names: ~s" binder names)) + (error 'parse-sexpr "bind expression missing body: ~s" sexpr))] + [else (error 'parse-sexpr "bad `~s' syntax in ~s" binder sexpr)])] ; Function definition. [(cons 'fun more) @@ -120,6 +125,16 @@ env) (error 'extend "arity mismatch for names: ~s" names))) +(: extend-rec : (Listof Symbol) (Listof TOY) ENV -> ENV) +(define (extend-rec names vals env) + (define newenv (extend names (map (lambda (_) (VoidV)) vals) env)) + (for-each (lambda ([name : Symbol] [val : TOY]) + (set-box! (lookup name newenv) (eval val newenv))) + names vals) + newenv) + + + (: lookup : Symbol ENV -> (Boxof VAL)) ;; lookup a symbol in an environment, frame by frame, ;; return its value or throw an error if it isn't bound @@ -181,6 +196,8 @@ [(Id name) (unbox (lookup name env))] [(Bind names exprs bound-body) (eval bound-body (extend names (map eval* exprs) env))] + [(Bindrec names exprs bound-body) + (eval bound-body (extend-rec names exprs env))] [(Fun names bound-body) (FunV names bound-body env)] [(Call fun-expr arg-exprs) @@ -214,6 +231,14 @@ ;;; ---------------------------------------------------------------- ;;; Tests +(test (run "{bindrec {{fact {fun {n} +{if {= 0 n} +1 +{* n {fact {- n 1}}}}}}} + +{fact 5}}") +=> 120) + (test (run " {bind {{x 10}} {bind {{y {set! x 1}}}