From 6215fec22513faaf31e01b6feee0aad59cb2560a Mon Sep 17 00:00:00 2001
From: "Kartik K. Agaram" <vc@akkartik.com>
Date: Thu, 17 Jul 2014 09:02:43 -0700
Subject: 27 - a simple assembler for turning else/break/continue into jumps

---
 mu.arc   | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 mu.arc.t | 18 +++++++++++++++++
 2 files changed, 85 insertions(+)

diff --git a/mu.arc b/mu.arc
index d4840706..0d0ea21b 100644
--- a/mu.arc
+++ b/mu.arc
@@ -114,6 +114,73 @@
 ;?     (prn "return " result)
     )))
 
+;? (mac assert (expr)
+;?   `(if (no ,expr)
+;?      (err "assertion failed: " ',expr)))
+
+(def convert-braces (instrs)
+  (let locs ()  ; list of information on each brace: (open/close pc)
+    (let pc 0
+      (loop (instrs instrs)
+        (each instr instrs
+          (if (~is 'begin instr.0)
+            (do
+;?               (prn pc " " instr)
+              (++ pc))
+            (do
+;?               (prn `(open ,pc))
+              (push `(open ,pc) locs)
+              (recur cdr.instr)
+;?               (prn `(close ,pc))
+              (push `(close ,pc) locs))))))
+    (zap rev locs)
+;?     (prn locs)
+    (with (pc  0
+           stack  ())  ; elems are pcs
+      (accum yield
+        (loop (instrs instrs)
+          (each instr instrs
+            (let delim (or (pos '<- instr) -1)
+              (with (oarg  (if (>= delim 0)
+                             (cut instr 0 delim))
+                     op  (instr (+ delim 1))
+                     arg  (cut instr (+ delim 2)))
+;?                 (prn op " " oarg)
+                (case op
+                  begin
+                    (do
+                      (push pc stack)
+                      (assert:is oarg nil)
+                      (recur arg)
+                      (pop stack))
+                  breakif
+                    (do
+;?                       (prn "breakif: " instr)
+                      (yield `(jif ,arg.0 (offset ,(close-offset pc locs)))))
+                  ;else
+                    (yield instr))))
+            (++ pc)))))))
+
+(def close-offset (pc locs)
+  (let close 0
+    (with (stacksize 0
+           done nil)
+      (each (state loc) locs
+;?         (prn "  :" close " " state " - " loc)
+        (if (< loc pc)
+              nil  ; do nothing
+            (no done)
+              (do
+                ; first time
+                (when (and (is 0 stacksize) (~is loc pc))
+                  (++ stacksize))
+                (if (is 'open state) (++ stacksize) (-- stacksize))
+                ; last time
+                (when (is 0 stacksize)
+                  (= close loc)
+                  (set done))))))
+    (- close pc 1)))
+
 (awhen cdr.argv
   (each file it
 ;?     (prn file)
diff --git a/mu.arc.t b/mu.arc.t
index 86442e3b..43d4dce6 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -365,3 +365,21 @@
                          ; temporaries for most recent call to add-fn
                          4 0  5 0  6 nil  7 3  8 4  9 7))
   (prn "F - different calls can exercise different clauses of the same function"))
+
+(if (~iso (convert-braces '(((integer 1) <- loadi 4)
+                            ((integer 2) <- loadi 2)
+                            ((integer 3) <- add (integer 2) (integer 2))
+                            { begin  ; 'begin' is just a hack because racket turns curlies into parens
+                            ((boolean 4) <- neq (integer 1) (integer 3))
+                            (breakif (boolean 4))
+                            ((integer 5) <- loadi 34)
+                            }
+                            (reply)))
+          '(((integer 1) <- loadi 4)
+            ((integer 2) <- loadi 2)
+            ((integer 3) <- add (integer 2) (integer 2))
+            ((boolean 4) <- neq (integer 1) (integer 3))
+            (jif (boolean 4) (offset 1))
+            ((integer 5) <- loadi 34)
+            (reply)))
+  (prn "F - convert braces"))
-- 
cgit 1.4.1-2-gfad0