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
+37 -12
View File
@@ -7,8 +7,9 @@
#| The AST: #| The AST:
<TOY> ::= <num> <TOY> ::= <num>
| <id> | <id>
| { bind {{ <id> <TOY> } ... } <TOY> } | { bind {{ <id> <TOY> } ... } <TOY> ... }
| { fun { <id> ... } <TOY> } | { bindrec {{ <id> <TOY> } ... } <TOY> ... }
| { fun { <id> ... } <TOY> ... }
| { <TOY> <TOY> ... } | { <TOY> <TOY> ... }
| { if <TOY> <TOY> <TOY> } | { if <TOY> <TOY> <TOY> }
| { set! <id> <TOY> } | { set! <id> <TOY> }
@@ -18,8 +19,9 @@
(define-type TOY (define-type TOY
[Num Number] [Num Number]
[Id Symbol] [Id Symbol]
[Bind (Listof Symbol) (Listof TOY) TOY] [Bind (Listof Symbol) (Listof TOY) (Listof TOY)]
[Fun (Listof Symbol) TOY] [Bindrec (Listof Symbol) (Listof TOY) (Listof TOY)]
[Fun (Listof Symbol) (Listof TOY)]
[Call TOY (Listof TOY)] [Call TOY (Listof TOY)]
[If TOY TOY TOY] [If TOY TOY TOY]
[Set Symbol TOY]) [Set Symbol TOY])
@@ -42,16 +44,19 @@
[(number: n) (Num n)] [(number: n) (Num n)]
[(symbol: name) (Id name)] [(symbol: name) (Id name)]
; Bind. ; Bindrec.
[(cons 'bind more) [(cons (and binder (or 'bind 'bindrec)) more) ; `binder` bound to 'bind or 'bindrec.
(match sexpr (match sexpr
[(list 'bind (list (list (symbol: names) (sexpr: nameds)) [(list b (list (list (symbol: names) (sexpr: nameds)) ...) body ...)
...) (if (not (null? body))
body)
(if (unique-list? names) (if (unique-list? names)
(Bind names (map parse-sexpr nameds) (parse-sexpr body)) ((if (symbol=? b 'bind) Bind Bindrec)
(error 'parse-sexpr "duplicate `bind' names: ~s" names))] names
[else (error 'parse-sexpr "bad `bind' syntax in ~s" sexpr)])] (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. ; Function definition.
[(cons 'fun more) [(cons 'fun more)
@@ -120,6 +125,16 @@
env) env)
(error 'extend "arity mismatch for names: ~s" names))) (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 : Symbol ENV -> (Boxof VAL))
;; lookup a symbol in an environment, frame by frame, ;; lookup a symbol in an environment, frame by frame,
;; return its value or throw an error if it isn't bound ;; return its value or throw an error if it isn't bound
@@ -181,6 +196,8 @@
[(Id name) (unbox (lookup name env))] [(Id name) (unbox (lookup name env))]
[(Bind names exprs bound-body) [(Bind names exprs bound-body)
(eval bound-body (extend names (map eval* exprs) env))] (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) [(Fun names bound-body)
(FunV names bound-body env)] (FunV names bound-body env)]
[(Call fun-expr arg-exprs) [(Call fun-expr arg-exprs)
@@ -214,6 +231,14 @@
;;; ---------------------------------------------------------------- ;;; ----------------------------------------------------------------
;;; Tests ;;; Tests
(test (run "{bindrec {{fact {fun {n}
{if {= 0 n}
1
{* n {fact {- n 1}}}}}}}
{fact 5}}")
=> 120)
(test (run " (test (run "
{bind {{x 10}} {bind {{x 10}}
{bind {{y {set! x 1}}} {bind {{y {set! x 1}}}