diff --git a/06-puwae/main.rkt b/06-puwae/main.rkt index 3e75807..693cbd7 100644 --- a/06-puwae/main.rkt +++ b/06-puwae/main.rkt @@ -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)) diff --git a/13-bang/main.rkt b/13-bang/main.rkt index 7d608ff..3e2e052 100644 --- a/13-bang/main.rkt +++ b/13-bang/main.rkt @@ -5,13 +5,14 @@ ;;; Syntax #| The AST: - ::= - | - | { bind {{ } ... } } - | { fun { ... } } - | { if } - | { ... } - |# + ::= + | + | { bind {{ } ... } } + | { fun { ... } } + | { ... } + | { if } + | { set! } +|# ;; 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}}")