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

Good work done on bang.

Browse Source
This commit is contained in:
jacob
2026-03-03 19:16:00 -05:00
parent 8e093ab0b5
commit d45570305a
2 changed files with 65 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
06-puwae/main.rkt
-5
View File
@@ -58,7 +58,6 @@ POSTT :== PUWAE
(: parsepost : (Sexpr (Listof PUWAE) -> PUWAE))
; Parse a post expression into a PUWAE.
(define (parsepost sexpr glob)
(println (format "parsing '~s' with glob '~s'" sexpr glob))
(match sexpr
['() (if (= 1 (length glob)) (first glob) (error 'parsepost "finished with messy glob: ~s" glob))] ; There shouldn't be anything else left in the stack.
[(cons '+ rest) (parsepost rest (parsepost-sum glob))]
@@ -78,25 +77,21 @@ POSTT :== PUWAE
(: parsepost-sum : ((Listof PUWAE) -> (Listof PUWAE)))
; Parse a post sum.
(define (parsepost-sum glob)
(println (format "summing '~s'" glob))
(glob-swap 'sum glob Sum))
(: parsepost-mul : ((Listof PUWAE) -> (Listof PUWAE)))
; Parse a post product.
(define (parsepost-mul glob)
(println (format "mulling '~s'" glob))
(glob-swap 'mul glob Mul))
(: parsepost-sub : ((Listof PUWAE) -> (Listof PUWAE)))
; Parse a post subtration.
(define (parsepost-sub glob)
(println (format "subbing '~s'" glob))
(glob-swap 'sub glob Sub))
(: parsepost-div : ((Listof PUWAE) -> (Listof PUWAE)))
; Parse a post quotient.
(define (parsepost-div glob)
(println (format "divving '~s'" glob))
(glob-swap 'div glob Div))
(: eval : (PUWAE -> Number))
13-bang/main.rkt
+65 -23
View File
@@ -5,13 +5,14 @@
;;; Syntax
#| The AST:
<TOY> ::= <num>
| <id>
| { bind {{ <id> <TOY> } ... } <TOY> }
| { fun { <id> ... } <TOY> }
| { if <TOY> <TOY> <TOY> }
| { <TOY> <TOY> ... }
|#
<TOY> ::= <num>
| <id>
| { bind {{ <id> <TOY> } ... } <TOY> }
| { fun { <id> ... } <TOY> }
| { <TOY> <TOY> ... }
| { if <TOY> <TOY> <TOY> }
| { set! <id> <TOY> }
|#
;; A matching abstract syntax tree datatype:
(define-type TOY
@@ -20,7 +21,11 @@
[Bind (Listof Symbol) (Listof TOY) TOY]
[Fun (Listof Symbol) TOY]
[Call TOY (Listof TOY)]
[If TOY TOY TOY])
[If TOY TOY TOY]
[Set Symbol TOY])
; Things you can't name things.
(define BAD_WORDS (list 'bind 'fun 'if 'set! '+ '- '* '/ '= '< '> 'true 'false 'void))
(: unique-list? : (Listof Any) -> Boolean)
;; Tests whether a list is unique, guards Bind and Fun values.
@@ -33,8 +38,11 @@
;; parses s-expressions into TOYs
(define (parse-sexpr sexpr)
(match sexpr
; Primitives.
[(number: n) (Num n)]
[(symbol: name) (Id name)]
; Bind.
[(cons 'bind more)
(match sexpr
[(list 'bind (list (list (symbol: names) (sexpr: nameds))
@@ -44,6 +52,8 @@
(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)])]
; Function definition.
[(cons 'fun more)
(match sexpr
[(list 'fun (list (symbol: names) ...) body)
@@ -51,6 +61,8 @@
(Fun names (parse-sexpr body))
(error 'parse-sexpr "duplicate `fun' names: ~s" names))]
[else (error 'parse-sexpr "bad `fun' syntax in ~s" sexpr)])]
; Conditional.
[(cons 'if more)
(match sexpr
[(list 'if cond then else)
@@ -58,9 +70,19 @@
(parse-sexpr then)
(parse-sexpr else))]
[else (error 'parse-sexpr "bad `if' syntax in ~s" sexpr)])]
; Set!.
[(cons 'set! more)
(match sexpr
[(list 'set! (symbol: thing) as)
(Set thing (parse-sexpr as))])]
; Function application
[(list fun args ...) ; other lists are applications
(Call (parse-sexpr fun)
(map parse-sexpr args))]
; Bad.
[else (error 'parse-sexpr "bad syntax in ~s" sexpr)]))
(: parse : String -> TOY)
@@ -76,24 +98,29 @@
[FrameEnv FRAME ENV])
;; a frame is an association list of names and values.
(define-type FRAME = (Listof (List Symbol VAL)))
(define-type FRAME = (Listof (List Symbol (Boxof VAL))))
(define-type VAL
[RktV Any]
[FunV (Listof Symbol) TOY ENV]
[PrimV ((Listof VAL) -> VAL)])
[PrimV ((Listof VAL) -> VAL)]
[VoidV])
(: extend : (Listof Symbol) (Listof VAL) ENV -> ENV)
(define (extend names vals env)
(raw-extend names (map (inst box VAL) vals) env))
(: raw-extend : (Listof Symbol) (Listof (Boxof VAL)) ENV -> ENV)
;; extends an environment with a new frame.
(define (extend names values env)
(if (= (length names) (length values))
(FrameEnv (map (lambda ([name : Symbol] [val : VAL])
(list name val))
names values)
(define (raw-extend names bvals env)
(if (= (length names) (length bvals))
(FrameEnv (map (lambda ([name : Symbol] [bval : (Boxof VAL)])
(list name bval))
names bvals)
env)
(error 'extend "arity mismatch for names: ~s" names)))
(: lookup : Symbol ENV -> VAL)
(: 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
(define (lookup name env)
@@ -113,7 +140,7 @@
[(RktV v) v]
[else (error 'racket-func "bad input: ~s" x)]))
(: racket-func->prim-val : Function -> VAL)
(: racket-func->prim-val : Function -> (Boxof VAL))
;; converts a racket function to a primitive evaluator function
;; which is a PrimV holding a ((Listof VAL) -> VAL) function.
;; (the resulting function will use the list function as is,
@@ -121,8 +148,8 @@
;; if it's given a bad number of arguments or bad input types.)
(define (racket-func->prim-val racket-func)
(define list-func (make-untyped-list-function racket-func))
(PrimV (lambda (args)
(RktV (list-func (map unwrap-rktv args))))))
(box (PrimV (lambda (args)
(RktV (list-func (map unwrap-rktv args)))))))
;; The global environment has a few primitives:
(: global-environment : ENV)
@@ -135,8 +162,9 @@
(list '> (racket-func->prim-val >))
(list '= (racket-func->prim-val =))
;; values
(list 'true (RktV #t))
(list 'false (RktV #f)))
(list 'true (box (RktV #t)))
(list 'false (box (RktV #f)))
(list 'void (box (VoidV))))
(EmptyEnv)))
;;; ----------------------------------------------------------------
@@ -150,7 +178,7 @@
(define (eval* expr) (eval expr env))
(cases expr
[(Num n) (RktV n)]
[(Id name) (lookup name env)]
[(Id name) (unbox (lookup name env))]
[(Bind names exprs bound-body)
(eval bound-body (extend names (map eval* exprs) env))]
[(Fun names bound-body)
@@ -169,7 +197,10 @@
[(RktV v) v] ; Racket value => use as boolean
[else #t]) ; other values are always true
then-expr
else-expr))]))
else-expr))]
[(Set thing as)
(set-box! (lookup thing env) (eval* as)) ; We are not a lazy language.
(VoidV)]))
(: run : String -> Any)
;; evaluate a TOY program contained in a string
@@ -183,6 +214,17 @@
;;; ----------------------------------------------------------------
;;; Tests
(test (run "
{bind {{x 10}}
{bind {{y {set! x 1}}}
x
}
}
") => 1)
(test (run "{bind {{x 2}} {set! x 1}}") =error> "run: evaluation returned a bad value: (VoidV)")
(test (run "{if {= 1 2} 0 1}") => 1)
(test (run "{if true 1 2}") => 1)
(test (run "{{fun {x} {+ x 1}} 4}")
=> 5)
(test (run "{bind {{add3 {fun {x} {+ x 3}}}} {add3 1}}")