Improve 3.rkt a bit

Final/2.rkt

@@ -7,6 +7,8 @@
   [appE (fun-expr : Exp) (arg-expr : Exp)]
   [errorE (msg : String)] ;; New
   [if0E (test : Exp) (then : Exp) (else : Exp)]
+  [minus1E (n : Exp)]
+  [timesE (lhs : Exp) (rhs : Exp)]
   )
 
 (define-type Value
@@ -43,6 +45,12 @@
                 (k : Continuation)]
   [doMinusK (v1 : Value)
             (k : Continuation)]
+  [doMinus1K (k : Continuation)]
+  [timesSecondK (r : Exp)
+                (env : Env)
+                (k : Continuation)]
+  [doTimesK (v1 : Value)
+            (k : Continuation)]
   [appArgK (arg-expr : Exp)
            (env : Env)
            (k : Continuation)]
@@ -77,12 +85,13 @@
          (lamE varE body))]
       [(s-exp-match? `(error STRING) sx) (errorE (s-exp->string (sx-ref sx 1)))]
       [(s-exp-match? `(error ANY) sx) (parse-error sx)]
-      [(s-exp-match? `(ANY ANY) sx)
-       (appE (px 0) (px 1))]
+      [(s-exp-match? `(-- ANY) sx) (minus1E (px 1))]
+      [(s-exp-match? `(ANY ANY) sx) (appE (px 0) (px 1))]
       [(s-exp-list? sx)
        (case (s-exp->symbol (sx-ref sx 0))
          [(+) (plusE (px 1) (px 2))]
          [(-) (minusE (px 1) (px 2))]
+         [(*) (timesE (px 1) (px 2))]
          [(if0) (if0E (px 1) (px 2) (px 3))]
          [else (parse-error sx)])]
       [else (parse-error sx)])))
@@ -113,7 +122,8 @@
      (interp fun-expr env (appArgK arg-expr env k))]
     [(if0E test-expr then-expr else-expr)
      (interp test-expr env (doIfK then-expr else-expr env k))]
-
+    [(minus1E n) (interp n env (doMinus1K k))]
+    [(timesE l r) (interp l env (timesSecondK r env k))]
     ))
 
 (define (continue [k : Continuation] [v : Value]) : Value
@@ -127,6 +137,12 @@
      (interp r env (doMinusK v next-k))]
     [(doMinusK v1 next-k)
      (continue next-k (arith-op - v1 v))]
+    [(doMinus1K next-k)
+     (continue next-k (arith-op - v (numV 1)))]
+    [(timesSecondK r env next-k)
+     (interp r env (doTimesK v next-k))]
+    [(doTimesK v1 next-k)
+     (continue next-k (arith-op * v1 v))]
     [(appArgK arg-expr env next-k)
      (interp arg-expr env (doAppK v next-k))]
     [(doAppK fun-val next-k)
@@ -240,3 +256,46 @@
                       {body-proc {lam {x} {{fX fX} x}}}}}}})
         (errorV "reached zero"))
   )
+
+; unary decrement
+(module+ test
+  (test (parse `{-- 2}) (minus1E (numE 2))))
+
+(module+ test
+  (test (run `{-- 2}) (numV 1))
+  (test (run `{{lam {x} {-- x}} 3}) (numV 2))
+  (test (run `{{lam {y} {+ {-- y} {-- y}}} 10}) (numV 18))
+  (test (run `{{lam {f} {f 4}} {lam {x} {-- x}}}) (numV 3)))
+
+; multiplication
+(module+ test
+  (define fact-prog
+    `{{lam {mkrec}
+           {{lam {fact}
+                 ;; Call fact on 5:
+                 {fact 5}}
+            ;; Create recursive fact
+            {mkrec
+             {lam {fact}
+                  {lam {n}
+                       {if0 n
+                            1
+                            {* n {fact {-- n}}}}}}}}}
+      ;; mkrec:
+      {lam {body-proc}
+           {{lam {fX}
+                 {fX fX}}
+            {lam {fX}
+                 {body-proc {lam {x} {{fX fX} x}}}}}}})
+
+  (test (run fact-prog) (numV 120)))
+
+; stupid tests for coverage
+(module+ test
+  (test/exn (parse-error 'invalid-syntax) "invalid-syntax")
+  (test (parse `(error "test error")) (errorE "test error"))
+  (test/exn (parse `(error 123)) "parse error")
+  (test/exn (parse `(unknown 1 2 3)) "parse error")
+  (test/exn (arith-op + (numV 1) (errorV "not a number")) "expects a number")
+  (test/exn (parse `#f) "parse error"))
+  

Final/3.rkt

@@ -58,8 +58,16 @@
               (test/exn (begin oper ...) expected))))]))
 
 (define (swap-spaces!)
-  ;; do nothing
-  (void))
+  (let ([current-offset (off)])
+    (if (= current-offset METADATA-SIZE)
+        ;; If left semi-space, switch to the right
+        (begin
+          (heap-set! LOC:OFFSET (+ METADATA-SIZE (space-size)))
+          (heap-set! LOC:PTR 0))
+        ;; Else switch back to the left semi-space
+        (begin
+          (heap-set! LOC:OFFSET METADATA-SIZE)
+          (heap-set! LOC:PTR 0)))))
 
 (module+ test
 
@@ -89,7 +97,7 @@
   )
 
 ;; malloc : size -> address
-(define (malloc n)
+(define (malloc n . other-roots)
   (when (> (+ (ptr) n) (space-size))
     (gc!))
   (when (> (+ (ptr) n) (space-size))
@@ -97,9 +105,29 @@
   (heap-set! LOC:PTR (+ (ptr) n))
   (+ (heap-ref LOC:OFFSET) (- (ptr) n)))
 
-(define (gc!)
-  ;; do nothing
-  (void))
+(define (forward/root thing)
+  (define addr (read-root thing))
+  (define fwrd (+ 1 addr))
+  (cond
+    [(gc:flat? addr) (heap-set! fwrd (gc:alloc-flat (gc:deref addr)))]
+    ; maybe forward root on each cons cell? could fix what seems to be memory corruption
+    [(gc:cons? addr) (heap-set! fwrd (gc:cons (simple-root (gc:first addr)) (simple-root (gc:rest addr))))]
+    [(gc:closure? addr)
+     (let ([code-ptr (gc:closure-code-ptr addr)]
+           [n-vars (heap-ref (+ addr 2))])
+       (heap-set! fwrd
+                  (gc:closure code-ptr
+                              (for/list ([i (in-range n-vars)])
+                                (forward/root (simple-root (gc:closure-env-ref addr i)))))))])
+  (heap-set! addr 'forwarded))
+
+(define (gc! . other-roots)
+  (swap-spaces!)
+  (heap-set! LOC:PTR 0)  ; Reset the allocation pointer in the new semi-space
+
+  ;; Forward all roots to the new semi-space
+  (for-each forward/root (get-root-set))
+  (for-each forward/root other-roots))
 
 ;; gc:alloc-flat : flat-value -> address
 (define (gc:alloc-flat value)