/src/test/run-pass$ ~/pres/racket/bin/raco fmt -i **/*.scm

We'll need it eventually, and it lets me steal lox tests

README.md

@@ -0,0 +1,3 @@
+## Credits
+
+Many of the tests are adapted from [craftinginterpriters](https://github.com/munificent/craftinginterpreters/tree/master/test).

src/ast.rs

@@ -5,6 +5,7 @@ use std::rc::Rc;
 crate enum Tree {
     Leaf(Literal),
     Define(String, Box<Tree>),
+    Set(String, Box<Tree>),
     If(Box<[Tree; 3]>),
     // Its easier to box the lambdas in the parser than the vm, as
     // here we see all of them exactly once

src/eval.rs

@@ -70,6 +70,11 @@ pub(crate) fn eval(t: &ast::Tree, env: Rc<RefCell<Env>>) -> Result<Value, RTErro
             env.borrow_mut().define(name.to_owned(), val);
             Value::Trap
         }
+        ast::Tree::Set(name, to) => {
+            let val = eval(to, Rc::clone(&env))?;
+            env.borrow_mut().set(name, val)?;
+            Value::Trap
+        }
         ast::Tree::If(box [cond, tcase, fcase]) => {
             let b = eval(cond, Rc::clone(&env))?.as_bool()?;
             let body = if b { tcase } else { fcase };
@@ -134,8 +139,20 @@ impl Env {
     pub(crate) fn define(&mut self, name: String, val: Value) {
         assert_ne!(val, Value::Trap); // TODO: Better error
 
+        // TODO: Error on previous def
         self.vars.insert(name, val);
     }
+
+    crate fn set(&mut self, name: &str, val: Value) -> Result<(), RTError> {
+        if let Some(loc) = self.vars.get_mut(name) {
+            *loc = val;
+            Ok(())
+        } else if let Some(parent) = &self.enclosing {
+            parent.borrow_mut().set(name, val)
+        } else {
+            err(format!("Tried to `set!` un `define`d var `{}`", name))
+        }
+    }
 }
 
 pub(crate) fn default_env() -> Env {

src/grammar.lalrpop

@@ -21,6 +21,7 @@ pub(crate) Tree: Tree = {
         => Tree::Define(name, Box::new(Tree::Func(Rc::new(Func{args, body})))),
     "(" "if" <Tree> <Tree> <Tree> ")" => Tree::If(Box::new([<>])),
     "(" "lambda (" <args:Sym*> ")" <body:Trees> ")" => Tree::Func(Rc::new(Func{<>})),
+    "(" "set!" <Sym> <BTree> ")" => Tree::Set(<>),
     Literal => Tree::Leaf(<>),
 }
 

src/snapshots/handball__tests__run-pass@4-1-6-Assignments.scm.snap

@@ -0,0 +1,7 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass r7rs-spec\\4-1-6-Assignments.scm"
+
+---
+3.05.0

src/snapshots/handball__tests__run-pass@assign-closures.scm.snap

@@ -0,0 +1,11 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\assign-closures.scm"
+
+---
+1.0
+2.0
+2.0
+3.0
+

src/snapshots/handball__tests__run-pass@assign-shadowed-later.scm.snap

@@ -0,0 +1,9 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\assign-shadowed-later.scm"
+
+---
+1.0
+0.0
+

src/snapshots/handball__tests__run-pass@bagel-donut.scm.snap

@@ -0,0 +1,9 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\bagel-donut.scm"
+
+---
+4.0
+2.0
+

src/snapshots/handball__tests__run-pass@close-over-function-param.scm.snap

@@ -0,0 +1,7 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\close-over-function-param.scm"
+
+---
+77.0

src/snapshots/handball__tests__run-pass@close-over-later-variable.scm.snap

@@ -0,0 +1,8 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\close-over-later-variable.scm"
+
+---
+2.0
+1.0

src/snapshots/handball__tests__run-pass@close-unused.scm.snap

@@ -0,0 +1,7 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\close-unused.scm"
+
+---
+7.0

src/snapshots/handball__tests__run-pass@closed-closure-in-function.scm.snap

@@ -0,0 +1,7 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\closed-closure-in-function.scm"
+
+---
+1.0

src/snapshots/handball__tests__run-pass@gnarly-i.scm.snap

@@ -0,0 +1,10 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\gnarly-i.scm"
+
+---
+3.0
+2.0
+1.0
+

src/snapshots/handball__tests__run-pass@mutate-levels.scm.snap

@@ -0,0 +1,13 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\mutate-levels.scm"
+
+---
+2.0
+3.0
+3.0
+3.0
+7.0
+8.0
+

src/snapshots/handball__tests__run-pass@nested-assign.scm.snap

@@ -0,0 +1,7 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\nested-assign.scm"
+
+---
+1.0

src/snapshots/handball__tests__run-pass@nested-closure.scm.snap

@@ -0,0 +1,10 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\nested-closure.scm"
+
+---
+1.0
+2.0
+3.0
+

src/snapshots/handball__tests__run-pass@objects-are-a-poor-mans-closure.scm.snap

@@ -0,0 +1,20 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\objects-are-a-poor-mans-closure.scm"
+
+---
+1.0
+7.0
+1.0
+7.0
+
+8.0
+2.0
+8.0
+2.0
+
+9.0
+9.0
+
+

src/snapshots/handball__tests__run-pass@open-closure-in-function.scm.snap

@@ -0,0 +1,7 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\open-closure-in-function.scm"
+
+---
+1.0

src/snapshots/handball__tests__run-pass@reference-closure-multiple-times.scm.snap

@@ -0,0 +1,8 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\reference-closure-multiple-times.scm"
+
+---
+1.0
+1.0

src/snapshots/handball__tests__run-pass@reuse-closure-slot.scm.snap

@@ -0,0 +1,7 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\reuse-closure-slot.scm"
+
+---
+1.0

src/snapshots/handball__tests__run-pass@scope.scm.snap

@@ -0,0 +1,9 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\scope.scm"
+
+---
+7.0
+2.0
+

src/snapshots/handball__tests__run-pass@shadow-closure-with-local.scm.snap

@@ -0,0 +1,9 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\shadow-closure-with-local.scm"
+
+---
+0.0
+1.0
+

src/snapshots/handball__tests__run-pass@unused-later-closures.scm.snap

@@ -0,0 +1,8 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\unused-later-closures.scm"
+
+---
+1.0
+1.0

src/snapshots/handball__tests__run-pass@use-after-close.scm.snap

@@ -0,0 +1,7 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\use-after-close.scm"
+
+---
+1.0

src/snapshots/handball__tests__run-pass@val-or-var.scm.snap

@@ -0,0 +1,9 @@
+---
+source: src/tests.rs
+assertion_line: 41
+expression: "run-pass closure\\val-or-var.scm"
+
+---
+0.0
+1.0
+

src/test/run-pass/ambig-scope.scm

@@ -1,18 +1,22 @@
 #lang scheme
 
-(define (displayln x) (newline) (display x))
+(define (displayln x)
+  (newline)
+  (display x))
 
-(define (ambig1 x) (lambda (x) x))
+(define (ambig1 x)
+  (lambda (x) x))
 
 (displayln ((ambig1 13) 42))
 
 (define (ambig2 a)
   (displayln a)
   (define a- a)
-  (lambda (b) (displayln b)
+  (lambda (b)
+    (displayln b)
     (lambda (a)
       (displayln a)
       (displayln b)
       (displayln a-))))
 
-(((ambig2 1) 2) 3)
+(((ambig2 1) 2) 3)

src/test/run-pass/capture.scm

@@ -1,12 +1,13 @@
 #lang scheme
 
-(define (displayln x) (display x) (newline))
+(define (displayln x)
+  (display x)
+  (newline))
 
-
-(define (const x) (lambda () x))
+(define (const x)
+  (lambda () x))
 
 (define two-thunk (const 2))
 
 (displayln two-thunk)
 (displayln (two-thunk))
-

src/test/run-pass/closure/assign-closures.scm

@@ -0,0 +1,28 @@
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/assign_to_closure.lox
+
+(define f #f)
+(define g #f)
+
+(define (displayln x)
+  (display x)
+  (newline))
+
+((lambda ()
+   (define local 1)
+
+   (define (f_)
+     (displayln local)
+     (set! local 2)
+     (displayln local))
+
+   (set! f f_)
+
+   (define (g_)
+     (displayln local)
+     (set! local 3)
+     (displayln local))
+
+   (set! g g_)))
+
+(f)
+(g)

src/test/run-pass/closure/assign-shadowed-later.scm

@@ -0,0 +1,17 @@
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/assign_to_shadowed_later.lox
+
+(define a 0)
+
+(define (displayln x)
+  (display x)
+  (newline))
+
+((lambda ()
+   (define (assign)
+     (set! a 1))
+
+   (define a 2)
+   (assign)
+   (displayln a)))
+
+(displayln a)

src/test/run-pass/closure/bagel-donut.scm

@@ -0,0 +1,14 @@
+(define (displayln x)
+  (display x)
+  (newline))
+
+(define (make-print x)
+  (define (print)
+    (displayln x))
+  print)
+
+(define print-2 (make-print 2))
+(define print-4 (make-print 4))
+
+(print-4)
+(print-2)

src/test/run-pass/closure/close-over-function-param.scm

@@ -0,0 +1,10 @@
+(define f #f)
+
+(define (foo param)
+  (define (f_)
+    (display param))
+  (set! f f_))
+
+(foo 77)
+
+(f)

src/test/run-pass/closure/close-over-later-variable.scm

@@ -0,0 +1,14 @@
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/close_over_later_variable.lox
+
+(define (f)
+  (define a 1)
+  (define b 2)
+
+  (define (g)
+    (display b)
+    (newline)
+    (display a))
+
+  (g))
+
+(f)

src/test/run-pass/closure/close-unused.scm

@@ -0,0 +1,6 @@
+((lambda ()
+   (define a 1)
+
+   (if #f (lambda () a) 0)))
+
+(display 7)

src/test/run-pass/closure/closed-closure-in-function.scm

@@ -0,0 +1,11 @@
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/closed_closure_in_function.lox
+
+(define f #f)
+
+((lambda ()
+   (define local 1)
+   (define (f_)
+     (display local))
+   (set! f f_)))
+
+(f)

src/test/run-pass/closure/gnarly-i.scm

@@ -0,0 +1,22 @@
+#lang scheme
+
+(define (displayln x)
+  (display x)
+  (newline))
+
+(define (outer)
+  (define x 1)
+
+  (define (middle)
+    (define (inner)
+      (displayln x))
+    (displayln 2)
+    inner)
+
+  (displayln 3)
+
+  middle)
+
+(define mid (outer))
+(define in (mid))
+(in)

src/test/run-pass/closure/mutate-levels.scm

@@ -0,0 +1,24 @@
+(define x 2)
+
+(define (show-x)
+  (display x)
+  (newline))
+
+(show-x)
+(set! x 3)
+(show-x)
+
+((lambda ()
+   (define x 7)
+   (show-x)
+   (set! x 8)
+   (show-x)))
+
+((lambda ()
+   (define (show-x)
+     (display x)
+     (newline))
+   (define x 7)
+   (show-x)
+   (set! x 8)
+   (show-x)))

src/test/run-pass/closure/nested-assign.scm

@@ -0,0 +1,8 @@
+(define (outer)
+  (define x 0)
+  (define (y)
+    (set! x 1))
+  (y)
+  (display x))
+
+(outer)

src/test/run-pass/closure/nested-closure.scm

@@ -0,0 +1,26 @@
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/nested_closure.lox
+#lang scheme
+
+(define (displayln x)
+  (display x)
+  (newline))
+
+(define f #f)
+
+(define (f1)
+  (define a 1)
+  (define (f2)
+    (define b 2)
+    (define (f3)
+      (define c 3)
+      (define (f4)
+        (displayln a)
+        (displayln b)
+        (displayln c))
+      (set! f f4))
+    (f3))
+  (f2))
+
+(f1)
+
+(f)

src/test/run-pass/closure/objects-are-a-poor-mans-closure.scm

@@ -0,0 +1,43 @@
+#lang scheme
+
+(define get-x 1)
+(define get-y 2)
+(define do-print 3)
+(define add 4)
+
+(define (displayln x)
+  (display x)
+  (newline))
+
+(define (vector x y)
+  (define (add-to other)
+    (vector (+ x (other get-x)) (+ y (other get-y))))
+
+  (lambda (message)
+    (if (= message get-x)
+        x
+        (if (= message get-y)
+            y
+            (if (= message add)
+                add-to
+                (if (= message do-print)
+                    ((lambda ()
+                       (displayln x)
+                       (displayln y)
+                       (newline)))
+                    ((lambda ()
+                       (displayln -99)
+                       0))))))))
+
+(define v-1-7 (vector 1 7))
+(displayln (v-1-7 get-x))
+(displayln (v-1-7 get-y))
+(v-1-7 do-print)
+
+(define v-8-2 (vector 8 2))
+(displayln (v-8-2 get-x))
+(displayln (v-8-2 get-y))
+(v-8-2 do-print)
+
+(define v-9-9 ((v-8-2 add) v-1-7))
+(v-9-9 do-print)

src/test/run-pass/closure/open-closure-in-function.scm

@@ -0,0 +1,9 @@
+#lang scheme
+
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/open_closure_in_function.lox
+
+((lambda ()
+   (define local 1)
+   (define (f)
+     (display local))
+   (f)))

src/test/run-pass/closure/reference-closure-multiple-times.scm

@@ -0,0 +1,14 @@
+#lang scheme
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/reference_closure_multiple_times.lox
+
+(define f #f)
+
+((lambda ()
+   (define a 1)
+   (define (f_)
+     (display a)
+     (newline)
+     (display a))
+   (set! f f_)))
+
+(f)

src/test/run-pass/closure/reuse-closure-slot.scm

@@ -0,0 +1,15 @@
+#lang scheme
+
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/reuse_closure_slot.lox
+
+((lambda ()
+   (define f #f)
+   ((lambda ()
+      (define a 1)
+      (define (f_)
+        (display a))
+      (set! f f_)))
+
+   ((lambda ()
+      (define b 2)
+      (f)))))

src/test/run-pass/closure/scope.scm

@@ -0,0 +1,13 @@
+(define x 2)
+
+(define (displayln x)
+  (display x)
+  (newline))
+
+(define (gy y)
+  x)
+(define (gx x)
+  x)
+
+(displayln (gx 7))
+(displayln (gy 7))

src/test/run-pass/closure/shadow-closure-with-local.scm

@@ -0,0 +1,15 @@
+; https://github.com/munificent/craftinginterpreters/blob/master/test/closure/shadow_closure_with_local.lox
+; TODO: Forbid this https://discordapp.com/channels/571040468092321801/618895179343986688/925533402592079912
+
+(define (displayln x)
+  (display x)
+  (newline))
+
+((lambda ()
+   (define foo 0)
+   (define (f)
+     ((lambda ()
+        (displayln foo)
+        (define foo 1)
+        (displayln foo))))
+   (f)))

src/test/run-pass/closure/unused-later-closures.scm

@@ -0,0 +1,19 @@
+(define closure #f)
+
+((lambda ()
+   (define a 1)
+
+   ((lambda ()
+      (define b 2)
+
+      (define (get-a)
+        a)
+
+      (set! closure get-a)
+
+      (if #f (lambda () b) 0)))
+
+   (display (closure))))
+
+(newline)
+(display (closure))

src/test/run-pass/closure/use-after-close.scm

@@ -0,0 +1,8 @@
+(define (outer)
+  (define x 1)
+  (define (inner)
+    (display x))
+  inner)
+
+(define clousre (outer))
+(clousre)

src/test/run-pass/closure/val-or-var.scm

@@ -0,0 +1,19 @@
+(define globalSet #f)
+(define globalGet #f)
+
+(define (main)
+  (define a 0)
+
+  (define (set)
+    (set! a 1))
+  (define (get)
+    (display a)
+    (newline))
+
+  (set! globalSet set)
+  (set! globalGet get))
+
+(main)
+(globalGet)
+(globalSet)
+(globalGet)

src/test/run-pass/curry.scm

@@ -1,7 +1,10 @@
 #lang scheme
 
-(define (displayln x) (display x) (newline))
+(define (displayln x)
+  (display x)
+  (newline))
 
-(define (curry2 f) (lambda (l) (lambda (r) (f l r))))
+(define (curry2 f)
+  (lambda (l) (lambda (r) (f l r))))
 
 (displayln (((curry2 +) 1) 2))

src/test/run-pass/fib.scm

@@ -1,21 +1,28 @@
 #lang scheme
 
-(define (displayln x) (display x) (newline))
+(define (displayln x)
+  (display x)
+  (newline))
 
-(define (my-or a b) (if a #t b)) ; Test was written before we had `or`
+(define (my-or a b)
+  (if a #t b)) ; Test was written before we had `or`
 
-
-(define (fib-base? n) (my-or (= n 1) (= n 0)))
+(define (fib-base? n)
+  (my-or (= n 1) (= n 0)))
 
 (define (fib n)
-  (if (fib-base? n) 1
-      (+ (fib (- n 1)) (fib (- n 2)))))
-      
+  (if (fib-base? n) 1 (+ (fib (- n 1)) (fib (- n 2)))))
 
-(define (pfib n) (displayln n) (displayln (fib n)) (newline))
+(define (pfib n)
+  (displayln n)
+  (displayln (fib n))
+  (newline))
 
 (define (pfibs n)
-  (if (= n (- 1)) 0 ; Hack
-      ((lambda () (pfib n) (pfibs (- n 1)))))) ; Hack
+  (if (= n (- 1))
+      0 ; Hack
+      ((lambda ()
+         (pfib n)
+         (pfibs (- n 1)))))) ; Hack
 
-(pfibs 10)
+(pfibs 10)

src/test/run-pass/funcs.scm

@@ -1,6 +1,8 @@
 #lang scheme
 
-(define (displayln x) (display x) (newline))
+(define (displayln x)
+  (display x)
+  (newline))
 
 (define add1 +)
 (displayln (add1 2 3))
@@ -8,5 +10,6 @@
 (define add2 (lambda (a b) (+ a b)))
 (displayln (add2 5 6))
 
-(define (add3 a b) (+ a b))
-(displayln (add3 5 9))
+(define (add3 a b)
+  (+ a b))
+(displayln (add3 5 9))

src/test/run-pass/lambda-calc.scm

@@ -1,18 +1,24 @@
 #lang scheme
 
-(define (displayln x) (display x) (newline))
-(define (printbool x) (displayln (bool->int x)))
+(define (displayln x)
+  (display x)
+  (newline))
+(define (printbool x)
+  (displayln (bool->int x)))
 
-(define (true x y) x)
-(define (false x y) y)
-(define (and x y) (x y x))
-(define (or x y) (x x y))
-(define (not x) (x false true))
+(define (true x y)
+  x)
+(define (false x y)
+  y)
+(define (and x y)
+  (x y x))
+(define (or x y)
+  (x x y))
+(define (not x)
+  (x false true))
 
-(define (bool->int x) 
-  (if 
-   (equal? x true) 1 
-   (if (equal? x false) 0 (- 1))))
+(define (bool->int x)
+  (if (equal? x true) 1 (if (equal? x false) 0 (- 1))))
 
 (printbool true)
 (printbool false)
@@ -27,4 +33,4 @@
 (printbool (or true false))
 (printbool (or false true))
 (printbool (or false false))
-(printbool (and (or true false) (or false true)))
+(printbool (and (or true false) (or false true)))

src/test/run-pass/multi.scm

@@ -1,5 +1,8 @@
 #lang scheme
 
-(define (multi) 1 2 3)
+(define (multi)
+  1
+  2
+  3)
 
-(display (multi))
+(display (multi))

src/test/run-pass/nested-defs.scm

@@ -6,15 +6,14 @@
 (define (sqrt x)
   (define (sqrt-iter guess x)
     (define (good-enough? guess x)
-      (define (square x) (* x x))
+      (define (square x)
+        (* x x))
       (< (abs (- (square guess) x)) 0.001))
     (define (improve guess x)
-      (define (average x y) 
+      (define (average x y)
         (/ (+ x y) 2))
       (average guess (/ x guess)))
-    (if (good-enough? guess x)
-        guess
-        (sqrt-iter (improve guess x) x)))
+    (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x)))
   (sqrt-iter 1.0 x))
 
-(display (sqrt 2))
+(display (sqrt 2))

src/test/run-pass/r7rs-spec/4-1-6-Assignments.scm

@@ -0,0 +1,4 @@
+(define x 2)
+(display (+ x 1))
+(set! x 4)
+(display (+ x 1))

src/test/run-pass/sqrt.scm

@@ -4,17 +4,16 @@
 ; http://sarabander.github.io/sicp/html/1_002e1.xhtml#g_t1_002e1_002e7
 
 (define (sqrt-iter guess x)
-  (if (good-enough? guess x)
-      guess
-      (sqrt-iter (improve guess x) x)))
+  (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x)))
 
 (define (improve guess x)
   (average guess (/ x guess)))
 
-(define (average x y) 
+(define (average x y)
   (/ (+ x y) 2))
 
-(define (square x) (* x x))
+(define (square x)
+  (* x x))
 
 (define (good-enough? guess x)
   (< (abs (- (square guess) x)) 0.001))
@@ -22,4 +21,4 @@
 (define (sqrt x)
   (sqrt-iter 1.0 x))
 
-(display (sqrt 2))
+(display (sqrt 2))

src/tests.rs

@@ -18,7 +18,7 @@ upstream for this
 fn run_pass() {
     let manifest_dir = Path::new(env!("CARGO_MANIFEST_DIR"));
 
-    insta::glob!("test/run-pass/**.scm", |p| {
+    insta::glob!("test/run-pass/**/*.scm", |p| {
         let p = PathBuf::from(
             p.canonicalize()
                 .unwrap()