diff options
author | Kartik K. Agaram <vc@akkartik.com> | 2014-11-24 21:40:59 -0800 |
---|---|---|
committer | Kartik K. Agaram <vc@akkartik.com> | 2014-11-24 21:40:59 -0800 |
commit | 55b99d0cb9db75f8b81f033b359402245b3b7d3c (patch) | |
tree | 4800b650f379dbe68b118f1390769d676389f73c | |
parent | cb9e66d70b86909dc811182479253a78cfbead07 (diff) | |
download | mu-55b99d0cb9db75f8b81f033b359402245b3b7d3c.tar.gz |
315 - handle before/after uniformly like def
-rw-r--r-- | mu.arc | 38 | ||||
-rw-r--r-- | mu.arc.t | 114 |
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")) |