Good work done on bang.

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))

13-bang/main.rkt

@@ -5,13 +5,14 @@
 ;;; Syntax
 
 #| The AST:
-       <TOY> ::= <num>
+<TOY> ::= <num>
        | <id>
        | { bind {{ <id> <TOY> } ... } <TOY> }
        | { fun { <id> ... } <TOY> }
-               | { if <TOY> <TOY> <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)
+(define (raw-extend names bvals env)
-  (if (= (length names) (length values))
+  (if (= (length names) (length bvals))
-      (FrameEnv (map (lambda ([name : Symbol] [val : VAL])
+      (FrameEnv (map (lambda ([name : Symbol] [bval : (Boxof VAL)])
-                       (list name val))
+                       (list name bval))
-                     names values)
+                     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)
+  (box (PrimV (lambda (args)
-           (RktV (list-func (map unwrap-rktv 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 'true  (box (RktV #t)))
-                  (list 'false (RktV #f)))
+                  (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}}")