jacob/cs5
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Stuff.

Browse Source
This commit is contained in:
jacob
2026-03-03 21:40:56 -05:00
parent d45570305a
commit 560dec5783
1 changed files with 38 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files
13-bang/main.rkt
+38 -13
View File
@@ -7,8 +7,9 @@
#| The AST:
<TOY> ::= <num>
| <id>
| { bind {{ <id> <TOY> } ... } <TOY> }
| { fun { <id> ... } <TOY> }
| { bind {{ <id> <TOY> } ... } <TOY> ... }
| { bindrec {{ <id> <TOY> } ... } <TOY> ... }
| { fun { <id> ... } <TOY> ... }
| { <TOY> <TOY> ... }
| { if <TOY> <TOY> <TOY> }
| { set! <id> <TOY> }
@@ -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}}}