29cee069efcc — Leonard Ritter 10 days ago
* multiple CADAG types can be mapped to the same native type
2 files changed, 38 insertions(+), 84 deletions(-)

M lib/tukan/CADAG.sc
M testing/test_cadag.sc
M lib/tukan/CADAG.sc +28 -66
@@ 195,13 195,12 @@ spice RIFF (name)
 ################################################################################
 
 struct TypeInfo plain
-    typeid : u32
+    T : type
     name : string
     dedup? : bool = true
 
 struct CADAGEnvData
-    type->info-map : (Map type TypeInfo)
-    typeid->type-map : (Map u32 type)
+    typeid->info-map : (Map u32 TypeInfo)
     name->typeid-map : (Map string u32)
 
     inline __drop (self)

          
@@ 291,23 290,23 @@ type CADAG < Struct
         let self = @@val
         self
 
-    spice typeidof (cls T)
+    #spice typeidof (cls T)
         let self = (getinstance cls)
         T as:= type
-        if (not ('in? self.type->info-map T))
+        if (not ('in? self.typeid->info-map T))
             error
                 .. "type " (repr T) " has no typeinfo"
         ('getdefault self.type->info-map T (TypeInfo 0 "")) . typeid
 
-    spice typeinfo (cls T)
+    spice typeinfo (cls code)
         let self = (getinstance cls)
-        T as:= type
-        if (not ('in? self.type->info-map T))
+        code as:= u32
+        if (not ('in? self.typeid->info-map code))
             error
-                .. "type " (repr T) " has no typeinfo"
-        'getdefault self.type->info-map T (TypeInfo 0 "")
+                .. "typeid " (repr code) " has no typeinfo"
+        'getdefault self.typeid->info-map code (TypeInfo Nothing "")
 
-    spice typeoftypeid (cls code)
+    #spice typeoftypeid (cls code)
         let self = (getinstance cls)
         cls as:= type
         code as:= u32

          
@@ 332,7 331,7 @@ type CADAG < Struct
                         error
                             .. "cannot dispatch unbound type name: " name
                 let T =
-                    try (deref ('get self.typeid->type-map code))
+                    try (deref (('get self.typeid->info-map code) . T))
                     else Nothing
                 let PT = (pointer.type T)
                 let PT =

          
@@ 357,27 356,19 @@ type CADAG < Struct
         let name =
             if (name == "") (tostring T)
             else name
-        if ('in? self.type->info-map T)
+        if ('in? self.typeid->info-map code)
             let info =
-                try ('get self.type->info-map T)
+                try ('get self.typeid->info-map code)
                 else
                     unreachable;
             error
-                .. "type " (repr T) " already mapped to typeid " (repr info.typeid)
-        if ('in? self.typeid->type-map code)
-            let T =
-                try ('get self.typeid->type-map code)
-                else
-                    unreachable;
-            error
-                .. "typeid " (repr code) " already mapped to type " (repr T)
+                .. "typeid " (repr code) " already mapped to type " (repr info.T)
 
-        'set self.type->info-map T
+        'set self.typeid->info-map code
             TypeInfo
-                typeid = code
+                T = T
                 name = name
                 dedup? = dedup?
-        'set self.typeid->type-map code T
 
         'set self.name->typeid-map name code
 

          
@@ 408,7 399,7 @@ type CADAG < Struct
         'set-symbol factory (Symbol name)
             spice-quote
                 inline (self ...)
-                    'store (bitcast self cls) T ...
+                    'store (bitcast self cls) code ...
 
         ;
 

          
@@ 539,9 530,9 @@ type+ CADAG
         deref ('last self.words)
 
     @@ memo
-    inline alloc-func (cls T)
+    inline alloc-func (cls typeid)
+        let T = (('typeinfo cls typeid) . T)
         let ET = (flexible-struct-type T)
-        typeid := ('typeidof cls T)
         IdType := (Id T)
         static-assert ((alignof T) <= 4)
             .. "type " (tostring T) " must have alignment <= 4, but has "

          
@@ 562,8 553,8 @@ type+ CADAG
                 let a b = (allocate self typeid sz)
                 _ (bitcast a IdType) (bitcast b (mutable @T))
 
-    inline... alloc (self, T : type, ...)
-        (alloc-func (typeof self) T) self ...
+    inline... alloc (self, typeid : u32, ...)
+        (alloc-func (typeof self) typeid) self ...
 
     fn... handleof (self, offset : u32)
         let cls = (typeof self)

          
@@ 762,7 753,8 @@ type+ CADAG
             idref = newid
 
     @@ memo
-    inline store-func (T)
+    inline store-func (cls typeid)
+        let T = (('typeinfo cls typeid) . T)
         static-if ((storageof T) < aggregate)
             let ET idx = (flexible-struct-type T)
             let ET... =

          
@@ 772,7 764,7 @@ type+ CADAG
             let ETcount = (va-countof ET...)
             static-if (ET == Nothing) # not variadic
                 inline (self ...)
-                    let id ptr = (alloc self T)
+                    let id ptr = (alloc self typeid)
                     let ptr = (@ ptr)
                     va-map
                         inline (i)

          
@@ 795,7 787,7 @@ type+ CADAG
                                         else 1
                                     va-range ETcount argcount
                         else (argcount - ETcount)
-                    let id ptr = (alloc self T extra)
+                    let id ptr = (alloc self typeid extra)
                     let ptr = (@ ptr)
                     va-map
                         inline (i)

          
@@ 824,43 816,13 @@ type+ CADAG
                     id
         else
             inline (self value)
-                let id ptr = (alloc self T)
+                let id ptr = (alloc self typeid)
                 let ptr = (@ ptr)
                 ptr = value
                 id
 
-    inline... store (self, T : type, ...)
-        (store-func T) self ...
-    case (self, value)
-        (store-func (typeof value)) self value
-    #
-        let T = (typeof value)
-
-        let ET idx = (flexible-struct-type T)
-        let argcount = (va-countof ...)
-        static-if (ET == Nothing) # not variadic
-
-        else # variadic
-        let id ptr = (alloc self T extra)
-
-        let id ptr = (alloc self T)
-
-        @ptr = value
-        id
-    #case (self, value, ...)
-        let T = (typeof value)
-        let ET idx = (flexible-struct-type T)
-        static-assert (ET != Nothing)
-        let extra = (va-countof ...)
-        let id ptr = (alloc self T extra)
-        let ptr = (@ ptr)
-        ptr = value
-        let tail = (extractvalue ptr idx)
-        va-map
-            inline (i)
-                tail @ i = (va@ i ...)
-            va-range extra
-        id
+    inline... store (self, typeid : u32, ...)
+        (store-func (typeof self) typeid) self ...
 
     fn offsetof (self id)
         (id as u32) + 2

          
M testing/test_cadag.sc +10 -18
@@ 4,9 4,8 @@ using import Capture
 import ..lib.tukan.use
 using import tukan.CADAG
 
-inline print-offsets (cls T)
-    typeid := ('typeidof cls T)
-    report T "typeid" typeid "offsets:"
+inline print-offsets (cls typeid)
+    report "typeid" typeid "offsets:"
     for i in (infinite-range usize)
         ofs := ('enum-id-offset cls typeid i)
         if (ofs > 200:usize)

          
@@ 29,7 28,7 @@ do
             u32
             array (tuple u32 (Id u32))
     define-type T "testT" 10:u32
-    print-offsets M T
+    print-offsets M 10:u32
     print "done."
 
 do

          
@@ 42,6 41,9 @@ do
     define-type u32 "const" (RIFF "CNST")
         #dedup = false
 
+    define-type u32 "const2" (RIFF "CNS2")
+        #dedup = false
+
     let u32x3 = (array (Id u32) 3)
     define-type u32x3 "vec3" (RIFF "VEC3")
 

          
@@ 57,28 59,18 @@ do
 
     from (methodsof module) let store load rootid headerof transform descend alloc
 
-    from (methodsof module.factory) let const vec3 u32x str
+    from (methodsof module.factory) let const const2 vec3 u32x str
 
     # store 4 nodes in DAG
     let k = (const 10:u32)
-    let m = (const 20:u32)
+    let m = (const2 20:u32)
+    let p = (str "foo" 32:char "bar")
     u32x 25
         i32_id 1 k
         i32_id 2 m
-        i32_id 3 k
+        i32_id 3 p
         i32_id 4
             vec3 k k m
-    str "foo" 32:char "bar"
-
-    #do
-        let s = "test"
-        let count = ((countof s) as u32)
-        let id ptr = (alloc strtype (count + 1))
-        do
-            let p = (s as rawstring)
-            let ptr = ((@ ptr) @ 0)
-            for i in (range count)
-                ptr @ i = p @ i
 
     # perform a topological transform where we increment the constant values
     let newmodule newid =