140

2 files changed, 35 insertions, 4 deletions

diff --git a/mu.arc b/mu.arc
index 6545fc59..0e80fff7 100644
--- a/mu.arc
+++ b/mu.arc
@@ -357,7 +357,7 @@
                       (new-array type (m arg.1))
                       (new-scalar type)))
                 sizeof
-                  (sizeof (v arg.0))
+                  (sizeof (m arg.0))
                 len
                   (let base arg.0
                     (if typeinfo.base!array
@@ -369,6 +369,10 @@
                   (run (v arg.0))
                 fork
                   (enq (make-context (v arg.0)) contexts*)
+                ; todo: errors should stall a process and let its parent
+                ; inspect it
+                assert
+                  (assert (m arg.0))
 
                 ; text interaction
                 cls
@@ -449,6 +453,7 @@
     (++ Memory-in-use-until (+ 1 (* (sizeof types*.type!elem) size)))))
 
 (def sizeof (type)
+  (trace "sizeof" type)
   (if (~or types*.type!record types*.type!array)
         types*.type!size
       types*.type!record
@@ -563,6 +568,19 @@
   ((xvalue location) <- get (x tagged-value-address deref) (1 offset))
   (reply (xvalue location) (match? boolean)))
 
+(init-fn new-tagged-value
+  ((xtype type) <- arg)
+  ((xtypesize integer) <- sizeof (xtype type))
+  ((xcheck boolean) <- eq (xtypesize integer) (1 literal))
+  (assert (xcheck boolean))
+  ; todo: check that arg 0 matches the type? or is that for the future typechecker?
+  ((result tagged-value-address) <- new (tagged-value type))
+  ((resulttype location) <- get-address (result tagged-value-address deref) (0 offset))
+  ((resulttype location deref) <- copy (xtype type))
+  ((locaddr location) <- get-address (result tagged-value-address deref) (1 offset))
+  ((locaddr location deref) <- arg)
+  (reply (result tagged-value-address)))
+
 ; drop all traces while processing above functions
 (on-init
   (= traces* (queue)))
diff --git a/mu.arc.t b/mu.arc.t
index a4eab61a..17795d95 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -120,7 +120,7 @@
               type (obj size 1)  ; implicitly scalar and primitive
               type-array (obj array t  elem 'type)
               type-array-address (obj size 1  address t  elem 'type-array)
-              location (obj size 1)
+              location (obj size 1  address t  elem 'location)  ; assume it points to an atom
               integer (obj size 1)
               boolean (obj size 1)
               boolean-address (obj size 1  address t)
@@ -570,7 +570,7 @@
 (new-trace "sizeof-record")
 (add-fns
   '((test1
-      ((1 integer) <- sizeof (integer-boolean-pair type)))))
+      ((1 integer) <- sizeof (integer-boolean-pair literal)))))
 (run 'test1)
 ;? (prn memory*)
 (if (~is memory*.1 2)
@@ -580,7 +580,7 @@
 (new-trace "sizeof-record-not-len")
 (add-fns
   '((test1
-      ((1 integer) <- sizeof (integer-point-pair type)))))
+      ((1 integer) <- sizeof (integer-point-pair literal)))))
 (run 'test1)
 ;? (prn memory*)
 (if (~is memory*.1 3)
@@ -661,6 +661,19 @@
 (if (or (~is memory*.3 0) (~is memory*.4 nil))
   (prn "F - 'maybe-coerce' doesn't copy value when type tag doesn't match"))
 
+(reset)
+(new-trace "new-tagged-value")
+;? (set dump-trace*)
+(add-fns
+  '((test1
+      ((1 integer-address) <- copy (34 literal))  ; pointer to nowhere
+      ((2 tagged-value-address) <- new-tagged-value (integer-address literal) (1 integer-address))
+      ((3 integer-address) (4 boolean) <- maybe-coerce (2 tagged-value-address deref) (integer-address literal)))))
+(run 'test1)
+;? (prn memory*)
+(if (or (~is memory*.3 34) (~is memory*.4 t))
+  (prn "F - 'new-tagged-value' is the converse of 'maybe-coerce'"))
+
 ; 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.