3b47817eed98 — Leonard Ritter 10 days ago
* special repr and constructor support for strings
2 files changed, 99 insertions(+), 39 deletions(-)

M lib/tukan/CADAG.sc
M testing/test_cadag.sc
M lib/tukan/CADAG.sc +69 -33
@@ 228,15 228,25 @@ fn value-typeid-repr (T value sz)
     pass type-kind-array
     pass type-kind-tuple
     do
-        if (('sizeof ST) == 0) `""
-        else
-            let value = `(storagecast value)
-            let body = (sc_expression_new)
-            let SZ = (('sizeof ST) as u32)
-            fold (str = `"") for i ET in (enumerate ('elements ST))
-                if ('unsized? ET) # last element
-                    let ET = ('element@ ET 0)
-                    let ETsz = (('sizeof ET) as u32)
+        let value = `(storagecast value)
+        let body = (sc_expression_new)
+        let SZ = (('sizeof ST) as u32)
+        vvv bind str
+        fold (str = `"") for i ET in (enumerate ('elements ST))
+            if ('unsized? ET) # last element
+                let ET = ('element@ ET 0)
+                let ETsz = (('sizeof ET) as u32)
+                if (ET == char)
+                    sc_expression_append body
+                        spice-quote
+                            let numelements = ((sz * u32_size - SZ) // ETsz)
+                            let arr = (value @ i)
+                            let str =
+                                .. str " "
+                                    repr
+                                        string (& (arr @ 0)) numelements
+                    str
+                else
                     sc_expression_append body
                         spice-quote
                             let numelements = ((sz * u32_size - SZ) // ETsz)

          
@@ 246,20 256,21 @@ fn value-typeid-repr (T value sz)
                                     if (k == numelements)
                                         break str
                                     let elem = (arr @ k)
-                                    _ (k + 1)
-                                        .. str
-                                            spice-unquote
-                                                this-function ET elem 0
+                                    let elemrepr =
+                                        spice-unquote
+                                            this-function ET elem 0
+                                    _ (k + 1) (.. str elemrepr)
                     str
-                else
-                    spice-quote
-                        let str =
-                            .. str " "
-                                spice-unquote
-                                    repr-atomic-value ET `(value @ i)
-                    sc_expression_append body str
-                    str
-            body
+            else
+                spice-quote
+                    let str =
+                        .. str " "
+                            spice-unquote
+                                repr-atomic-value ET `(value @ i)
+                sc_expression_append body str
+                str
+        sc_expression_append body str
+        body
     default
         `(.. " " [(repr-atomic-value T value)])
 

          
@@ 443,6 454,11 @@ type Handle
 type CADAGFactory
 
 type+ CADAG
+    let factory =
+        Accessor
+            inline (value key)
+                let cls = (typeof value)
+                bitcast (view value) cls.FactoryType
 
     inline new-type (name)
         let T =

          
@@ 471,12 487,6 @@ type+ CADAG
                 fn typenameof (cls typeid)
                     _get-typename typeid
 
-                let factory =
-                    Accessor
-                        inline (value key)
-                            let cls = (typeof value)
-                            bitcast (view value) cls.FactoryType
-
         let HandleType =
             type (.. name "Handle") < Handle : (tuple u32 u32 @u32)
                 let CADAGType = T

          
@@ 770,10 780,21 @@ type+ CADAG
                         va-range ETcount
                     id
             else
+                let string? = (ET == char)
                 let ETcount = (ETcount - 1)
                 inline (self ...)
                     let argcount = (va-countof ...)
-                    let extra = (argcount - ETcount)
+                    let extra =
+                        static-if string?
+                            + 1
+                                va-map
+                                    inline (i)
+                                        let arg = (va@ i ...)
+                                        static-if ((typeof arg) == string)
+                                            (countof arg) as i32
+                                        else 1
+                                    va-range ETcount argcount
+                        else (argcount - ETcount)
                     let id ptr = (alloc self T extra)
                     let ptr = (@ ptr)
                     va-map

          
@@ 781,10 802,25 @@ type+ CADAG
                             (extractvalue ptr i) = (va@ i ...)
                         va-range ETcount
                     let tail = (extractvalue ptr idx)
-                    va-map
-                        inline (i)
-                            (extractvalue tail i) = (va@ (i + ETcount) ...)
-                        va-range extra
+                    static-if string?
+                        va-lfold 0
+                            inline (k i idx)
+                                let arg = (va@ i ...)
+                                let dest = (extractvalue tail idx)
+                                static-if ((typeof arg) == string)
+                                    let count = (countof arg)
+                                    memcpy ((& dest) as (mutable @u32))
+                                        \ (arg as rawstring as @u32) count
+                                    idx + count
+                                else
+                                    dest = arg
+                                    idx + 1
+                            va-range ETcount argcount
+                    else
+                        va-map
+                            inline (i)
+                                (extractvalue tail i) = (va@ (i + ETcount) ...)
+                            va-range extra
                     id
         else
             inline (self value)

          
M testing/test_cadag.sc +30 -6
@@ 32,7 32,6 @@ do
     print-offsets M T
     print "done."
 
-
 do
     # generate a new DAG module type
     let TestDAG = (CADAG "TestDAG")

          
@@ 48,24 47,38 @@ do
 
     let i32_id = (tuple i32 AnyId)
     let u32var = (tuple u32 (array i32_id))
-    define-type u32var "u32..." (RIFF "U32*")
+    define-type u32var "u32x" (RIFF "U32*")
+
+    let strtype = (tuple (array char))
+    define-type strtype "str" (RIFF "STR*")
 
     # instantiate a module
     local module : TestDAG
 
-    from (methodsof module) let store load rootid headerof transform descend
+    from (methodsof module) let store load rootid headerof transform descend alloc
 
-    from (methodsof module.factory) let const vec3 u32...
+    from (methodsof module.factory) let const vec3 u32x str
 
     # store 4 nodes in DAG
     let k = (const 10:u32)
     let m = (const 20:u32)
-    u32... 25
+    u32x 25
         i32_id 1 k
         i32_id 2 m
         i32_id 3 k
         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 =

          
@@ 82,8 95,19 @@ do
                         case const (self)
                             print "yes is a const"
                         default;
-                    case u32... (self)
+                    case u32x (self)
                         print ('vacount handle)
+                    case str (self)
+                        ptr := self @ 0
+                        # find last nonzero char
+                        let count =
+                            for i in (rrange ('vacount handle))
+                                if ((ptr @ i) != 0:char)
+                                    break (i + 1)
+                            else 0:u32
+                        print
+                            repr
+                                string (& (ptr @ 0)) count
                     default
                         print "unhandled:" (string handle.name)
                     finalize;