3b7b80304182 — Leonard Ritter 10 days ago
* tukdag: initial support for IL generation
2 files changed, 34 insertions(+), 24 deletions(-)

M lib/tukan/CADAG.sc
M testing/test_cadag.sc
M lib/tukan/CADAG.sc +29 -22
@@ 486,14 486,6 @@ type+ CADAG
                 fn typenameof (cls typeid)
                     _get-typename typeid
 
-        let HandleType =
-            type (.. name "Handle") < Handle : (tuple u32 u32 @u32)
-                let CADAGType = T
-
-        let MutableHandleType =
-            type (.. name "MutableHandle") < Handle : (tuple u32 u32 (mutable @u32))
-                let CADAGType = T
-
         let BuilderType =
             type (.. name "Builder") < CADAGBuilder :: (storageof T)
                 let CADAGType = T

          
@@ 512,6 504,14 @@ type+ CADAG
                         sc_default_styler style-operator ":"
                         repr (typeof self)
 
+        let HandleType =
+            type (.. name "Handle") < Handle : (tuple TypeIdType u32 @u32)
+                let CADAGType = T
+
+        let MutableHandleType =
+            type (.. name "MutableHandle") < Handle : (tuple TypeIdType u32 (mutable @u32))
+                let CADAGType = T
+
         let IdType =
             type (.. name "Id") < Id
                 let CADAGType = T

          
@@ 653,22 653,23 @@ type+ CADAG
         let cls = (typeof self)
         let visit =
             va-option visit ...
-                inline (md ptr)
-                    report "done" md.id (string ('typenameof cls md.typeid))
+                inline (module id)
+                    let handle = ('handleof module id)
+                    report "done" id handle.name
         let on-enter =
             va-option on-enter ...
-                inline (id)
+                inline (module id) true
         local stack : DescendStack
         local seen : (Set u32)
-        'push stack self root
+        if (on-enter (view self) root)
+            'push stack self root
         loop ()
             let md = ('peek stack)
             let ofs = ('enum-id-offset cls (copy md.typeid) (copy md.refindex))
             let wordofs = (ofs // u32_size)
             if (wordofs >= md.size)
-                let stackptr = (& (self.words @ md.offset))
                 let oldid = (copy md.id)
-                visit md stackptr
+                visit (view self) oldid
                 # clear
                 'pop stack
                 if (empty? stack)

          
@@ 681,8 682,8 @@ type+ CADAG
                 let nextid = (copy (self.words @ ofs))
                 if (not ('in? seen nextid))
                     'insert seen nextid
-                    on-enter nextid
-                    'push stack self nextid
+                    if (on-enter (view self) nextid)
+                        'push stack self nextid
 
     struct TransformStack
         data : (Array u32)

          
@@ 705,7 706,8 @@ type+ CADAG
             let ptr = ('load module id)
             let dataoffset = (countof data)
             'resize data (dataoffset + sz)
-            memcpy (& (data @ dataoffset)) ptr (u32_size * sz)
+            if (sz != 0)
+                memcpy (& (data @ dataoffset)) ptr (u32_size * sz)
             'append metadata
                 StackEntry
                     id = id

          
@@ 748,11 750,16 @@ type+ CADAG
             let wordofs = (ofs // u32_size)
             vvv bind oldid newid
             if (wordofs >= md.size)
-                let stackptr = (& (stack.data @ md.offset))
+                let stackptr =
+                    if md.size (& (stack.data @ md.offset))
+                    else (null as (mutable @u32))
                 capture finalize () {&newmodule &md stackptr &dedup_map}
                     let dedup? = ('do-dedup? cls md.typeid)
                     if dedup?
-                        let digest = (sha256 (bitcast stackptr rawstring) (u32_size * md.size))
+                        local sha : SHA256
+                        'hash sha (bitcast &md.typeid rawstring) u32_size
+                        'hash sha (bitcast stackptr rawstring) (u32_size * md.size)
+                        let digest = ('digest sha)
                         let digest = (@ (bitcast &digest @u256))
                         try
                             return (copy ('get dedup_map digest))

          
@@ 813,7 820,7 @@ type+ CADAG
                     let ptr = (@ ptr)
                     va-map
                         inline (i)
-                            (extractvalue ptr i) = (imply (va@ i ...) (va@ i ET...))
+                            (extractvalue ptr i) = (va@ i ...)
                         va-range ETcount
                     id
             else

          
@@ 897,8 904,8 @@ type+ CADAG
     fn dump (self)
         descend self ('rootid self)
             visit =
-                capture (md ptr) {&self}
-                    print ('repr self md.id)
+                capture (module id) {}
+                    print ('repr module id)
 
 do
     let CADAG RIFF riff->string

          
M testing/test_cadag.sc +5 -2
@@ 57,23 57,26 @@ do
     let strtype = (tuple (array char))
     define-type "str" (RIFF "STR*") strtype
 
+    define-type "empty" (RIFF "EMPT") (tuple)
+
     # instantiate a module
     local module : TestDAG
 
     from (methodsof module) let store load rootid headerof transform descend alloc
 
-    from (methodsof module.builder) let const const2 vec3 u32x str
+    from (methodsof module.builder) let const const2 vec3 u32x str empty
 
     # store 4 nodes in DAG
     let k = (const 10:u32)
     let m = (const2 20:u32)
     let p = (str "foo" 32:char "bar")
+    let q = (empty)
     u32x 25
         i32_id 1 k
         i32_id 2 m
         i32_id 3 p
         i32_id 4
-            vec3 k k m
+            vec3 k q m
 
     # perform a topological transform where we increment the constant values
     let newmodule newid =