130 - build maybe-coerce in mu

This is more likely to be right. But the limitations of symbolic
locations are starting to be a drag. Time to build lexical scope.

2 files changed, 32 insertions, 25 deletions

diff --git a/mu.arc b/mu.arc
index 68f5807d..1a82c2c5 100644
--- a/mu.arc
+++ b/mu.arc
@@ -9,7 +9,7 @@
         initialization-fns*))
 
 (mac init-fn (name . body)
-  `(enq (fn () (= (function* ',name) ',body))
+  `(enq (fn () (= (function* ',name) (convert-braces ',body)))
         initialization-fns*))
 
 ; things that a future assembler will need separate memory for:
@@ -91,9 +91,12 @@
 
 (def sz (operand)
 ;?   (prn "sz " operand)
-  (if typeinfo.operand!array
-    array-len.operand
-    typeinfo.operand!size))
+  (if (is 'literal ty.operand)
+        'literal
+      (let-or it typeinfo.operand (err "no such type: @operand")
+        (if it!array
+          array-len.operand
+          it!size))))
 (defextend sz (typename) (isa typename 'sym)
   (or types*.typename!size
       (err "type @typename doesn't have a size: " (tostring:pr types*.typename))))
@@ -353,22 +356,6 @@
                       array-len.base
                       -1))
 
-                ; dynamic types
-                maybe-coerce
-;?                 (do (prn "AAA " arg.0 " " arg.1)
-;?                   (prn (m arg.0))
-;?                   (prn `(,(v arg.0) type))
-;?                   (prn "DDD " (m `(,(v arg.0) type)))
-;?                   (prn (+ 1 (v arg.0)))
-;?                   (prn `(,(+ 1 (v arg.0)) ,(m arg.1)))
-;?                   (prn (m `(,(+ 1 (v arg.0)) ,(m arg.1))))
-                  (if (is (m arg.1) (m `(,(v arg.0) type)))
-                    (list (m `(,(+ 1 (v arg.0)) ,(m arg.1)))
-                          t)
-                    (list 0
-                          nil))
-;?                   )
-
                 ; multiprocessing
                 run
                   (run (v arg.0))
@@ -401,8 +388,7 @@
                              arg.0
                              (do1 caller-arg-idx.context
                                 (++ caller-arg-idx.context)))
-;?                     (prn idx)
-;?                     (prn caller-args.context)
+;?                     (prn arg " " idx " " caller-args.context)
                     (m caller-args.context.idx))
                 type
                   (ty (caller-args.context arg.0))
@@ -412,7 +398,9 @@
                   (do (pop-stack context)
                       (if empty.context (return ninstrs))
                       (let (caller-oargs _ _)  (parse-instr (body.context pc.context))
+;?                         (prn arg " " caller-oargs)
                         (each (dest src)  (zip caller-oargs arg)
+;?                           (prn src " => " dest)
                           (setm dest  (m src))))
                       (++ pc.context)
                       (while (>= pc.context (len body.context))
@@ -550,6 +538,24 @@
   (pr msg)
   (apply prn args))
 
+;; system software
+
+(init-fn maybe-coerce
+  ((23 tagged-value) <- arg)
+  ((p type) <- arg)
+  ((xtype type) <- get (23 tagged-value) (0 offset))
+  ((match? boolean) <- eq (xtype type) (p type))
+  { begin
+    (breakif (match? boolean))
+    (reply (0 literal) (nil boolean))
+  }
+  ((xvalue location) <- get (23 tagged-value) (1 offset))
+  (reply (xvalue location) (match? boolean)))
+
+; drop all traces while processing above functions
+(on-init
+  (= traces* (queue)))
+
 ;; after loading all files, start at 'main'
 (reset)
 (awhen cdr.argv
diff --git a/mu.arc.t b/mu.arc.t
index a784709d..a6ced345 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -138,7 +138,7 @@
               integer-integer-pair (obj size 2  record t  elems '(integer integer))
               integer-point-pair (obj size 2  record t  elems '(integer integer-integer-pair))
               ; tagged-values are the foundation of dynamic types
-              tagged-value (obj size 2  record t  elems '(type address))
+              tagged-value (obj size 2  record t  elems '(type location))
               )))
 
 ; Our language is assembly-like in that functions consist of series of
@@ -606,14 +606,15 @@
 
 (reset)
 (new-trace "tagged-value")
+;? (set dump-trace*)
 (add-fns
   '((test1
       ((1 type) <- copy (integer-address literal))
-      ((2 integer-address) <- copy (3 literal))
+      ((2 integer-address) <- copy (34 literal))
       ((3 integer-address) (4 boolean) <- maybe-coerce (1 tagged-value) (integer-address literal)))))
 (run 'test1)
 ;? (prn memory*)
-(if (~iso memory* (obj 1 'integer-address  2 3  3 3  4 t))
+(if (or (~is memory*.3 34) (~is memory*.4 t))
   (prn "F - 'maybe-coerce' copies value only if type tag matches"))
 
 ; Just like the table of types is centralized, functions are conceptualized as