From 48e121d5e83412402b2eeb5d7b5025f817bdff55 Mon Sep 17 00:00:00 2001
From: "Kartik K. Agaram" <vc@akkartik.com>
Date: Sat, 25 Oct 2014 02:32:30 -0700
Subject: [PATCH] 157 - 'new-list' handles integers

---
 mu.arc   | 20 ++++++++++++++++++--
 mu.arc.t | 46 +++++++++++++++++++++++++++++++++++++---------
 2 files changed, 55 insertions(+), 11 deletions(-)

diff --git a/mu.arc b/mu.arc
index 7cd9248c..aa9a3064 100644
--- a/mu.arc
+++ b/mu.arc
@@ -373,7 +373,7 @@
 
                 ; tagged-values require one primitive
                 save-type
-                  (annotate 'record `(,(ty arg.0) ,(v arg.0)))
+                  (annotate 'record `(,(ty arg.0) ,(m arg.0)))
 
                 ; multiprocessing
                 run
@@ -531,7 +531,7 @@
                     (do
                       (assert:is oarg nil)
                       (assert:is arg nil)
-                      (yield `(jump (,(- stack.0 pc) offset))))
+                      (yield `(jump (,(- stack.0 1 pc) offset))))
                   continue-if
                     (do
                       (trace "cvt0" "continue-if: " instr " => " (- stack.0 1))
@@ -608,6 +608,22 @@
   ((result tagged-value-address) <- get-address (base list-address deref) (0 offset))
   (reply (result tagged-value-address)))
 
+(init-fn new-list
+  ((new-list-result list-address) <- new (list type))
+  ((curr list-address) <- copy (new-list-result list-address))
+  { begin
+    ((curr-value integer) (exists? boolean) <- arg)
+    (break-unless (exists? boolean))
+    ((next list-address-address) <- get-address (curr list-address deref) (1 offset))
+    ((next list-address-address deref) <- new (list type))
+    ((curr list-address) <- list-next (curr list-address))
+    ((dest tagged-value-address) <- list-value-address (curr list-address))
+    ((dest tagged-value-address deref) <- save-type (curr-value integer))
+    (continue)
+  }
+  ((new-list-result list-address) <- list-next (new-list-result list-address))  ; memory leak
+  (reply (new-list-result list-address)))
+
 ; drop all traces while processing above functions
 (on-init
   (= traces* (queue)))
diff --git a/mu.arc.t b/mu.arc.t
index ccd325de..55040f8e 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -674,10 +674,11 @@
 (new-trace "save-type")
 (add-fns
   '((main
-      ((1 tagged-value) <- save-type (34 integer-address)))))  ; pointer to nowhere
+      ((1 integer-address) <- copy (34 literal))  ; pointer to nowhere
+      ((2 tagged-value) <- save-type (1 integer-address)))))
 (run 'main)
 ;? (prn memory*)
-(if (~iso memory* (obj  1 'integer-address  2 34))
+(if (~iso memory* (obj  1 34  2 'integer-address  3 34))
   (prn "F - 'save-type' saves the type of a value at runtime, turning it into a tagged-value"))
 
 (reset)
@@ -728,13 +729,14 @@
           (~is (memory* (+ first 1))  34)
           (~is memory*.5 (+ first 2))
           (let second memory*.6
-            (~is (memory* (+ first 2)) second)
-            (~all second (map memory* '(6 7 8)))
-            (~is memory*.second 'boolean)
-            (~is memory*.9 (+ second 1))
-            (~is (memory* (+ second 1)) t)
-            (~is memory*.10 nil)))
-    (prn "F - 'list' constructs a heterogeneous list, which can contain elements of different types")))
+            (or
+              (~is (memory* (+ first 2)) second)
+              (~all second (map memory* '(6 7 8)))
+              (~is memory*.second 'boolean)
+              (~is memory*.9 (+ second 1))
+              (~is (memory* (+ second 1)) t)
+              (~is memory*.10 nil))))
+    (prn "F - lists can contain elements of different types")))
 (add-fns
   '((test2
       ((10 list-address) <- list-next (1 list-address)))))
@@ -743,6 +745,32 @@
 (if (~is memory*.10 memory*.6)
   (prn "F - 'list-next can move a list pointer to the next node"))
 
+; 'new-list' takes a variable number of args and constructs a list containing
+; them.
+
+(reset)
+(new-trace "new-list")
+(add-fns
+  '((main
+      ((1 integer) <- new-list (3 literal) (4 literal) (5 literal)))))
+;? (set dump-trace*)
+(run 'main)
+;? (prn memory*)
+(let first memory*.1
+;?   (prn first)
+  (if (or (~is memory*.first  'integer)
+          (~is (memory* (+ first 1))  3)
+          (let second (memory* (+ first 2))
+;?             (prn second)
+            (or (~is memory*.second 'integer)
+                (~is (memory* (+ second 1)) 4)
+                (let third (memory* (+ second 2))
+;?                   (prn third)
+                  (or (~is memory*.third 'integer)
+                      (~is (memory* (+ third 1)) 5)
+                      (~is (memory* (+ third 2) nil)))))))
+    (prn "F - 'new-list' can construct a list of integers")))
+
 ; Just like the table of types is centralized, functions are conceptualized as
 ; a centralized table of operations just like the 'primitives' we've seen so
 ; far. If you create a function you can call it like any other op.