about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorKartik K. Agaram <vc@akkartik.com>2014-11-24 21:40:59 -0800
committerKartik K. Agaram <vc@akkartik.com>2014-11-24 21:40:59 -0800
commit55b99d0cb9db75f8b81f033b359402245b3b7d3c (patch)
tree4800b650f379dbe68b118f1390769d676389f73c
parentcb9e66d70b86909dc811182479253a78cfbead07 (diff)
downloadmu-55b99d0cb9db75f8b81f033b359402245b3b7d3c.tar.gz
315 - handle before/after uniformly like def
-rw-r--r--mu.arc38
-rw-r--r--mu.arc.t114
2 files changed, 89 insertions, 63 deletions
diff --git a/mu.arc b/mu.arc
index ff8d9b0e..4cc74308 100644
--- a/mu.arc
+++ b/mu.arc
@@ -86,6 +86,7 @@
 
 (def new-trace (filename)
 ;?   (prn "new-trace " filename)
+;?   )
   (= curr-trace-file* filename))
 
 (= dump-trace* nil)
@@ -133,11 +134,26 @@
   (each (expected-label expected-msg)  expected-contents
     (prn "  ! " expected-label ": " expected-msg)))
 
-(def add-code (fns)
-  (each (_def name (_make-br-fn body)) fns
-    (assert (is 'def _def))
-    (assert (is 'make-br-fn _make-br-fn))
-    (= function*.name (convert-names:convert-braces:insert-code body))))
+(def add-code (forms)
+  (each (op . rest)  forms
+    (case op
+      def
+        (let (name (_make-br-fn body))  rest
+          (assert (is 'make-br-fn _make-br-fn))
+          (= function*.name (convert-names:convert-braces:insert-code body)))
+      ; multiple before directives => code in order
+      before
+        (let (label (_make-br-fn fragment))  rest
+          (assert (is 'make-br-fn _make-br-fn))
+          (or= before*.label (queue))
+          (enq fragment before*.label))
+      ; multiple after directives => code in *reverse* order
+      ; (if initialization order in a function is A B, corresponding
+      ; finalization order should be B A)
+      after
+        (let (label (_make-br-fn fragment))  rest
+          (assert (is 'make-br-fn _make-br-fn))
+          (push fragment after*.label)))))
 
 ;; managing concurrent routines
 
@@ -859,17 +875,7 @@
   (= before* (table))  ; label -> queue of fragments
   (= after* (table)))  ; label -> list of fragments
 
-(def add-hooks (clauses)
-  (each (op label . fragment)  clauses
-    ; multiple before directives => code in order
-    (when (is op 'before)
-      (or= before*.label (queue))
-      (enq fragment before*.label))
-    ; multiple after directives => code in *reverse* order
-    ; (if initialization order in a function is A B, corresponding
-    ; finalization order should be B A)
-    (when (is op 'after)
-      (push fragment after*.label))))
+; see add-code below for adding to before* and after*
 
 (def insert-code (instrs)
   (accum yield
diff --git a/mu.arc.t b/mu.arc.t
index ebf30e44..9b13c0d7 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -2572,13 +2572,14 @@
 
 (reset)
 ;? (new-trace "insert-code-before")
-(add-hooks '((before label1
-               ((2 integer) <- copy (0 literal)))))
+(add-code '((before label1 [
+               ((2 integer) <- copy (0 literal))
+             ])))
 (if (~iso (as cons before*!label1)
           '(; fragment
             (
               ((2 integer) <- copy (0 literal)))))
-  (prn "F - add-hooks records fragments of code to insert before labels"))
+  (prn "F - 'before' records fragments of code to insert before labels"))
 
 (if (~iso (insert-code
             '(((1 integer) <- copy (0 literal))
@@ -2592,17 +2593,19 @@
 
 (reset)
 ;? (new-trace "insert-code-before-multiple")
-(add-hooks '((before label1
-               ((2 integer) <- copy (0 literal)))
-             (before label1
-               ((3 integer) <- copy (0 literal)))))
+(add-code '((before label1 [
+               ((2 integer) <- copy (0 literal))
+             ])
+            (before label1 [
+              ((3 integer) <- copy (0 literal))
+             ])))
 (if (~iso (as cons before*!label1)
           '(; fragment
             (
               ((2 integer) <- copy (0 literal)))
             (
               ((3 integer) <- copy (0 literal)))))
-  (prn "F - add-hooks records 'before' fragments in order"))
+  (prn "F - 'before' records fragments in order"))
 
 (if (~iso (insert-code
             '(((1 integer) <- copy (0 literal))
@@ -2617,13 +2620,14 @@
 
 (reset)
 ;? (new-trace "insert-code-after")
-(add-hooks '((after label1
-               ((2 integer) <- copy (0 literal)))))
+(add-code '((after label1 [
+               ((2 integer) <- copy (0 literal))
+             ])))
 (if (~iso (as cons after*!label1)
           '(; fragment
             (
               ((2 integer) <- copy (0 literal)))))
