34204081dba4 — Leonard Ritter 4 months ago
* zarray related fixes
5 files changed, 53 insertions(+), 50 deletions(-)

M lib/tukan/CADAG/init.sc
M lib/tukan/FIR.sc
M lib/tukan/gl.sc
M lib/tukan/vm.sc
M testing/tukdag.sc
M lib/tukan/CADAG/init.sc +10 -7
@@ 168,7 168,8 @@ fn... _gen-id-offset-func (QT : type)
     _ idoffsets nextindex
 
 spice gen-id-offset-func (QT)
-    _gen-id-offset-func (QT as type)
+    let f = (_gen-id-offset-func (QT as type))
+    f
 
 fn _flexible-struct-type (T)
     let T = ('storageof T)

          
@@ 263,7 264,7 @@ fn value-typeid-repr (T value sz)
         let body = (sc_expression_new)
         let SZ = (('sizeof ST) as u32)
         vvv bind str
-        fold (str = `"") for i ET in (enumerate ('elements ST))
+        fold (str = `(string "")) for i ET in (enumerate ('elements ST))
             if ('unsized? ET) # last element
                 let ET = ('element@ ET 0)
                 let ETsz = (('sizeof ET) as u32)

          
@@ 283,7 284,7 @@ fn value-typeid-repr (T value sz)
                             let numelements = ((sz * u32_size - SZ) // ETsz)
                             let arr = (value @ i)
                             let str =
-                                loop (k str = 0:u32 str)
+                                loop (k str = 0:u32 (string str))
                                     if (k == numelements)
                                         break str
                                     let elem = (arr @ k)

          
@@ 535,7 536,9 @@ type CADAG < Struct
                 else
                     unreachable;
             error
-                .. "typeid " (repr code) " already mapped to type " (repr info.T)
+                .. "CADAG: type `" name "` uses typeid " (repr code)
+                    \ ", but it is already mapped to type " info.name
+                    \ " : " (repr info.T)
 
         'set self.typeid->info-map code (deref ti)
 

          
@@ 617,9 620,9 @@ type TypeId < CEnum
     fn _name (self)
         'dispatch self
             inline "#hidden" (code cls)
-                x := (('typeinfo cls code) . name) as rawstring
+                x := (('typeinfo cls code) . name)
                 static-assert (constant? x)
-                x
+                x as rawstring
 
     let dedup? = (Accessor (inline (self) ('_dedup? (copy self))))
     let name = (Accessor (inline (self) ('_name (copy self))))

          
@@ 716,7 719,7 @@ type+ CADAG
                 inline __typecall (cls typeid)
                     let info = ('typeinfo typeid)
                     let T =
-                        type (.. "(" (tostring cls) " " info.name ")") < cls : u32
+                        type (.. "(" (tostring cls) " " (info.name as zarray) ")") < cls : u32
                             let Type = info.T
                             let TypeId = typeid
                             let Name = info.name

          
M lib/tukan/FIR.sc +6 -6
@@ 169,7 169,7 @@ let
 
 define-type "cell" (RIFF "CELL") (tuple (items = (array AnyId)))
     instrcolor...
-define-type "text" (RIFF "TEXT") (tuple (chars = (array char)))
+define-type "blob" (RIFF "BLOB") (tuple (chars = (array char)))
     stringcolor...
 define-type "symbol" (RIFF "SYMN") (tuple (string = AnyId))
     stringcolor...

          
@@ 999,7 999,7 @@ fn generate-IL (module rootid)
                 spice-quote
                     let pg = (Program)
                     call
-                        attach-shaders pg
+                        attach-shaders (view pg)
                             compute = main
                             debug = true
                     let ptr = [(getglprogram self.setup-ctx offset)]

          
@@ 1021,7 1021,7 @@ fn generate-IL (module rootid)
                 spice-quote
                     let pg = (Program)
                     call
-                        attach-shaders pg
+                        attach-shaders (view pg)
                             vertex = vertex-main
                             fragment = fragment-main
                             debug = true

          
@@ 1394,7 1394,7 @@ fn generate-IL (module rootid)
         for i in (range numbindings)
             let bindid = (copy (bindings @ i))
             let bhandle = ('handleof module bindid)
-            dispatch bhandle
+            dispatch (view bhandle)
             case rbind (rbind)
                 let v k = rbind.source rbind.target
                 let khandle = ('handleof module k)

          
@@ 1447,7 1447,7 @@ fn generate-IL (module rootid)
                                 BindFramebuffer FRAMEBUFFER fboptr
                         fbo = fbo-offset
                         ;
-                    let fbo-offset = ('force-unwrap fbo)
+                    let fbo-offset = ('force-unwrap (view fbo))
                     let fbosetupptr = (getgluint ctx.setup-ctx fbo-offset)
                     let imageoffset = (get v)
                     let svptr = (getgluint ctx.setup-ctx imageoffset)

          
@@ 1507,7 1507,7 @@ fn generate-IL (module rootid)
                     let status = (CheckNamedFramebufferStatus
                         fbosetupptr FRAMEBUFFER)
                     assert (status == FRAMEBUFFER_COMPLETE)
-                        .. "Framebuffer incomplete: " (framebuffer-status status)
+                        .. "Framebuffer incomplete: " (string (framebuffer-status status))
 
     fn visit (module id ctx)
         if ('in? ctx.values id)

          
M lib/tukan/gl.sc +33 -33
@@ 596,20 596,20 @@ fn image-format (gl-format)
 
 fn framebuffer-status (status)
     match status
-    case GL.FRAMEBUFFER_COMPLETE "COMPLETE"
-    case GL.FRAMEBUFFER_UNDEFINED "UNDEFINED"
-    case GL.FRAMEBUFFER_INCOMPLETE_ATTACHMENT "INCOMPLETE_ATTACHMENT"
-    case GL.FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT "INCOMPLETE_MISSING_ATTACHMENT"
-    case GL.FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT "INCOMPLETE_DIMENSIONS"
-    case GL.FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER "INCOMPLETE_DRAW_BUFFER"
-    case GL.FRAMEBUFFER_INCOMPLETE_FORMATS_EXT "INCOMPLETE_FORMATS"
-    case GL.FRAMEBUFFER_INCOMPLETE_LAYER_COUNT_ARB "INCOMPLETE_LAYER_COUNT"
-    case GL.FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS "INCOMPLETE_LAYER_TARGETS"
-    case GL.FRAMEBUFFER_INCOMPLETE_READ_BUFFER "INCOMPLETE_READ_BUFFER"
-    case GL.FRAMEBUFFER_UNSUPPORTED "UNSUPPORTED"
-    case GL.FRAMEBUFFER_INCOMPLETE_MULTISAMPLE "INCOMPLETE_MULTISAMPLE"
-    case GL.FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS "INCOMPLETE_LAYER_TARGETS"
-    default "?"
+    case GL.FRAMEBUFFER_COMPLETE &"COMPLETE"
+    case GL.FRAMEBUFFER_UNDEFINED &"UNDEFINED"
+    case GL.FRAMEBUFFER_INCOMPLETE_ATTACHMENT &"INCOMPLETE_ATTACHMENT"
+    case GL.FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT &"INCOMPLETE_MISSING_ATTACHMENT"
+    case GL.FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT &"INCOMPLETE_DIMENSIONS"
+    case GL.FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER &"INCOMPLETE_DRAW_BUFFER"
+    case GL.FRAMEBUFFER_INCOMPLETE_FORMATS_EXT &"INCOMPLETE_FORMATS"
+    case GL.FRAMEBUFFER_INCOMPLETE_LAYER_COUNT_ARB &"INCOMPLETE_LAYER_COUNT"
+    case GL.FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS &"INCOMPLETE_LAYER_TARGETS"
+    case GL.FRAMEBUFFER_INCOMPLETE_READ_BUFFER &"INCOMPLETE_READ_BUFFER"
+    case GL.FRAMEBUFFER_UNSUPPORTED &"UNSUPPORTED"
+    case GL.FRAMEBUFFER_INCOMPLETE_MULTISAMPLE &"INCOMPLETE_MULTISAMPLE"
+    case GL.FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS &"INCOMPLETE_LAYER_TARGETS"
+    default &"?"
 
 #-------------------------------------------------------------------------------
 

          
@@ 926,31 926,31 @@ fn print-gl-info ()
 fn hook-gl-debug ()
     fn gl-debug-source (source)
         match source
-        case GL.DEBUG_SOURCE_API                "API"
-        case GL.DEBUG_SOURCE_WINDOW_SYSTEM      "Window System"
-        case GL.DEBUG_SOURCE_SHADER_COMPILER    "Shader Compiler"
-        case GL.DEBUG_SOURCE_THIRD_PARTY        "Third Party"
-        case GL.DEBUG_SOURCE_APPLICATION        "Application"
-        case GL.DEBUG_SOURCE_OTHER              "Other"
-        default                                 "?"
+        case GL.DEBUG_SOURCE_API                &"API"
+        case GL.DEBUG_SOURCE_WINDOW_SYSTEM      &"Window System"
+        case GL.DEBUG_SOURCE_SHADER_COMPILER    &"Shader Compiler"
+        case GL.DEBUG_SOURCE_THIRD_PARTY        &"Third Party"
+        case GL.DEBUG_SOURCE_APPLICATION        &"Application"
+        case GL.DEBUG_SOURCE_OTHER              &"Other"
+        default                                 &"?"
 
     fn gl-debug-type (type_)
         match type_
-        case GL.DEBUG_TYPE_ERROR                "Error"
-        case GL.DEBUG_TYPE_DEPRECATED_BEHAVIOR  "Deprecated"
-        case GL.DEBUG_TYPE_UNDEFINED_BEHAVIOR   "Undefined Behavior"
-        case GL.DEBUG_TYPE_PORTABILITY          "Portability"
-        case GL.DEBUG_TYPE_PERFORMANCE          "Performance"
-        case GL.DEBUG_TYPE_OTHER                "Other"
-        default                                 "?"
+        case GL.DEBUG_TYPE_ERROR                &"Error"
+        case GL.DEBUG_TYPE_DEPRECATED_BEHAVIOR  &"Deprecated"
+        case GL.DEBUG_TYPE_UNDEFINED_BEHAVIOR   &"Undefined Behavior"
+        case GL.DEBUG_TYPE_PORTABILITY          &"Portability"
+        case GL.DEBUG_TYPE_PERFORMANCE          &"Performance"
+        case GL.DEBUG_TYPE_OTHER                &"Other"
+        default                                 &"?"
 
     fn gl-debug-severity (severity)
         match severity
-        case GL.DEBUG_SEVERITY_HIGH             "High"
-        case GL.DEBUG_SEVERITY_MEDIUM           "Medium"
-        case GL.DEBUG_SEVERITY_LOW              "Low"
-        case GL.DEBUG_SEVERITY_NOTIFICATION     "Notification"
-        default                                 "?"
+        case GL.DEBUG_SEVERITY_HIGH             &"High"
+        case GL.DEBUG_SEVERITY_MEDIUM           &"Medium"
+        case GL.DEBUG_SEVERITY_LOW              &"Low"
+        case GL.DEBUG_SEVERITY_NOTIFICATION     &"Notification"
+        default                                 &"?"
 
     fn gl-debug-callback (source type_ id_ severity length message userparams)
         #void <- (GLenum GLenum GLuint GLenum GLsizei GLchar* void*)

          
M lib/tukan/vm.sc +1 -1
@@ 223,7 223,7 @@ fn... runvm (
                 do
                     let pg = (GL.Program)
                     call
-                        attach-shaders pg
+                        attach-shaders (view pg)
                             vertex = present.vertex-main
                             fragment = present.fragment-main
                     pg

          
M testing/tukdag.sc +3 -3
@@ 376,7 376,7 @@ fn... parse-scopes-list (module : FIR, v
         for i entry in (enumerate l u32)
             items @ i = (recur module entry)
         let expr =
-            'alloc module TypeId.typeid_expr (countof l)
+            'alloc module TypeId.typeid_cell (countof l)
         let args = expr.items
         for i in (range count)
             args @ i = items @ i

          
@@ 487,7 487,7 @@ inline graphviz (rootid)
 
 #let prog = (gen-level1-test-geometry)
 #let prog = (gen-level1-test)
-let prog =
+#let prog =
     do
         let prog = (gen-level3-test)
         let prog = (cleanup prog)

          
@@ 498,7 498,7 @@ let prog =
         print "lowering..."
         'lower module prog
 
-#let prog =
+let prog =
     do
         let prog = (gen-level2-test-geometry)
         let prog = (cleanup prog)