-  (prn "F - add-hooks records fragments of code to insert after labels"))
+  (prn "F - 'after' records fragments of code to insert after labels"))
 
 (if (~iso (insert-code
             '(((1 integer) <- copy (0 literal))
@@ -2637,17 +2641,19 @@
 
 (reset)
 ;? (new-trace "insert-code-after-multiple")
-(add-hooks '((after label1
-               ((2 integer) <- copy (0 literal)))
-             (after label1
-               ((3 integer) <- copy (0 literal)))))
+(add-code '((after label1 [
+               ((2 integer) <- copy (0 literal))
+             ])
+            (after label1 [
+              ((3 integer) <- copy (0 literal))
+             ])))
 (if (~iso (as cons after*!label1)
           '(; fragment
             (
               ((3 integer) <- copy (0 literal)))
             (
               ((2 integer) <- copy (0 literal)))))
-  (prn "F - add-hooks records 'after' fragments in reverse order"))
+  (prn "F - 'after' records fragments in *reverse* order"))
 
 (if (~iso (insert-code
             '(((1 integer) <- copy (0 literal))
@@ -2662,10 +2668,12 @@
 
 (reset)
 ;? (new-trace "insert-code-before-after")
-(add-hooks '((before label1
-               ((2 integer) <- copy (0 literal)))
-             (after label1
-               ((3 integer) <- copy (0 literal)))))
+(add-code '((before label1 [
+               ((2 integer) <- copy (0 literal))
+             ])
+            (after label1 [
+              ((3 integer) <- copy (0 literal))
+             ])))
 (if (and (~iso (as cons before*!label1)
                '(; fragment
                  (
@@ -2674,7 +2682,7 @@
                '(; fragment
                  (
                    ((3 integer) <- copy (0 literal))))))
-  (prn "F - add-hooks can record 'before' and 'after' fragments at once"))
+  (prn "F - 'before' and 'after' fragments work together"))
 
 (if (~iso (insert-code
             '(((1 integer) <- copy (0 literal))
@@ -2689,16 +2697,20 @@
 
 (reset)
 ;? (new-trace "insert-code-before-after-multiple")
-(add-hooks '((before label1
+(add-code '((before label1 [
                ((2 integer) <- copy (0 literal))
-               ((3 integer) <- copy (0 literal)))
-             (after label1
-               ((4 integer) <- copy (0 literal)))
-             (before label1
-               ((5 integer) <- copy (0 literal)))
-             (after label1
-               ((6 integer) <- copy (0 literal))
-               ((7 integer) <- copy (0 literal)))))
+               ((3 integer) <- copy (0 literal))
+             ])
+            (after label1 [
+              ((4 integer) <- copy (0 literal))
+             ])
+            (before label1 [
+              ((5 integer) <- copy (0 literal))
+             ])
+            (after label1 [
+              ((6 integer) <- copy (0 literal))
+              ((7 integer) <- copy (0 literal))
+             ])))
 (if (or (~iso (as cons before*!label1)
               '(; fragment
                 (
@@ -2713,7 +2725,7 @@
                   ((7 integer) <- copy (0 literal)))
                 (
                   ((4 integer) <- copy (0 literal))))))
-  (prn "F - add-hooks can record multiple 'before' and 'after' fragments at once"))
+  (prn "F - multiple 'before' and 'after' fragments at once"))
 
 (if (~iso (insert-code
             '(((1 integer) <- copy (0 literal))
@@ -2733,25 +2745,33 @@
 ;? (new-trace "insert-code-before-after-independent")
 (if (~iso (do
             (reset)
-            (add-hooks '((before label1
-                           ((2 integer) <- copy (0 literal)))
-                         (after label1
-                           ((3 integer) <- copy (0 literal)))
-                         (before label1
-                           ((4 integer) <- copy (0 literal)))
-                         (after label1
-                           ((5 integer) <- copy (0 literal)))))
+            (add-code '((before label1 [
+                           ((2 integer) <- copy (0 literal))
+                         ])
+                        (after label1 [
+                          ((3 integer) <- copy (0 literal))
+                         ])
+                        (before label1 [
+                          ((4 integer) <- copy (0 literal))
+                         ])
+                        (after label1 [
+                          ((5 integer) <- copy (0 literal))
+                         ])))
             (list before*!label1 after*!label1))
           (do
             (reset)
-            (add-hooks '((before label1
-                           ((2 integer) <- copy (0 literal)))
-                         (before label1
-                           ((4 integer) <- copy (0 literal)))
-                         (after label1
-                           ((3 integer) <- copy (0 literal)))
-                         (after label1
-                           ((5 integer) <- copy (0 literal)))))
+            (add-code '((before label1 [
+                           ((2 integer) <- copy (0 literal))
+                         ])
+                        (before label1 [
+                          ((4 integer) <- copy (0 literal))
+                         ])
+                        (after label1 [
+                          ((3 integer) <- copy (0 literal))
+                         ])
+                        (after label1 [
+                          ((5 integer) <- copy (0 literal))
+                         ])))
             (list before*!label1 after*!label1)))
   (prn "F - order matters within 'before' and 'after' fragments, but not *between* 'before' and 'after' fragments"))