46067f7cb6d1 — Leonard Ritter 2 months ago
* semi-lowered form runs on CADAG
5 files changed, 1863 insertions(+), 460 deletions(-)

M lib/tukan/CADAG/dot.sc
M lib/tukan/CADAG/init.sc
M lib/tukan/gl.sc
M testing/test_cadag.sc
M testing/tukdag.sc
M lib/tukan/CADAG/dot.sc +1 -1
@@ 27,7 27,7 @@ type+ CADAG
         commit tmp
 
         'descend self root
-            visit =
+            on-leave =
                 capture (module id) {&tmp fstream}
                     inline commit ()
                         fstream tmp

          
M lib/tukan/CADAG/init.sc +39 -34
@@ 33,14 33,16 @@ type+ Id
         (storagecast self) as bool
 
     @@ memo
+    inline __rimply (cls T)
+        static-if (cls == u32)
+            static-error "can not implicitly convert u32 to Id"
+
+    @@ memo
     inline __imply (cls T)
-        let AnyId = cls.CADAGType.AnyId
         static-if (T == u32)
             storagecast
         elseif (T == integer)
             storagecast
-        elseif (T == AnyId)
-            inline (self) (bitcast self AnyId)
 
 ################################################################################
 

          
@@ 418,7 420,7 @@ type CADAG < Struct
                 let PT =
                     if mutable? ('mutable PT)
                     else PT
-                sc_switch_append_case sw code `(v (@ (ptr as PT)))
+                sc_switch_append_case sw code ('tag `(v (@ (ptr as PT))) ('anchor arg))
         sw
 
     spice define-type (cls name code T ...)

          
@@ 465,7 467,8 @@ type CADAG < Struct
         let enumval = (sc_const_int_new TypeIdType code)
 
         let namesym = (Symbol name)
-        'set-symbol TypeIdType namesym enumval
+        let typeid_namesym = (Symbol (.. "typeid_" name))
+        'set-symbol TypeIdType typeid_namesym enumval
 
         let code = `code
         let dispatch-any-type = (('@ cls 'dispatch-any-type) as type)

          
@@ 789,11 792,11 @@ type+ CADAG
 
     fn descend (self root ...)
         let cls = (typeof self)
-        let visit =
-            va-option visit ...
+        let on-leave =
+            va-option on-leave ...
                 inline (module id)
                     let handle = ('handleof module id)
-                    report "done" id handle.name
+                    report "done" id (string handle.typeid.name)
         let on-enter =
             va-option on-enter ...
                 inline (module id) true

          
@@ 807,7 810,7 @@ type+ CADAG
             let wordofs = (ofs // u32_size)
             if (wordofs >= md.size)
                 let oldid = (copy md.id)
-                visit (view self) oldid
+                on-leave (view self) (bitcast oldid cls.AnyId)
                 # clear
                 'pop stack
                 if (empty? stack)

          
@@ 861,21 864,22 @@ type+ CADAG
         viewing self
         viewing oldmodule
         let cls = (typeof self)
-        local aliases : (Map u32 u32)
-        let alias =
-            va-option alias ...
-                inline (self oldmodule id)
-                    copy ('get aliases id)
+        local aliases : (Map u32 cls.AnyId)
         let on-enter =
             va-option on-enter ...
                 inline (self oldmodule id)
-        let on-alias =
-            va-option on-alias ...
-                inline (self newid oldmodule oldid)
-                    'set aliases oldid newid
-        let visit =
-            va-option visit ...
-                inline (self handle finalize)
+        let on-enter-param =
+            va-option on-enter-param ...
+                inline (self oldmodule id index paramid)
+                    try (_ false (copy ('get aliases paramid)))
+                    else (_ true cls.NoId)
+        let on-leave-param =
+            va-option on-leave-param ...
+                inline (self oldmodule id index oldparamid newparamid)
+                    'set aliases oldparamid newparamid
+        let on-leave =
+            va-option on-leave ...
+                inline (self oldmodule oldid handle finalize)
                     let newid = (finalize)
                     #report "done" md.id "->" newid (string (get-typename md.typeid))
                     newid

          
@@ 899,34 903,35 @@ type+ CADAG
                 let handle = (bitcast
                     ((storageof cls.MutableHandleType) md.typeid md.size stackptr)
                     cls.MutableHandleType)
-                let newid = (visit self handle finalize)
+                let newid = (on-leave self oldmodule (copy md.id) handle finalize)
                 let oldid = (copy md.id)
-                on-alias self newid oldmodule oldid
                 # clear
                 'pop stack
                 if (empty? stack)
                     return (copy newid)
+                let md = ('peek stack)
+                on-leave-param self oldmodule (copy md.id) ((copy md.refindex) - 1) oldid newid
                 _ oldid (storagecast newid)
             else
                 assert ((ofs % u32_size) == 0)
                 let ofs = (md.offset + 2 + wordofs)
                 md.refoffset = (ofs as u32)
+                let oldid = (copy (stack.data @ ofs))
+                let enter? newid = (on-enter-param self oldmodule (copy md.id) (copy md.refindex) oldid)
+                static-assert ((typeof newid) == cls.AnyId)
                 md.refindex += 1
-                let oldid = (copy (stack.data @ ofs))
-                let newid =
-                    try (alias self oldmodule oldid)
-                    else
-                        # no alias
-                        on-enter self oldmodule oldid
-                        'push stack oldmodule oldid
-                        repeat;
-                _ oldid newid
+                if enter?
+                    on-enter self oldmodule oldid
+                    'push stack oldmodule oldid
+                    repeat;
+                else
+                    _ oldid (storagecast newid)
             # update reference in parent
             let md = ('peek stack)
-            let ofs = ('enum-id-offset ((copy md.typeid) as cls.TypeId) (md.refindex - 1))
             let idref = (stack.data @ md.refoffset)
             assert (idref == oldid)
             idref = newid
+            ;
 
     @@ memo
     inline store-func (typeid)

          
@@ 1036,7 1041,7 @@ type+ CADAG
 
     fn dump (self)
         descend self ('rootid self)
-            visit =
+            on-leave =
                 capture (module id) {}
                     print ('repr module id)
 

          
M lib/tukan/gl.sc +3 -0
@@ 38,6 38,8 @@ fn translate-gl-symbols (scope source)
 
 let GL = ('bind GL 'gladLoadGL _GL.extern.gladLoadGL)
 
+let GLAPI = _GL
+
 unlet _GL
 
 run-stage;

          
@@ 968,5 970,6 @@ let GL = ('bind GL 'GetInteger64 gl-get-
 do
     let print-gl-info hook-gl-debug setup-ubo attach-shaders bind-ubo \
         setup-framebuffer setup-ssbo bind-ssbo GL setup-renderbuffer
+    let GLAPI
 
     locals;

          
M testing/test_cadag.sc +2 -2
@@ 83,8 83,8 @@ do
     local newmodule : TestDAG
     let newid =
         'translate newmodule module ('rootid module)
-            visit =
-                capture (module handle finalize) {}
+            on-leave =
+                capture (module oldmodule oldid handle finalize) {}
                     dispatch handle
                     case const (self)
                         print self

          
M testing/tukdag.sc +1818 -423
@@ 9,7 9,7 @@ using import glm
 import ..lib.tukan.use
 using import tukan.CADAG
 using import tukan.CADAG.dot
-
+using import tukan.gl
 using import tukan.vm
 
 let SYSKEY_START = 0x80000000:u32

          
@@ 145,7 145,7 @@ enum ImageFormat : u32
 
 # generate a new DAG module type
 let FIR = (CADAG "FIR")
-from FIR let AnyId NoId Id
+from FIR let AnyId NoId Id TypeId
 from (methodsof FIR) let define-type
 
 let

          
@@ 157,74 157,33 @@ let
     instrcolor... = (_ (dot.fontcolor = "#de5f84") (dot.color = "#de5f84"))
     commentcolor... = (_ (dot.fontcolor = "#969896") (dot.color = "#969896"))
 
-define-type "ILString"          (RIFF "ISTR") (tuple (size = u32) (str = (array char)))
-    stringcolor...
-define-type "ILSymbol"          (RIFF "ISYM") (tuple (string = AnyId))
-    constcolor...
-define-type "ILBuiltin"         (RIFF "IBLT") (tuple (symbol = AnyId))
-    constcolor...
-define-type "ILConstInt"        (RIFF "ICIN") (tuple (type = AnyId) (value = u32))
-    constcolor...
-define-type "ILConstReal"       (RIFF "ICRE") (tuple (type = AnyId) (value = f32))
-    constcolor...
-define-type "ILParams"          (RIFF "IPMS") (tuple (level = i32) (count = i32))
-    dedup = false
-define-type "ILUndef"           (RIFF "IUDF") (tuple (type = AnyId))
-define-type "ILVAGet"           (RIFF "IGET") (tuple (index = i32) (args = AnyId))
-define-type "ILVA"              (RIFF "ILVA") (tuple (args = (array AnyId)))
-define-type "ILTemplate"        (RIFF "ITMP") (tuple (params = AnyId) (body = AnyId))
-    dedup = false
-    funccolor...
-define-type "ILDo"              (RIFF "IRDO") (tuple (scoped? = bool) (body = (array AnyId)))
-    dedup = false
-    instrcolor...
-define-type "ILKeyed"           (RIFF "IKEY") (tuple (symbol = AnyId) (value = AnyId))
-    dedup = false
-define-type "ILCall"            (RIFF "ICAL") (tuple (callee = AnyId) (args = (array AnyId)))
-    dedup = false
-    instrcolor...
-define-type "ILNoReturnType"    (RIFF "INRT") (tuple)
-    typecolor...
-define-type "ILIntegerType"     (RIFF "IINT") (tuple (width = i32) (signed? = bool))
-    typecolor...
-define-type "ILRealType"        (RIFF "IREA") (tuple (width = i32))
-    typecolor...
-define-type "ILVectorType"        (RIFF "IVET") (tuple (element = AnyId) (count = i32))
+################################################################################
+
+define-type "uniform"       (RIFF "UNIF") (tuple (type = AnyId) (location = u32))
+define-type "image"         (RIFF "IMGT") (tuple (dim = ImageDim) (format = ImageFormat) (array? = bool) (ms? = bool))
+define-type "wimage"        (RIFF "WIMG") (tuple (type = AnyId) (binding = u32))
+define-type "load"          (RIFF "LOAD") (tuple (pointer = AnyId))
+define-type "getelementptr" (RIFF "GELP") (tuple (value = AnyId) (indices = (array AnyId)))
+define-type "globalid"      (RIFF "GLID") (tuple)
+define-type "imagewrite"    (RIFF "IMGW") (tuple (element = AnyId) (offset = AnyId) (target = AnyId))
+define-type "computefn"     (RIFF "CMFN") (tuple (x = u32) (y = u32) (z = u32) (body = AnyId))
+define-type "bindings"      (RIFF "BIND") (tuple (entries = (array (tuple AnyId AnyId))))
+define-type "imagestorage"  (RIFF "IMST") (tuple (type = AnyId) (x = u32) (y = u32) (z = u32) (levels = u32) (samples = u32))
+define-type "dispatch"      (RIFF "DISP") (tuple (func = AnyId) (x = AnyId) (y = AnyId) (z = AnyId) (sources = AnyId) (sinks = AnyId))
+define-type "rimage"        (RIFF "RIMG") (tuple (type = AnyId) (binding = u32))
+define-type "mimage"        (RIFF "MIMG") (tuple (type = AnyId) (binding = u32))
+define-type "rssbo"         (RIFF "RSBO") (tuple (type = AnyId) (binding = u32))
+define-type "wssbo"         (RIFF "WSBO") (tuple (type = AnyId) (binding = u32))
+define-type "mssbo"         (RIFF "MSBO") (tuple (type = AnyId) (binding = u32)) # mutable SSBO
+define-type "store"         (RIFF "STOR") (tuple (value = AnyId) (pointer = AnyId))
+define-type "bufferstorage" (RIFF "BFST") (tuple (size = u32))
+define-type "idispatch"     (RIFF "IDSP") (tuple (callee = AnyId) (size = AnyId) (sources = AnyId) (sinks = AnyId))
+
+################################################################################
+
+define-type "fvec"      (RIFF "FVEC") (tuple (count = u32))
     typecolor...
-define-type "ILArgumentsType"   (RIFF "IATY") (tuple (types = (array AnyId)))
-    typecolor...
-define-type "ILStringType"      (RIFF "ISTY") (tuple)
-    typecolor...
-define-type "ILFunctionType"    (RIFF "IFTY") (tuple (return = AnyId) (raise = AnyId) (params = (array AnyId)))
-    typecolor...
-define-type "ILGlobal"          (RIFF "IGLO")
-    tuple (name = AnyId) (type = AnyId) (flags = u32) (storage = AnyId) (attrs = (array AnyId))
-    funccolor...
-define-type "ILIf"              (RIFF "ILIF") (tuple (cond = AnyId) (then = AnyId) (else = AnyId))
-    dedup = false
-    instrcolor...
-define-type "ILXValue"          (RIFF "ILXV")
-    type ILXValueType <: (tuple u32 u32 u32 u32)
-        @@ memo
-        inline __as (cls T)
-            static-if (T == Value)
-                fn (self)
-                    let w0 w1 w2 w3 = (unpack self)
-                    let u128 = (integer 128)
-                    local value =
-                        |
-                            w0 as u128
-                            (w1 as u128) << 32
-                            (w2 as u128) << 64
-                            (w3 as u128) << 96
-                    deref (@ (bitcast (& value) @Value))
-
-        inline __CADAG_repr (self)
-            repr (self as Value)
-
-define-type "fvec"      (RIFF "FVEC") (tuple (count = i32))
-    typecolor...
-define-type "uvec"      (RIFF "UVEC") (tuple (count = i32))
+define-type "uvec"      (RIFF "UVEC") (tuple (count = u32))
     typecolor...
 define-type "fvec2"     (RIFF "FVC2") (tuple (x = AnyId) (y = AnyId))
 define-type "fvec3"     (RIFF "FVC3") (tuple (x = AnyId) (y = AnyId) (z = AnyId))

          
@@ 232,9 191,11 @@ define-type "fvec4"     (RIFF "FVC4") (t
 define-type "uvec2"     (RIFF "UVC2") (tuple (x = AnyId) (y = AnyId))
 define-type "uvec3"     (RIFF "UVC3") (tuple (x = AnyId) (y = AnyId) (z = AnyId))
 define-type "uvec4"     (RIFF "UVC4") (tuple (x = AnyId) (y = AnyId) (z = AnyId) (w = AnyId))
-define-type "input"     (RIFF "INPT") (tuple (type = AnyId) (source = SystemKey))
+define-type "input"     (RIFF "INPT") (tuple (source = SystemKey))
     instrcolor...
-define-type "output"    (RIFF "OUTP") (tuple (array (tuple SystemKey AnyId)))
+define-type "output"    (RIFF "OUTP") (tuple (sink = SystemKey) (value = AnyId))
+    instrcolor...
+define-type "outputs"   (RIFF "OUPS") (tuple (outputs = (array AnyId)))
     instrcolor...
 define-type "uconst"    (RIFF "U32C") (tuple (value = u32))
     constcolor...

          
@@ 242,329 203,308 @@ define-type "fconst"    (RIFF "F32C") (t
     constcolor...
 define-type "range"     (RIFF "RANG") (tuple (x = AnyId) (y = AnyId) (z = AnyId))
     stringcolor...
-define-type "comp"      (RIFF "COMP") (tuple (index = i32) (value = AnyId))
+define-type "comp"      (RIFF "COMP") (tuple (index = u32) (value = AnyId))
 let Operator1Type = (tuple (value = AnyId))
 let Operator2Type = (tuple (lhs = AnyId) (rhs = AnyId))
-define-type "and"       (RIFF "BAND") Operator2Type
-    funccolor...
-define-type "xor"       (RIFF "BXOR") Operator2Type
-    funccolor...
-define-type "utof"      (RIFF "UTOF") Operator1Type
-    funccolor...
-define-type "sin"       (RIFF "FSIN") Operator1Type
-    funccolor...
-define-type "cos"       (RIFF "FCOS") Operator1Type
-    funccolor...
-define-type "fadd"      (RIFF "FADD") Operator2Type
-    funccolor...
-define-type "fmul"      (RIFF "FMUL") Operator2Type
-    funccolor...
-define-type "fdiv"      (RIFF "FDIV") Operator2Type
-    funccolor...
-define-type "sample"    (RIFF "SAMP") (tuple (value = AnyId) (uv = AnyId))
+inline define-op1 (name riff)
+    define-type name (RIFF riff) Operator1Type
+        funccolor...
+inline define-op2 (name riff)
+    define-type name (RIFF riff) Operator2Type
+        funccolor...
+
+define-op2 "add"    "IADD"
+define-op2 "sub"    "ISUB"
+define-op2 "mul"    "IMUL"
+define-op2 "udiv"   "UDIV"
+define-op2 "sdiv"   "SDIV"
+define-op2 "urem"   "UREM"
+define-op2 "srem"   "SREM"
+
+define-op2 "eq"   "IEQ_"
+define-op2 "ne"   "INE_"
+define-op2 "ugt"   "UGT_"
+define-op2 "uge"   "UGE_"
+define-op2 "ult"   "ULT_"
+define-op2 "ule"   "ULE_"
+define-op2 "sgt"   "SGT_"
+define-op2 "sge"   "SGE_"
+define-op2 "slt"   "SLT_"
+define-op2 "sle"   "SLE_"
+
+define-op2 "shl"    "ISHL"
+define-op2 "ushr"   "USHR"
+define-op2 "sshr"   "SSHR"
+define-op2 "and"    "IAND"
+define-op2 "or"     "IOR_"
+define-op2 "xor"    "IXOR"
+
+define-op1 "findmsb"    "CTLZ"
+define-op1 "findlsb"    "CTTZ"
+define-op1 "bitcount"   "POPC"
+
+define-op1 "utof"   "UTOF"
+define-op1 "stof"   "STOF"
+define-op1 "ftou"   "FTOU"
+define-op1 "ftos"   "FTOS"
+
+define-op2 "fadd"   "FADD"
+define-op2 "fsub"   "FSUB"
+define-op2 "fmul"   "FMUL"
+define-op2 "fdiv"   "FDIV"
+define-op2 "frem"   "FREM"
+
+define-op1 "fneg"   "FNEG"
+
+define-op2 "foeq"   "FOEQ"
+define-op2 "fone"   "FONE"
+define-op2 "fogt"   "FOGT"
+define-op2 "foge"   "FOGE"
+define-op2 "folt"   "FOLT"
+define-op2 "fole"   "FOLE"
+define-op2 "fo"     "FO__"
+
+define-op2 "fueq"   "FUEQ"
+define-op2 "fune"   "FUNE"
+define-op2 "fugt"   "FUGT"
+define-op2 "fuge"   "FUGE"
+define-op2 "fult"   "FULT"
+define-op2 "fule"   "FULE"
+define-op2 "fu"     "FU__"
+
+define-op1 "sqrt"   "SQRT"
+define-op1 "sin"    "FSIN"
+define-op1 "cos"    "FCOS"
+
+define-type "sample"    (RIFF "SAMP") (tuple (source = AnyId) (uv = AnyId))
     instrcolor...
 
 ################################################################################
 
-type+ FIR.BuilderType
-    let ILString = this-type.ILString
-    inline ILString (self str)
-        static-if (none? str) (ILString self 0)
-        else (ILString self ((countof str) as u32) str)
+type FInterval <: vec2
+    fn sort (self)
+        let a b = (unpack self)
+        this-type
+            if (a < b) (_ a b)
+            else (_ b a)
 
-    let ILSymbol = this-type.ILSymbol
-    inline... ILSymbol (self, str : AnyId)
-        ILSymbol self str
-    case (self, str : string)
-        ILSymbol self (ILString self str)
+    fn fadd (a b)
+        this-type (a + b)
 
-    let ILBuiltin = this-type.ILBuiltin
-    inline... ILBuiltin (self, str : AnyId)
-        ILBuiltin self str
-    case (self, str : string)
-        ILBuiltin self (ILSymbol self str)
+    fn fsub (a b)
+        this-type (a - b.yx)
 
-    let ILDo = this-type.ILDo
-    inline ILEmbed (self ...)
-        ILDo self false ...
-    inline ILDo (self ...)
-        ILDo self true ...
+    fn fmul (a b)
+        let a1 a2 a3 a4 = (unpack (a.xxyy * b.xyxy))
+        this-type (min a1 a2 a3 a4) (max a1 a2 a3 a4)
+
+    fn fdiv (a b)
+        let a1 a2 = (unpack (a.x / b))
+        let a3 a4 = (unpack (a.y / b))
+        this-type (min a1 a2 a3 a4) (max a1 a2 a3 a4)
 
-    spice ILType (self value)
-        value as:= type
-        switch ('kind value)
-        case type-kind-function
-            let retT raiseT = (sc_function_type_return_type value)
-            let count = (sc_type_countof value)
-            let call = (sc_call_new 'ILFunctionType)
-            sc_call_append_argument call self
-            sc_call_append_argument call `('ILType self retT)
-            sc_call_append_argument call `('ILType self raiseT)
-            for i in (range count)
-                let ET = (sc_type_element_at value i)
-                sc_call_append_argument call `('ILType self ET)
-            call
-        case type-kind-arguments
-            let count = (sc_arguments_type_argcount value)
-            let call = (sc_call_new 'ILArgumentsType)
-            sc_call_append_argument call self
-            for i in (range count)
-                let ET = (sc_arguments_type_getarg value i)
-                sc_call_append_argument call `('ILType self ET)
-            call
-        case type-kind-typename
-            match value
-            case string `('ILStringType self)
-            case noreturn `('ILNoReturnType self)
-            default
-                error (.. "cannot translate typename " (repr value))
-        default
-            error (.. "cannot translate type " (repr value))
+    fn fabs (x)
+        let a b = (unpack x)
+        let a b =
+            if (a >= 0.0) # strictly positive
+                _ a b
+            elseif (b < 0.0) # strictly negative
+                _ -b -a
+            else # crossing zero
+                _ 0.0 (max -a b)
+        this-type a b
 
-    spice ILValue (self value)
-        switch ('kind value)
-        case value-kind-global
-            let flags = (sc_global_flags value)
-            let name = ((sc_global_name value) as string)
-            let storage_class = ((sc_global_storage_class value) as string)
-            let location = (sc_global_location value)
-            let binding = (sc_global_binding value)
-            let set = (sc_global_descriptor_set value)
-            let T = (sc_type_element_at (sc_value_type value) 0)
-            spice-quote
-                from (methodsof self) let ILGlobal ILSymbol ILType
-                ILGlobal (ILSymbol name) (ILType T) flags
-                    ILSymbol storage_class
-        default
-            error (.. "cannot translate value " (repr value))
+    fn fract (x)
+        let a b = (unpack x)
+        let d = (b - a)
+        let a = (mod a 1.0)
+        let b = (a + d)
+        if (b < 1.0)
+            # is not overlapping boundary
+            this-type a b
+        else
+            # otherwise:
+                union([0 .. b%1], [a%1 .. 1]) -> [0 .. 1]
+            this-type 0 1
 
-    let ILXValue = this-type.ILXValue
-    fn... ILXValue (self, value : Value)
-        static-assert ((sizeof Value) == 16)
-        local value = (copy value)
-        let value = (deref (@ (bitcast (& value) (@ (integer 128)))))
-        let w0 = (value as u32)
-        let w1 = ((value >> 32) as u32)
-        let w2 = ((value >> 64) as u32)
-        let w3 = ((value >> 96) as u32)
-        ILXValue self w0 w1 w2 w3
-
-run-stage;
-
-################################################################################
-
-let ValueMap = (Map AnyId Value)
-struct ILFunction
-    func : Value
-    values : ValueMap
-
-fn resolve (funcstack id)
-    for ctx in ('reverse funcstack)
-        try
-            return (copy ('get ctx.values id))
-        else;
-    else
-        raise;
-
-fn resolve-value (funcstack id)
-    try (resolve funcstack id)
-    else
-        error
-            .. "unmapped id: " (repr id)
+    fn frem (a b)
+        'fmul ('fract ('fdiv a b)) b
 
-fn generate-IL (self)
-    local funcstack : (Array ILFunction)
-    'append funcstack (ILFunction `none)
-    'descend self ('rootid self)
-        on-enter =
-            capture (module id) {&funcstack}
-                #report "enter" id
-                let handle = ('handleof module id)
-                dispatch handle
-                case ILTemplate (self)
-                    let f = (sc_template_new unnamed)
-                    local ctx : ILFunction
-                    ctx.func = f
-                    let paramsid = self.params
-                    dispatch ('handleof module paramsid)
-                    case ILParams (params)
-                        let args = (alloca-array Value params.count)
-                        for i in (range params.count)
-                            let arg = (sc_parameter_new unnamed)
-                            sc_template_append_parameter f arg
-                            args @ i = arg
-                        'set ctx.values paramsid
-                            sc_argument_list_new params.count args
-                    default;
-                    #'set ctx.values id f
-                    'append funcstack ctx
-                default;
-                true
-        visit =
-            capture (module id) {&funcstack}
-                inline get (id)
-                    resolve-value funcstack id
-                try
-                    return (resolve funcstack id)
-                else;
-                #report "leave" id
-                let handle = ('handleof module id)
-                let vacount = ('vacount handle)
-                local global? = false
-                vvv bind value
-                dispatch handle
-                case ILXValue (self)
-                    self as Value
-                case ILTemplate (self)
-                    #report "pop"
-                    let ctx = ('last funcstack)
-                    let f = (copy ctx.func)
-                    sc_template_set_body f (get self.body)
-                    'pop funcstack
-                    f
-                case ILSymbol (self)
-                    global? = true
-                    `[(Symbol ((get self.string) as string))]
-                case ILBuiltin (self)
-                    global? = true
-                    `[(bitcast ((get self.symbol) as Symbol) Builtin)]
-                case ILString (self)
-                    global? = true
-                    `[(string (& (self.str @ 0)) (min vacount self.size))]
-                case ILArgumentsType (self)
-                    global? = true
-                    let count = vacount
-                    let types = (alloca-array type count)
-                    let ptypes = self.types
-                    for i in (range count)
-                        types @ i =
-                            \ (get (ptypes @ i)) as type
-                    `[(sc_arguments_type (count as i32) types)]
-                case ILVA (self)
-                    let args = (alloca-array Value vacount)
-                    for i in (range vacount)
-                        args @ i = (get (self.args @ i))
-                    sc_argument_list_new (vacount as i32) args
-                case ILVAGet (self)
-                    sc_extract_argument_new (get self.args) self.index
-                case ILNoReturnType ()
-                    global? = true
-                    `noreturn
-                case ILStringType ()
-                    global? = true
-                    `string
-                case ILFunctionType (self)
-                    global? = true
-                    let types = (alloca-array type vacount)
-                    let params = self.params
-                    for i in (range vacount)
-                        types @ i = ((get (params @ i)) as type)
-                    let return-type = ((get self.return) as type)
-                    let raise-type = ((get self.raise) as type)
-                    let RT = (sc_function_type return-type (vacount as i32) types)
-                    let RT =
-                        if (raise-type != noreturn)
-                            sc_function_type_raising RT raise-type
-                        else RT
-                    `RT
-                case ILIntegerType (self)
-                    global? = true
-                    `[(sc_integer_type self.width self.signed?)]
-                case ILConstInt (self)
-                    global? = true
-                    `[(sc_const_int_new ((get self.type) as type) self.value)]
-                case ILIf (self)
-                    `[(sc_cond_new
-                        (get self.cond) (get self.then) (get self.else))]
-                case ILGlobal (self)
-                    global? = true
-                    let name = ((get self.name) as Symbol)
-                    let type = ((get self.type) as type)
-                    let storage = ((get self.storage) as Symbol)
-                    sc_global_new name type self.flags storage
-                case ILCall (self)
-                    let call = (sc_call_new (get self.callee))
-                    let args = self.args
-                    for i in (range vacount)
-                        sc_call_append_argument call (get (args @ i))
-                    call
-                case ILDo (self)
-                    let expr = (sc_expression_new)
-                    if self.scoped?
-                        sc_expression_set_scoped expr
-                    let body = self.body
-                    for i in (range vacount)
-                        sc_expression_append expr (get (body @ i))
-                    expr
-                default
-                    error@ unknown-anchor
-                        .. "while translating " ('repr module id)
-                        "invalid expression"
-                let ctx =
-                    if global? (funcstack @ 0)
-                    else ('last funcstack)
-                'set ctx.values id value
-                value
-    try
-        resolve funcstack ('rootid self)
-    else
-        assert false
-        unreachable;
+    fn cos (x)
+        let a b = (unpack x)
+        let d = (b - a)
+        let a = (mod a tau)
+        let a s =
+            if (a >= pi) (_ (a - pi) -1.0)
+            else (_ a 1.0)
+        let b = (a + d)
+        let u v = (cos a) (cos b)
+        let u v =
+            if (b < pi)
+                _ u v
+            elseif (b < tau)
+                _ -1.0 (max u v)
+            else
+                _ -1.0 1.0
+        let u v = (u * s) (v * s)
+        let u v =
+            if (u <= v) (_ u v)
+            else (_ v u)
+        this-type u v
+
+    fn sin (x)
+        'cos (x - (pi * 0.5))
+
+type IInterval <: uvec2
+    fn usort (self)
+        let a b = (unpack self)
+        this-type
+            if (a < b) (_ a b)
+            else (_ b a)
+
+    fn isort (self)
+        let a b = (unpack self)
+        let a b = (bitcast a i32) (bitcast b i32)
+        this-type
+            if (a < b) (_ a b)
+            else (_ b a)
+
+    inline gen_u_binop2 (f)
+        fn (a b)
+            # todo: actually do this right
+            let a b = (usort a) (usort b)
+            let a1 a2 a3 a4 =
+                f a.x b.x
+                f a.x b.y
+                f a.y b.x
+                f a.y b.y
+            this-type (min a1 a2 a3 a4) (max a1 a2 a3 a4)
+
+    let
+        and = (gen_u_binop2 &)
+        or = (gen_u_binop2 |)
+        xor = (gen_u_binop2 ^)
+        udiv = (gen_u_binop2 //)
+        urem = (gen_u_binop2 %)
+
+    fn utof (x)
+        let a b = (unpack x)
+        FInterval a b
+
+enum CompileTimeInterval
+    Undefined
+    Composite
+    F : FInterval
+    I : IInterval
 
 ################################################################################
 
 struct ProgramInfo
     range : AnyId
     read_order : i32
-    ptr : Value = null
-    body : Value = null
-    bindbody : Value = null
+    ptr : AnyId
+    body : (Array AnyId)
+    bindbody : (Array AnyId)
     dim : i32
     buffersize : ivec3
+    localsize : ivec3
     next_location_index : i32
     next_binding_index : i32
     next_tu_index : i32
-    values : (Map AnyId Value)
+    values : (Map AnyId AnyId)
+
+struct Metadata
+    range : AnyId
+    #   count read order by propagating depth first. source nodes without any
+        reads always start at order 0.
+        read nodes increase the read order.
+        the read order of a node is the maximum read order of its inputs.
+        nodes with same range and read order may share the same shader
+    read_order : i32
+    elements : u32 = 1
+    intervals : (array CompileTimeInterval 4) =
+        arrayof CompileTimeInterval
+            (CompileTimeInterval.Undefined)
+            (CompileTimeInterval.Undefined)
+            (CompileTimeInterval.Undefined)
+            (CompileTimeInterval.Undefined)
+
+    fn upper-limit (self)
+        dispatch (self.intervals @ 0)
+        case I (value) value.y
+        default
+            error "integer interval expected"
 
 struct BufferInfo plain
-    ptr : Value = null
+    ptr : AnyId
     type : type
+    wglobal : Value
     glformat : i32
 
 struct FIRContext
-    # {range, order} -> idptr body
-    programs : (Map (tuple AnyId i32) ProgramInfo)
-    # {id, imageformat} -> global
-    buffers : (Map (tuple AnyId ImageFormat) BufferInfo)
-    #md : MetadataArray
-    ctx-size : usize
-    setup-ctx : Value
-    setup-body : Value
-    drive-ctx : Value
+    programs : (Array ProgramInfo)
+    # {range, order} -> program index
+    programkeys : (Map (tuple AnyId i32) u32)
+    buffers : (Array BufferInfo)
+    # {id, imageformat} -> buffer index
+    bufferkeys : (Map (tuple AnyId ImageFormat) u32)
+    md : (Map AnyId Metadata)
+    setup-ctx : AnyId
+    setup-body : (Array AnyId)
+    drive-ctx : AnyId
     ins : AnyId
     outs : AnyId
-    drive-body : Value
-    drop-ctx : Value
-    drop-body : Value
-    pginfostack : (Array (tuple AnyId i32))
+    drive-body : (Array AnyId)
+    drop-ctx : AnyId
+    drop-body : (Array AnyId)
+    pginfostack : (Array u32) # program index stack
+
+    fn contextwords (self)
+        +
+            (countof self.programs) as u32 - 1
+            (countof self.buffers) as u32
 
     inline __typecall (cls)
         local self = (super-type.__typecall cls)
-        let key = ('getcpuprogramkey self)
-        'set self.programs key (ProgramInfo)
-        'append self.pginfostack key
+        'append self.programs (ProgramInfo)
+        'append self.pginfostack 0:u32
         deref self
 
-    fn getcpuprogramkey (self)
-        tupleof NoId 0
+    fn active-pginfo (self)
+        self.programs @ ('last self.pginfostack)
+
+    fn getmd (self id)
+        try ('get self.md id)
+        else
+            assert false
+            unreachable;
+
+    fn getbuffer (self value imageformat)
+        let key = (tupleof value imageformat)
+        @ self.buffers
+            try ('get self.bufferkeys key)
+            else
+                assert false
+                unreachable;
+
+    fn pop-program (self)
+        'pop self.pginfostack
+
+    fn push-program (self md)
+        let key = (tupleof (copy md.range) (copy md.read_order))
+        'append self.pginfostack
+            try ('get self.programkeys key)
+            else
+                assert false
+                unreachable;
 
     fn read-input (self module key)
         from (methodsof module.builder) let ILSymbol ILConstInt
-            \ ILIntegerType ILCall ILBuiltin
+            \ ILIntegerType ILExtractValue
         let ins = (copy self.ins)
         let flag = (syskey->flag key)
         inline readfield (fieldname)
-            ILCall (ILBuiltin "extractvalue") ins
+            ILExtractValue ins
                 ILSymbol (fieldname as string)
             #spice-quote
                 assert ((ins.flags & flag) == flag)

          
@@ 591,44 531,640 @@ struct FIRContext
             error
                 .. "unsupported input key: " (repr key)
 
+    fn write-output (self module key value)
+        from (methodsof module.builder) let ILSymbol ILConstInt
+            \ ILIntegerType ILExtractValue ILAssign ILOr
+        let outs = self.outs
+        let body = self.drive-body
+
+        inline writefield (flagsym fieldname)
+            let flag = (getattr OutputFlags flagsym)
+
+            let flagptr =
+                ILExtractValue outs
+                    ILSymbol "flags"
+            'append body
+                ILAssign
+                    ILOr
+                        flagptr
+                        ILConstInt (ILIntegerType 64 false) (flag as u32)
+                    flagptr
+            static-if (not (none? fieldname))
+                'append body
+                    ILAssign
+                        value
+                        ILExtractValue outs
+                            ILSymbol (fieldname as string)
+        switch key
+        # u32[?]
+        case SystemKey.OState
+            writefield 'State 'state
+        # zterm u32[?]
+        case SystemKey.Stdout
+            writefield 'Stdout 'stdout
+        # u32[0]
+        case SystemKey.BlockBreak
+            writefield 'BlockBreak
+        # u32[0]
+        case SystemKey.BlockClose
+            writefield 'BlockClose
+        # f32[width * height * 4]
+        case SystemKey.Screen
+            writefield 'Screen 'screen
+        # zterm u32[?]
+        case SystemKey.Title
+            writefield 'Title 'title
+        # u32[4 * ?]
+        #case SystemKey.Program
+            writefield 'Program 'program
+        # zterm u32[?]
+        case SystemKey.Prompt
+            writefield 'Prompt 'prompt
+        # i32
+        case SystemKey.Exit
+            writefield 'Exit 'exit
+        # f32[samplecount * 2]
+        case SystemKey.Sound
+            writefield 'Sound 'sound
+        default
+            error
+                .. "unsupported output key: " (repr key)
+
+    fn alloc-buffers (self module offset)
+        from (methodsof module.builder) let ILIntegerType ILConstInt ILCall
+            \ ILLoad ILValue ILGetElementPtr
+
+        let u32id = (ILIntegerType 32 false)
+        let i32id = (ILIntegerType 32 true)
+        let offsetid = (ILConstInt u32id (offset as u32))
+
+        let numbuffersid =
+            ILConstInt i32id ((countof self.buffers) as u32)
+
+        'append self.setup-body
+            ILCall
+                ILLoad
+                    ILValue (reftoptr GLAPI.define.glCreateBuffers)
+                numbuffersid
+                ILGetElementPtr self.setup-ctx offsetid
+
+        'append self.drop-body
+            ILCall
+                ILLoad
+                    ILValue (reftoptr GLAPI.define.glDeleteBuffers)
+                numbuffersid
+                ILGetElementPtr self.drop-ctx offsetid
+
+        for i buf in (enumerate self.buffers u32)
+            report "buffer" ((offset as u32) + i)
+            let offsetid = (ILConstInt u32id ((offset as u32) + i))
+            let ptr = (ILGetElementPtr self.drive-ctx offsetid)
+            'append self.drive-body ptr
+            buf.ptr = ptr
+
+    fn alloc-program (self module pginfo offset)
+        from (methodsof module.builder) let ILValue ILCall ILLoad ILStore
+            \ ILGetElementPtr ILConstInt ILIntegerType ILBitcast ILPointerType
+
+        let u32id = (ILIntegerType 32 false)
+        let offsetid = (ILConstInt u32id (offset as u32))
+
+        'append self.setup-body
+            ILStore
+                ILCall
+                    ILLoad
+                        ILValue (reftoptr GLAPI.define.glCreateProgram)
+                ILGetElementPtr self.setup-ctx offsetid
+
+        let ptr = (ILGetElementPtr self.drive-ctx offsetid)
+        'append self.drive-body ptr
+        pginfo.ptr = ptr
+
+        'append self.drop-body
+            ILCall
+                ILLoad
+                    ILValue (reftoptr GLAPI.define.glDeleteProgram)
+                ILLoad
+                    ILGetElementPtr self.drop-ctx offsetid
+
+    #
+        let PT = GL.Program
+        let UT = (mutable @GL.uint)
+        let T = (mutable @GL.Program)
+        inline gethandle (src offset)
+            bitcast (& (src @ offset)) T
+        inline gethandleT (src offset T)
+            bitcast (& (src @ offset)) T
+
+        let offset = (deref self.ctx-size)
+        self.ctx-size += (sizeof GL.uint)
+        sc_expression_append self.setup-body
+            spice-quote
+                let ptr = (gethandle [(copy self.setup-ctx)] offset)
+                let pg = (PT)
+                call
+                    attach-shaders pg
+                        compute = main
+                        debug = true
+                store pg ptr
+                lose ptr
+        sc_expression_append self.drop-body
+            spice-quote
+                let ptr = (@ (gethandle [(copy self.drop-ctx)] offset))
+                __drop (view ptr)
+                lose ptr
+        let ptr = `(@ (gethandleT [(copy self.drive-ctx)] offset UT))
+        sc_expression_append self.drive-body ptr
+        ptr
 
 fn translate-FIR (self module)
     viewing self
     viewing module
     local ctx : FIRContext
-    'append ctx.pginfostack ('getcpuprogramkey ctx)
+    'append ctx.pginfostack 0:u32 # append CPU program
+
+    fn genprogram (module ctx rangeid read_order)
+        assert (rangeid != NoId)
+        let key = (tupleof rangeid read_order)
+        try
+            return (copy ('get ctx.programkeys key))
+        else;
+        # reuse an existing program if possible, otherwise allocate a new one
+        let mdx mdy mdz =
+            dispatch ('handleof module rangeid)
+            case range (self)
+                _
+                    'getmd ctx self.x
+                    'getmd ctx self.y
+                    'getmd ctx self.z
+            default
+                assert false
+                unreachable;
+        let allocsize =
+            ivec3
+                'upper-limit mdx
+                'upper-limit mdy
+                'upper-limit mdz
+        # wave size
+        let dim localsize =
+            do
+                if (allocsize.z == 1)
+                    if (allocsize.y == 1)
+                        _ 1 (ivec3 64 1 1)
+                    else
+                        _ 2 (ivec3 8 8 1)
+                else
+                    _ 3 (ivec3 4 4 4)
+        let localsize = (min allocsize localsize)
+        do
+            let w h d = (va-map usize (unpack allocsize))
+            switch d
+            case 1
+                if (w > 4194304)
+                    error "range too big"
+            case 2
+                if ((max w h) > 4096)
+                    error "range too big"
+            case 3
+                if ((max w h d) > 1024)
+                    error "range too big"
+            default;
+        #let wx wy wz = (unpack localsize)
+        #from (methodsof module.builder) let ILLocalSize
+        #local body : (Array AnyId)
+        #'append body
+            ILLocalSize wx wy wz
+        #let ptr = ('alloc-program ctx module)
+        #do
+            from GL let UseProgram DispatchCompute
+
+            let pginfo = ('getcpuprogram ctx)
+            let d1 d2 d3 =
+                va-map
+                    inline (id)
+                        visit module id ctx pginfo
+                    \ d1 d2 d3
+            let wx-1 wy-1 wz-1 = (wx - 1) (wy - 1) (wz - 1)
+            sc_expression_append ctx.drive-body
+                spice-quote
+                    UseProgram ptr
+                    bindbody
+                    DispatchCompute
+                        (d1 + wx-1) // wx
+                        (d2 + wy-1) // wy
+                        (d3 + wz-1) // wz
+                    UseProgram 0
+
+        let pginfo =
+            ProgramInfo
+                range = rangeid
+                read_order = read_order
+                #ptr = ptr
+                dim = dim
+                buffersize = allocsize
+                localsize = localsize
+        let pgindex = ((countof ctx.programs) as u32)
+        'append ctx.programs pginfo
+        'set ctx.programkeys key pgindex
+        pgindex
+
+    fn... imagedim->symbol (fmt : ImageDim)
+        switch fmt
+        case ImageDim.1D '1D
+        case ImageDim.2D '2D
+        case ImageDim.3D '3D
+        case ImageDim.Cube 'Cube
+        case ImageDim.Rect 'Rect
+        case ImageDim.Buffer 'Buffer
+        default
+            error
+                .. "unsupported image dimensionality: " (repr fmt)
+
+    fn... imageformat->symbol (fmt : ImageFormat)
+        switch fmt
+        case ImageFormat.RGBA8UNORM 'Rgba8
+        case ImageFormat.R32F 'R32f
+        case ImageFormat.RG32F 'Rg32f
+        case ImageFormat.RGBA32F 'Rgba32f
+        default
+            error
+                .. "unsupported image format: " (repr fmt)
+
+    fn... imageformat->GL (fmt : ImageFormat)
+        using GLAPI.define
+        # https://www.khronos.org/registry/OpenGL-Refpages/gl4/html/glBindImageTexture.xhtml
+        switch fmt
+        case ImageFormat.RGBA8UNORM GL_RGBA8
+        case ImageFormat.R32F GL_R32F
+        case ImageFormat.RG32F GL_RG32F
+        case ImageFormat.RGBA32F GL_RGBA32F
+        default
+            error
+                .. "unsupported image format: " (repr fmt)
 
-    vvv bind on-enter
-    capture (module oldmodule id) {&ctx}
+    fn genbuffer (module ctx source imageformat)
+        assert (('components imageformat) == 1)
+        let key = (tupleof source imageformat)
+        try
+            return (copy ('get ctx.bufferkeys key))
+        else;
+        let md = ('getmd ctx source)
+        let pginfo =
+            ctx.programs @
+                genprogram module ctx (copy md.range) (copy md.read_order)
+        let elements = (copy md.elements)
+        assert (elements >= 1)
+        let arrayed? = false
+        let multisampled? = false
+        let imageformat = ('setcomponents imageformat elements)
+        using GLAPI.define
+        let imgdim target =
+            switch pginfo.dim
+            case 1 # 1D texture
+                _ '1D GL_TEXTURE_1D
+            case 2 # 2D texture
+                _ '2D GL_TEXTURE_2D
+            case 3 # 3D texture
+                _ '3D GL_TEXTURE_3D
+            default
+                assert false
+                unreachable;
+        let T =
+            switch ('format imageformat)
+            case ImageFormat.UNORM vec4
+            case ImageFormat.SNORM vec4
+            case ImageFormat.U uvec4
+            case ImageFormat.S ivec4
+            case ImageFormat.F vec4
+            default
+                error "unknown component format"
+        let format = (imageformat->symbol imageformat)
+        let glformat = (imageformat->GL imageformat)
+        let IT = (sc_image_type T imgdim 0 arrayed? multisampled? 2 format unnamed)
+        let RIT = (sc_sampled_image_type (sc_image_type T imgdim 0 arrayed? multisampled? 1 'Unknown unnamed))
+        let flags =
+            | global-flag-coherent global-flag-restrict
+        wflags := flags | global-flag-non-readable
+        let wglobal = (sc_global_new 'wbuf IT wflags 'UniformConstant)
+        let binding_index = (copy pginfo.next_binding_index)
+        pginfo.next_binding_index += 1
+        sc_global_set_binding wglobal binding_index
+
+        #let coord = `(deref gl_GlobalInvocationID)
+        #let coord =
+            switch pginfo.dim
+            case 1 `coord.x
+            case 2 `coord.xy
+            case 3 `coord
+            default
+                assert false
+                unreachable;
+        #let value =
+            switch md.elements
+            case 1 `(uvec4 (uconv value) 0 0 0)
+            case 2 `(uvec4 (uconv value) 0 0)
+            case 3 `(uvec4 (uconv value) 0)
+            case 4 value
+            default
+                assert false
+                unreachable;
+        #sc_expression_append pginfo.body `(imagewrite-impl (ptrtoref wglobal) coord value)
+
+        #let x y z = (unpack (copy pginfo.buffersize))
+        #let levels = 1
+        #let samples = 4
+        #let fixedsamplelocations = GL.TRUE
+        #let setup-ptr drive-ptr = ('alloc-texture ctx target)
+        #from GL let TextureStorage1D TextureStorage2D TextureStorage3D \
+            TextureStorage2DMultisample TextureStorage3DMultisample
+        #sc_expression_append ctx.setup-body
+            switch target
+            case GL.TEXTURE_1D
+                `(TextureStorage1D setup-ptr levels glformat x)
+            pass GL.TEXTURE_1D_ARRAY
+            pass GL.TEXTURE_2D
+            pass GL.TEXTURE_RECTANGLE
+            pass GL.TEXTURE_CUBE_MAP
+            do
+                `(TextureStorage2D setup-ptr levels glformat x y)
+            pass GL.TEXTURE_2D_ARRAY
+            pass GL.TEXTURE_3D
+            pass GL.TEXTURE_CUBE_MAP_ARRAY
+            do
+                `(TextureStorage3D setup-ptr levels glformat x y z)
+            case GL.TEXTURE_2D_MULTISAMPLE_ARRAY
+                `(TextureStorage3DMultisample setup-ptr samples glformat x y z fixedsamplelocations)
+            case GL.TEXTURE_2D_MULTISAMPLE
+                `(TextureStorage2DMultisample setup-ptr samples glformat x y fixedsamplelocations)
+            #case GL.TEXTURE_BUFFER
+                TextureBuffer
+            default
+                unreachable;
+
+        # bind to program
+        #from GL let FALSE WRITE_ONLY BindImageTexture
+        #sc_expression_append pginfo.bindbody
+            spice-quote
+                BindImageTexture binding_index drive-ptr
+                    0 # level
+                    FALSE # layered
+                    0 # layer
+                    WRITE_ONLY # access
+                    glformat
+
+        let bi =
+            BufferInfo
+                type = RIT
+                wglobal = wglobal
+                glformat = glformat
+        let bufindex = ((countof ctx.buffers) as u32)
+        'append ctx.buffers bi
+        'set ctx.bufferkeys key bufindex
+        bufindex
+
+    capture on-enter-param (module oldmodule id index paramid) {&ctx}
+        #dispatch ('handleof oldmodule id)
+        #case output (self)
+            switch self.sink
+            case SystemKey.Screen
+            default
+                error
+                    .. "unsupported output key: " (repr key)
+        #default;
+        let pginfo = ('active-pginfo ctx)
+        try
+            return (_ false (copy ('get pginfo.values paramid)))
+        else;
+        _ true NoId
+
+    capture on-leave-param (module oldmodule id index oldparamid newparamid) {&ctx}
+        print "on leave" id index
+        let pginfo = ('active-pginfo ctx)
+        'set pginfo.values oldparamid newparamid
+        ;
+
+    capture on-enter (module oldmodule id) {&ctx}
         let handle = ('handleof oldmodule id)
         dispatch handle
+        case output (self)
+            switch self.sink
+            case SystemKey.Screen
+                #let key = (tupleof self.source ImageFormat.R8UNORM)
+                #if ('has? ctx.buffers key)
+                #else;
+                md := ('getmd ctx self.value)
+                if (md.range == NoId)
+                    error "ranged expression expected"
+                'push-program ctx md
+            default
+                error
+                    .. "unsupported output key: " (repr key)
         case range (self)
-            'append ctx.pginfostack ('getcpuprogramkey ctx)
-        case input (self)
-            return false
+            'append ctx.pginfostack 0:u32
         default;
         true
 
-    vvv bind visit
-    capture (module handle finalize) {&ctx}
+    fn merge-all-read-orders (ctx handle md)
+        md.read_order =
+            fold (ro = 0) for id in ('sources handle)
+                max ro (('getmd ctx id) . read_order)
+
+    fn merge-all-ranges (ctx handle md)
+        md.range =
+            fold (r = NoId) for id in ('sources handle)
+                let newr = (copy (('getmd ctx id) . range))
+                if (newr == NoId) r
+                else
+                    if (r == NoId) newr
+                    elseif (r == newr) r
+                    else
+                        error "operation is mixing different ranges"
+
+    fn compute-metadata (ctx module handle vacount id)
+        from CompileTimeInterval let Undefined Composite F I
+        local md : Metadata
+        inline get (id)
+            'getmd ctx id
+        inline merge-all-read-orders ()
+            merge-all-read-orders ctx handle md
+        inline merge-all-ranges ()
+            merge-all-ranges ctx handle md
+        inline merge-all ()
+            merge-all-read-orders ctx handle md
+            merge-all-ranges ctx handle md
+
+        inline ibinop (self iaf)
+            merge-all;
+            md.intervals @ 0 =
+                I
+                    iaf
+                        dispatch ((get self.lhs) . intervals @ 0)
+                        case I (lhs) lhs
+                        default
+                            error "integer interval expected"
+                        dispatch ((get self.rhs) . intervals @ 0)
+                        case I (rhs) rhs
+                        default
+                            error "integer interval expected"
+        inline fbinop (self iaf)
+            merge-all;
+            md.intervals @ 0 =
+                F
+                    iaf
+                        dispatch ((get self.lhs) . intervals @ 0)
+                        case F (lhs) lhs
+                        default
+                            error "float interval expected"
+                        dispatch ((get self.rhs) . intervals @ 0)
+                        case F (rhs) rhs
+                        default
+                            error "float interval expected"
+        inline ifunop (self iaf)
+            merge-all;
+            md.intervals @ 0 =
+                F
+                    iaf
+                        dispatch ((get self.value) . intervals @ 0)
+                        case I (value) value
+                        default
+                            error "integer interval expected"
+        inline funop (self iaf)
+            merge-all;
+            md.intervals @ 0 =
+                F
+                    iaf
+                        dispatch ((get self.value) . intervals @ 0)
+                        case F (value) value
+                        default
+                            error "float interval expected"
+
+        dispatch handle
+        case outputs (self)
+        case output (self)
+            md.elements = 0
+            switch self.sink
+            case SystemKey.Screen
+                #let key = (tupleof self.source ImageFormat.R8UNORM)
+                #if ('has? ctx.buffers key)
+                #else;
+                md := ('getmd ctx self.value)
+                if (md.range == NoId)
+                    error "ranged expression expected"
+                genbuffer module ctx self.value ImageFormat.R8UNORM
+            default
+                error
+                    .. "unsupported output key: " (repr key)
+        case uconst (self)
+            md.intervals @ 0 = (I (IInterval self.value))
+        case fconst (self)
+            md.intervals @ 0 = (F (FInterval self.value))
+        case input (self)
+            switch self.source
+            case SystemKey.ScreenSize
+                md.elements = 2
+                let ival = (IInterval 1 4096)
+                md.intervals @ 0 = (I ival)
+                md.intervals @ 1 = (I ival)
+            case SystemKey.Iteration
+                md.intervals @ 0 = (I (IInterval 0:u32 0xffffffff:u32))
+            default
+                error
+                    .. "invalid input source: " (repr key)
+        case range (self)
+            md.range = id
+            md.elements = 3
+            merge-all-read-orders;
+            inline compute-interval (id)
+                dispatch ((get id) . intervals @ 0)
+                case I (value)
+                    I (IInterval 0:u32 ((max 1:u32 (unpack value)) - 1:u32))
+                default
+                    error "integer interval expected"
+            md.intervals @ 0 = (compute-interval self.x)
+            md.intervals @ 1 = (compute-interval self.y)
+            md.intervals @ 2 = (compute-interval self.z)
+        case comp (self)
+            merge-all-read-orders;
+            merge-all-ranges;
+            let srcmd = (get self.value)
+            if (self.index > srcmd.elements)
+                error "component out of range"
+            md.intervals @ 0 = (copy (srcmd.intervals @ self.index))
+        case fadd (self) (fbinop self 'fadd)
+        case fmul (self) (fbinop self 'fmul)
+        case fdiv (self) (fbinop self 'fdiv)
+        case sin (self) (funop self 'sin)
+        case cos (self) (funop self 'cos)
+        case and (self) (ibinop self 'and)
+        case xor (self) (ibinop self 'xor)
+        case utof (self) (ifunop self 'utof)
+        case uvec (self)
+            md.elements = self.count
+        case fvec2 (self)
+            md.elements = 2
+            merge-all;
+            md.intervals @ 0 = (copy ((get self.x) . intervals @ 0))
+            md.intervals @ 1 = (copy ((get self.y) . intervals @ 0))
+        case fvec4 (self)
+            md.elements = 4
+            merge-all;
+            md.intervals @ 0 = (copy ((get self.x) . intervals @ 0))
+            md.intervals @ 1 = (copy ((get self.y) . intervals @ 0))
+            md.intervals @ 2 = (copy ((get self.z) . intervals @ 0))
+            md.intervals @ 3 = (copy ((get self.w) . intervals @ 0))
+        case sample (self)
+            merge-all-read-orders;
+            let srcmd = (get self.source)
+            if (srcmd.range == NoId)
+                error "ranged expression expected"
+            genbuffer module ctx self.source ImageFormat.R32F
+            md.range = (get self.uv) . range
+            md.read_order += 1
+            md.elements = srcmd.elements
+            for i in (range 4)
+                md.intervals @ i = (copy (srcmd.intervals @ i))
+        default
+            error@ unknown-anchor
+                .. "while checking " (string handle.typeid.name)
+                "invalid node type"
+        md
+
+    fn compute-ilvalue (ctx module handle finalize vacount oldmodule oldid)
         from (methodsof module.builder) let ILConstInt ILIntegerType
-            \ ILConstReal ILRealType ILGlobal ILSymbol ILVectorType
-            \ ILBuiltin ILCall ILKeyed
-        let vacount = ('vacount handle)
+            \ ILConstReal ILRealType ILGlobal ILSymbol ILVectorType ILLoad
+            \ ILBuiltin ILCall ILKeyed ILUndef ILInsertElement ILExtractElement
+            \ ILAnd ILOr ILXor ILFAdd ILFMul ILFDiv ILSin ILCos ILUIToFP
+            \ ILSample ILFetch
         vvv bind op1
-        inline "#hidden" (self name)
+        inline "#hidden" (self op)
             return
-                ILCall (ILBuiltin name) self.value
+                op self.value
         vvv bind op2
-        inline "#hidden" (self name)
+        inline "#hidden" (self op)
             return
-                ILCall (ILBuiltin name) self.lhs self.rhs
+                op self.lhs self.rhs
         inline constint (value)
             ILConstInt (ILIntegerType 32 true) (bitcast value u32)
         inline constfloat (value)
             ILConstReal (ILRealType 32) value
         dispatch handle
+        case outputs (self)
         case output (self)
+            switch self.sink
+            case SystemKey.Screen
+                let pginfo = ('last ctx.pginfostack)
+                dispatch ('handleof oldmodule oldid)
+                case output (self)
+                    let bufinfo = ('getbuffer ctx self.value ImageFormat.R8UNORM)
+                    # generate actual code here
+                    'write-output ctx module self.sink bufinfo.ptr
+                default
+                    assert false
+                'pop ctx.pginfostack
+            default
+                error
+                    .. "unsupported output key: " (repr key)
+            return NoId
         case uconst (self)
             return
                 ILConstInt (ILIntegerType 32 false) self.value

          
@@ 638,62 1174,851 @@ fn translate-FIR (self module)
         case range (self)
             'pop ctx.pginfostack
             return
-                ILCall (ILBuiltin "load")
+                ILLoad
                     ILGlobal (ILSymbol "spirv.GlobalInvocationId")
                         ILVectorType (ILIntegerType 32 false) 3
                         global-flag-non-writable
                         ILSymbol "Input"
         case comp (self)
             return
-                ILCall (ILBuiltin "extractelement") self.value (constint self.index)
-        case and (self) (op2 self "band")
-        case xor (self) (op2 self "bxor")
-        case fadd (self) (op2 self "fadd")
-        case fmul (self) (op2 self "fmul")
-        case fdiv (self) (op2 self "fdiv")
-        case sin (self) (op1 self "sin")
-        case cos (self) (op1 self "cos")
-        case utof (self) (op1 self "uitofp")
+                ILExtractElement self.value (constint self.index)
+        case and (self) (op2 self ILAnd)
+        case xor (self) (op2 self ILOr)
+        case fadd (self) (op2 self ILFAdd)
+        case fmul (self) (op2 self ILFMul)
+        case fdiv (self) (op2 self ILFDiv)
+        case sin (self) (op1 self ILSin)
+        case cos (self) (op1 self ILCos)
+        case utof (self)
+            return (ILUIToFP self.value (ILRealType 32))
         case uvec (self)
             #ILVectorType (ILIntegerType 32 false) self.count
         case fvec (self)
             #ILVectorType (ILRealType 32) self.count
         case fvec2 (self)
-            let InsertElement = (ILBuiltin "insertelement")
-            let id = (ILCall (ILBuiltin "undef") (ILVectorType (ILRealType 32) 2))
-            let id = (ILCall InsertElement id self.x (constint 0))
-            let id = (ILCall InsertElement id self.y (constint 1))
+            let id = (ILUndef (ILVectorType (ILRealType 32) 2))
+            let id = (ILInsertElement id self.x (constint 0))
+            let id = (ILInsertElement id self.y (constint 1))
             return id
         case fvec3 (self)
-            let InsertElement = (ILBuiltin "insertelement")
-            let id = (ILCall (ILBuiltin "undef") (ILVectorType (ILRealType 32) 3))
-            let id = (ILCall InsertElement id self.x (constint 0))
-            let id = (ILCall InsertElement id self.y (constint 1))
-            let id = (ILCall InsertElement id self.z (constint 2))
+            let id = (ILUndef (ILVectorType (ILRealType 32) 3))
+            let id = (ILInsertElement id self.x (constint 0))
+            let id = (ILInsertElement id self.y (constint 1))
+            let id = (ILInsertElement id self.z (constint 2))
             return id
         case fvec4 (self)
-            let InsertElement = (ILBuiltin "insertelement")
-            let id = (ILCall (ILBuiltin "undef") (ILVectorType (ILRealType 32) 4))
-            let id = (ILCall InsertElement id self.x (constint 0))
-            let id = (ILCall InsertElement id self.y (constint 1))
-            let id = (ILCall InsertElement id self.z (constint 2))
-            let id = (ILCall InsertElement id self.w (constint 3))
+            let id = (ILUndef (ILVectorType (ILRealType 32) 4))
+            let id = (ILInsertElement id self.x (constint 0))
+            let id = (ILInsertElement id self.y (constint 1))
+            let id = (ILInsertElement id self.z (constint 2))
+            let id = (ILInsertElement id self.w (constint 3))
             return id
         case input (self)
             return ('read-input ctx module self.source)
         case sample (self)
             return
-                ILCall (ILBuiltin "sample") self.value self.uv
-                    ILKeyed (ILSymbol "Lod") (constfloat 0.0)
+                ILSample self.source self.uv (constfloat 0.0)
         default
             error@ unknown-anchor
                 .. "while translating " (string handle.typeid.name)
                 "invalid node type"
         finalize;
 
+    'descend module ('rootid module)
+        on-leave =
+            capture (module id) {&ctx}
+                let handle = ('handleof module id)
+                let vacount = ('vacount handle)
+                let md = (compute-metadata ctx module handle vacount id)
+                'set ctx.md id md
+
+    capture on-leave (module oldmodule oldid handle finalize) {&ctx}
+        let vacount = ('vacount handle)
+        compute-ilvalue ctx module handle finalize vacount oldmodule oldid
+
+    from (methodsof self.builder) let ILParams ILVAGet ILTemplate ILVA ILDo
+        \ ILMallocArray ILFree ILIntegerType ILConstInt ILBitcast ILPointerType
+
+    let setup-params = (ILParams 0 0)
+    let u32id = (ILIntegerType 32 false)
+    let pu32id = (ILPointerType u32id)
+    let setup-ctx = (ILMallocArray u32id (ILConstInt u32id ('contextwords ctx)))
+    ctx.setup-ctx = setup-ctx
+    'append ctx.setup-body setup-ctx
+    # ctx, ins, outs
+    let drive-params = (ILParams 0 3)
+    let drive-ctx =
+        ILBitcast
+            ILVAGet 0 drive-params
+            pu32id
+    ctx.drive-ctx = drive-ctx
+    'append ctx.drive-body drive-ctx
+    ctx.ins = (ILVAGet 1 drive-params)
+    ctx.outs = (ILVAGet 2 drive-params)
+    # ctx
+    let drop-params = (ILParams 0 1)
+    let drop-ctx =
+        ILBitcast
+            ILVAGet 0 drop-params
+            pu32id
+    'append ctx.drop-body drop-ctx
+    ctx.drop-ctx = drop-ctx
+
+    local offset = 0:u32
+    for i in (range 1:u32 ((countof ctx.programs) as u32))
+        'alloc-program ctx self (ctx.programs @ i) (deref offset)
+        offset += 1
+    'alloc-buffers ctx self (deref offset)
+    offset += (countof ctx.buffers) as u32
+
     'translate self module ('rootid module)
         on-enter = on-enter
-        visit = visit
+        on-leave = on-leave
+        on-enter-param = on-enter-param
+        on-leave-param = on-leave-param
+
+    'append ctx.setup-body ctx.setup-ctx
+    'append ctx.drop-body
+        ILFree ctx.drop-ctx
+
+    inline make-function (params body)
+        let ptr = ('alloc self TypeId.ILDo ((countof body) as u32))
+        ptr.scoped? = false
+        for i value in (enumerate body)
+            ptr.body @ i = value
+        let body = ('commit self)
+        ILTemplate params body
+
+    let fsetup = (make-function setup-params ctx.setup-body)
+    let fdrive = (make-function drive-params ctx.drive-body)
+    let fdrop = (make-function drop-params ctx.drop-body)
+    ILVA fsetup fdrive fdrop
+
+################################################################################
+
+spice setoption-impl (member value)
+    let TT = ('typeof member)
+    let ST = ('typeof value)
+    spice-quote
+        member = value
+        ;
+
+################################################################################
+
+fn generate-IL (module)
+    using import glm
+    using import glsl
+    using import tukan.gl
+
+    struct Context
+        values : (Map AnyId Value)
+        ctx-size : usize
+        setup-ctx : Value
+        setup-body : Value
+        drive-ctx : Value
+        ins : Value
+        outs : Value
+        drive-body : Value
+        drop-ctx : Value
+        drop-body : Value
+
+        fn alloc-program (self main)
+            let PT = GL.Program
+            let UT = (mutable @GL.uint)
+            let T = (mutable @GL.Program)
+            inline gethandle (src offset)
+                bitcast (& (src @ offset)) T
+            inline gethandleT (src offset T)
+                bitcast (& (src @ offset)) T
+
+            let offset = (deref self.ctx-size)
+            self.ctx-size += (sizeof GL.uint)
+            sc_expression_append self.setup-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.setup-ctx)] offset)
+                    let pg = (PT)
+                    call
+                        attach-shaders pg
+                            compute = main
+                            debug = true
+                    store pg ptr
+                    lose ptr
+            sc_expression_append self.drop-body
+                spice-quote
+                    let ptr = (@ (gethandle [(copy self.drop-ctx)] offset))
+                    __drop (view ptr)
+                    lose ptr
+            let ptr = `(@ (gethandleT [(copy self.drive-ctx)] offset UT))
+            sc_expression_append self.drive-body ptr
+            ptr
+
+        fn alloc-texture (self target)
+            let T = (mutable @GL.uint)
+            inline gethandle (src offset)
+                bitcast (& (src @ offset)) T
+
+            let offset = (deref self.ctx-size)
+            self.ctx-size += (sizeof GL.uint)
+            sc_expression_append self.setup-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.setup-ctx)] offset)
+                    GL.CreateTextures target 1 ptr
+            let setup-ptr = `(load ptr)
+            sc_expression_append self.drop-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.drop-ctx)] offset)
+                    GL.DeleteTextures 1 ptr
+            let drive-ptr = `(load (gethandle [(copy self.drive-ctx)] offset))
+            sc_expression_append self.drive-body drive-ptr
+            _ setup-ptr drive-ptr
+
+        fn alloc-buffer (self)
+            let T = (mutable @GL.uint)
+            inline gethandle (src offset)
+                bitcast (& (src @ offset)) T
+
+            let offset = (deref self.ctx-size)
+            self.ctx-size += (sizeof GL.uint)
+            sc_expression_append self.setup-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.setup-ctx)] offset)
+                    GL.CreateBuffers 1 ptr
+            let setup-ptr = `(load ptr)
+            sc_expression_append self.drop-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.drop-ctx)] offset)
+                    GL.DeleteBuffers 1 ptr
+            let drive-ptr = `(load (gethandle [(copy self.drive-ctx)] offset))
+            sc_expression_append self.drive-body drive-ptr
+            _ setup-ptr drive-ptr
+
+    #fn visit-join-const-clause (module id)
+        local values : (Array Value)
+        fn join (module id values)
+            returning void
+            raising Error
+            let recur = this-function
+            expr := (module.exprs @ id)
+            let op a1 a2 a3 = (unpack expr)
+            op := op as Op
+            switch op
+            case Op.CONST32
+                'append values
+                    sc_const_int_new u32 a1
+            case Op.CONST64
+                'append values
+                    sc_const_int_new u32 a1
+                'append values
+                    sc_const_int_new u32 a2
+            case Op.JOIN
+                recur module a1 values
+                recur module a2 values
+            default
+                error
+                    .. (repr op) " operation not permitted in a JOIN clause"
+            ;
+        join module id values
+        let sz = ((countof values) as u32)
+        let T = (sc_vector_type u32 sz)
+        sc_const_aggregate_new T (sz as i32) (& (values @ 0))
+
+    fn syskey->flag (key)
+        switch key
+        case SystemKey.Setup InputFlags.Setup
+        case SystemKey.ScreenSize InputFlags.ScreenSize
+        case SystemKey.Iteration InputFlags.Iteration
+        case SystemKey.IState InputFlags.State
+        case SystemKey.Break InputFlags.Break
+        case SystemKey.Close InputFlags.Close
+        case SystemKey.Readline InputFlags.Readline
+        case SystemKey.SampleRate InputFlags.SampleRate
+        case SystemKey.SampleCount InputFlags.SampleCount
+        default
+            error
+                .. "unsupported input key: " (repr key)
+
+    fn read-input (module ctx key)
+        let ins = (copy ctx.ins)
+        let flag = (syskey->flag key)
+        inline readfield (fieldname)
+            spice-quote
+                assert ((ins.flags & flag) == flag)
+                copy (getattr ins fieldname)
+        switch key
+        pass SystemKey.Setup InputFlags.Setup
+        pass SystemKey.Break InputFlags.Break
+        pass SystemKey.Close InputFlags.Close
+        do `1:u32
+        case SystemKey.ScreenSize
+            readfield 'screen-size
+        case SystemKey.Iteration
+            readfield 'iteration
+        case SystemKey.IState
+            readfield 'state
+        case SystemKey.Readline
+            readfield 'readline
+        case SystemKey.SampleRate
+            readfield 'samplerate
+        case SystemKey.SampleCount
+            readfield 'samplecount
+        default
+            error
+                .. "unsupported input key: " (repr key)
+
+    fn write-output (module ctx key value)
+        let outs = (copy ctx.outs)
+        let body = ctx.drive-body
+        #dump module body key value
+        key as:= SystemKey
+
+        inline writefield (flagsym fieldname)
+            let flag = (getattr OutputFlags flagsym)
+            sc_expression_append body `(outs.flags |= flag)
+            sc_expression_append body
+                `(setoption-impl (getattr outs fieldname) value)
+        switch key
+        # u32[?]
+        case SystemKey.OState
+            writefield 'State 'state
+        # zterm u32[?]
+        case SystemKey.Stdout
+            writefield 'Stdout 'stdout
+        # u32[0]
+        case SystemKey.BlockBreak
+            writefield 'BlockBreak
+        # u32[0]
+        case SystemKey.BlockClose
+            writefield 'BlockClose
+        # f32[width * height * 4]
+        case SystemKey.Screen
+            writefield 'Screen 'screen
+        # zterm u32[?]
+        case SystemKey.Title
+            writefield 'Title 'title
+        # u32[4 * ?]
+        #case SystemKey.Program
+            writefield 'Program 'program
+        # zterm u32[?]
+        case SystemKey.Prompt
+            writefield 'Prompt 'prompt
+        # i32
+        case SystemKey.Exit
+            writefield 'Exit 'exit
+        # f32[samplecount * 2]
+        case SystemKey.Sound
+            writefield 'Sound 'sound
+        default
+            error
+                .. "unsupported output key: " (repr key)
+
+    fn... imagedim->symbol (fmt : ImageDim)
+        switch fmt
+        case ImageDim.1D '1D
+        case ImageDim.2D '2D
+        case ImageDim.3D '3D
+        case ImageDim.Cube 'Cube
+        case ImageDim.Rect 'Rect
+        case ImageDim.Buffer 'Buffer
+        default
+            error
+                .. "unsupported image dimensionality: " (repr fmt)
+
+    fn... imageformat->symbol (fmt : ImageFormat)
+        switch fmt
+        case ImageFormat.RGBA8UNORM 'Rgba8
+        default
+            error
+                .. "unsupported image format: " (repr fmt)
+
+    fn... imageformat->GL (fmt : ImageFormat)
+        # https://www.khronos.org/registry/OpenGL-Refpages/gl4/html/glBindImageTexture.xhtml
+        switch fmt
+        case ImageFormat.RGBA8UNORM GL.RGBA8
+        default
+            error
+                .. "unsupported image format: " (repr fmt)
+
+    inline simplequote (x) `x
+
+    fn genbufstorage (module id ctx)
+        # BUFSTORAGE size
+        from (methodsof module) let opof argsof iterexprlist
+        let rtype = ('typeof module id)
+        let a1 = ((argsof id 0) * (sizeof u32))
+        let setup-ptr drive-ptr = ('alloc-buffer ctx)
+        from GL let NamedBufferStorage
+        let flags = 0:u32
+            #| GL.DYNAMIC_STORAGE_BIT
+                GL.MAP_READ_BIT
+                GL.MAP_WRITE_BIT
+                GL.MAP_PERSISTENT_BIT
+                GL.MAP_COHERENT_BIT
+        sc_expression_append ctx.setup-body
+            `(NamedBufferStorage setup-ptr a1 null flags)
+        drive-ptr
+
+    fn gentexstorage (module imgstorage ctx)
+        from imgstorage let x y z levels samples
+        let rtype = imgstorage.type
+
+        let dim format arrayed? ms? =
+            dispatch ('handleof module rtype)
+            case image (self)
+                from self let dim format array? ms?
+            default
+                error "image type expected"
+        let fmt = (imageformat->GL format)
+        let target =
+            switch dim
+            case ImageDim.1D
+                if arrayed?
+                    GL.TEXTURE_1D_ARRAY
+                else
+                    GL.TEXTURE_1D
+            case ImageDim.2D
+                if arrayed?
+                    if ms?
+                        GL.TEXTURE_2D_MULTISAMPLE_ARRAY
+                    else
+                        GL.TEXTURE_2D_ARRAY
+                elseif ms?
+                    GL.TEXTURE_2D_MULTISAMPLE
+                else
+                    GL.TEXTURE_2D
+            case ImageDim.3D
+                GL.TEXTURE_3D
+            case ImageDim.Cube
+                if arrayed?
+                    GL.TEXTURE_CUBE_MAP_ARRAY
+                else
+                    GL.TEXTURE_CUBE_MAP
+            case ImageDim.Rect
+                GL.TEXTURE_RECTANGLE
+            #case ImageDim.Buffer
+                GL.TEXTURE_BUFFER
+            default
+                error "unsupported image dimensionality"
+        let fixedsamplelocations = GL.TRUE
+        let setup-ptr drive-ptr = ('alloc-texture ctx target)
+        from GL let TextureStorage1D TextureStorage2D TextureStorage3D \
+            TextureStorage2DMultisample TextureStorage3DMultisample
+        sc_expression_append ctx.setup-body
+            switch target
+            case GL.TEXTURE_1D
+                `(TextureStorage1D setup-ptr levels fmt x)
+            pass GL.TEXTURE_1D_ARRAY
+            pass GL.TEXTURE_2D
+            pass GL.TEXTURE_RECTANGLE
+            pass GL.TEXTURE_CUBE_MAP
+            do
+                `(TextureStorage2D setup-ptr levels fmt x y)
+            pass GL.TEXTURE_2D_ARRAY
+            pass GL.TEXTURE_3D
+            pass GL.TEXTURE_CUBE_MAP_ARRAY
+            do
+                `(TextureStorage3D setup-ptr levels fmt x y z)
+            case GL.TEXTURE_2D_MULTISAMPLE_ARRAY
+                `(TextureStorage3DMultisample setup-ptr samples fmt x y z fixedsamplelocations)
+            case GL.TEXTURE_2D_MULTISAMPLE
+                `(TextureStorage2DMultisample setup-ptr samples fmt x y fixedsamplelocations)
+            #case GL.TEXTURE_BUFFER
+                TextureBuffer
+            default
+                unreachable;
+        drive-ptr
+
+    fn visit (module id ctx)
+        if ('in? ctx.values id)
+            return;
+        # prevent cyclic references
+        'set ctx.values id `none
+        inline get (id...)
+            va-map
+                inline (id)
+                    try (copy ('get ctx.values id))
+                    else
+                        error "could not resolve cached value"
+                        #trap;
+                id...
+        inline vecop1 (self op)
+            `(op [(get self.value)])
+        inline castvecop1 (self op T)
+            `(op [(get self.value)] T)
+        inline vecop2 (self op)
+            `(op [(get self.lhs)] [(get self.rhs)])
+        inline veccmpop2 (self op)
+            `(op [(get self.lhs)] [(get self.rhs)])
+        let handle = ('handleof module id)
+        let vacount = ('vacount handle)
+        vvv bind value
+        dispatch handle
+        case uconst (self) `[self.value]
+        case fconst (self) `[self.value]
+        case add (self) (vecop2 self add)
+        case sub (self) (vecop2 self sub)
+        case mul (self) (vecop2 self mul)
+        case udiv (self) (vecop2 self udiv)
+        case sdiv (self) (vecop2 self sdiv)
+        case urem (self) (vecop2 self urem)
+        case srem (self) (vecop2 self srem)
+
+        case shl (self) (vecop2 self shl)
+        case ushr (self) (vecop2 self lshr)
+        case sshr (self) (vecop2 self ashr)
+        case and (self) (vecop2 self band)
+        case or (self) (vecop2 self bor)
+        case xor (self) (vecop2 self bxor)
+
+        case findmsb (self) (vecop1 self findmsb)
+        case findlsb (self) (vecop1 self findlsb)
+        case bitcount (self) (vecop1 self bitcount)
+
+        case eq (self) (veccmpop2 self icmp==)
+        case ne (self) (veccmpop2 self icmp!=)
+        case ugt (self) (veccmpop2 self icmp>u)
+        case uge (self) (veccmpop2 self icmp>=u)
+        case ult (self) (veccmpop2 self icmp<u)
+        case ule (self) (veccmpop2 self icmp<=u)
+        case sgt (self) (veccmpop2 self icmp>s)
+        case sge (self) (veccmpop2 self icmp>=s)
+        case slt (self) (veccmpop2 self icmp<s)
+        case sle (self) (veccmpop2 self icmp<=s)
+
+        case fadd (self) (vecop2 self fadd)
+        case fsub (self) (vecop2 self fsub)
+        case fmul (self) (vecop2 self fmul)
+        case fdiv (self) (vecop2 self fdiv)
+        case frem (self) (vecop2 self frem)
+        case fneg (self) (vecop1 self fneg)
+
+        case sqrt (self) (vecop1 self sqrt)
+        case sin (self) (vecop1 self sin)
+        case cos (self) (vecop1 self cos)
+
+        case foeq (self) (veccmpop2 self fcmp==o)
+        case fone (self) (veccmpop2 self fcmp!=o)
+        case fogt (self) (veccmpop2 self fcmp>o)
+        case foge (self) (veccmpop2 self fcmp>=o)
+        case folt (self) (veccmpop2 self fcmp<o)
+        case fole (self) (veccmpop2 self fcmp<=o)
+
+        case fueq (self) (veccmpop2 self fcmp==u)
+        case fune (self) (veccmpop2 self fcmp!=u)
+        case fugt (self) (veccmpop2 self fcmp>u)
+        case fuge (self) (veccmpop2 self fcmp>=u)
+        case fult (self) (veccmpop2 self fcmp<u)
+        case fule (self) (veccmpop2 self fcmp<=u)
+
+        case fo (self) (veccmpop2 self fcmp-ord)
+        case fu (self) (veccmpop2 self fcmp-uno)
+
+        case utof (self) (castvecop1 self uitofp f32)
+        case stof (self) (castvecop1 self sitofp f32)
+        case ftou (self) (castvecop1 self fptoui u32)
+        case ftos (self) (castvecop1 self fptosi u32)
+
+        case comp (self)
+            `([(get self.value)] @ [self.index])
+        case fvec2 (self)
+            `(vec2 [(get self.x)] [(get self.y)])
+        case fvec3 (self)
+            `(vec3 [(get self.x)] [(get self.y)] [(get self.z)])
+        case fvec4 (self)
+            `(vec4 [(get self.x)] [(get self.y)] [(get self.z)] [(get self.w)])
+        case uvec2 (self)
+            `(uvec2 [(get self.x)] [(get self.y)])
+        case uvec3 (self)
+            `(uvec3 [(get self.x)] [(get self.y)] [(get self.z)])
+        case uvec4 (self)
+            `(uvec4 [(get self.x)] [(get self.y)] [(get self.z)] [(get self.w)])
+        case fvec (self)
+            switch self.count
+            case 1 `f32
+            case 2 `vec2
+            case 3 `vec3
+            case 4 `vec4
+            default
+                error "unsupported vector size"
+        case uvec (self)
+            switch self.count
+            case 1 `u32
+            case 2 `uvec2
+            case 3 `uvec3
+            case 4 `uvec4
+            default
+                error "unsupported vector size"
+        case globalid (self)
+            `(deref gl_GlobalInvocationID)
+        case load (self)
+            `(load [(get self.pointer)])
+        case getelementptr (self)
+            let call = (sc_call_new `getelementptr)
+            sc_call_append_argument call (get self.value)
+            let indices = self.indices
+            for i in (range vacount)
+                sc_call_append_argument call (get (indices @ i))
+            call
+        case image (self)
+            let arrayed? = (self.array? as i32)
+            let multisampled? = (self.ms? as i32)
+            let T =
+                switch ('format self.format)
+                case ImageFormat.UNORM vec4
+                case ImageFormat.SNORM vec4
+                case ImageFormat.U uvec4
+                case ImageFormat.S ivec4
+                case ImageFormat.F vec4
+                default
+                    error "unknown component format"
+            let dim = (imagedim->symbol self.dim)
+            let format = (imageformat->symbol self.format)
+            `[(sc_image_type T dim 0 arrayed? multisampled? 2 format unnamed)]
+        case bindings (self) `none
+        case imagestorage (self) `none
+        case uniform (self)
+            let T = ((get self.type) as type)
+            let flags = 0
+            let glob = (sc_global_new 'u T flags 'UniformConstant)
+            sc_global_set_location glob (self.location as i32)
+            `glob
+        case wimage (self)
+            let T = ((get self.type) as type)
+            let flags =
+                |
+                    global-flag-coherent
+                    global-flag-restrict
+                    global-flag-non-readable
+            let glob = (sc_global_new 'wimg T flags 'UniformConstant)
+            sc_global_set_binding glob (self.binding as i32)
+            `glob
+        #case wssbo (self)
+            # SSBOATTR key target? : type
+            let T = ((translate rtype) as type)
+            let T = (tuple.type (array.type T -1))
+            let flags =
+                |
+                    global-flag-buffer-block
+                    global-flag-coherent
+                    global-flag-restrict
+                    if (a2 == 0:u32) global-flag-non-writable
+                    else global-flag-non-readable
+            let glob = (sc_global_new 'ssboattr T flags 'Uniform)
+            a1 as:= i32
+            sc_global_set_binding glob a1
+            `glob
+        case imagewrite (self)
+            `(Image-write [(get self.target)] [(get self.offset)] [(get self.element)])
+        #case Op.WRITE
+            # IMAGEWRITE attr index value : imagetype
+            let a1 a2 a3 = (translate a1 a2 a3)
+            `(write-impl a1 a2 a3)
+        case computefn (self)
+            from self let x y z body
+            let body = (get body)
+
+            spice-quote
+                fn main ()
+                    local_size x y z
+                    body
+                    return;
+            'alloc-program ctx main
+        case dispatch (self)
+            let pg = (get self.func)
+            let x y z = (get self.x self.y self.z)
+            let sources sinks = self.sources self.sinks
+
+            from GL let DispatchCompute DispatchComputeIndirect
+                \ BindBuffer DISPATCH_INDIRECT_BUFFER UseProgram
+
+            let dispatchcmd =
+                `(DispatchCompute x y z)
+                #spice-quote
+                    BindBuffer DISPATCH_INDIRECT_BUFFER source
+                    DispatchComputeIndirect 0
+
+            let body = (sc_expression_new)
+            sc_expression_append body `(UseProgram pg)
+
+            local retargs : (Array Value)
+
+            # bind values from function body instructions
+            do
+                let handle = ('handleof module sources)
+                let numsources = ('vacount handle)
+                let sources =
+                    dispatch handle
+                    case bindings (self) self.entries
+                    default
+                        error "sources must be bindings"
+                for i in (range numsources)
+                    let v k = (unpack (sources @ i))
+                    let khandle = ('handleof module k)
+                    dispatch khandle
+                    case uniform (self)
+                        let k = (get k)
+                        let v = (get v)
+                        let loc = (sc_global_location k)
+                        if (loc >= 0)
+                            sc_expression_append body `(GL.Uniform (ptrtoref k) v)
+                        else
+                            error "uniformattr has no binding"
+                    #case Op.SSBOATTR
+                        let b = (sc_global_binding k)
+                        assert (b >= 0)
+                        from GL let BindBufferBase SHADER_STORAGE_BUFFER
+                        sc_expression_append body
+                            spice-quote
+                                BindBufferBase SHADER_STORAGE_BUFFER b v
+                    default
+                        error
+                            .. "invalid binding type: " (string khandle.typeid.name)
+            do
+                let handle = ('handleof module sinks)
+                let numsinks = ('vacount handle)
+                let sinks =
+                    dispatch handle
+                    case bindings (self) self.entries
+                    default
+                        error "sources must be bindings"
+                for i in (range numsinks)
+                    let v k = (unpack (sinks @ i))
+                    let khandle = ('handleof module k)
+                    dispatch khandle
+                    case wimage (self)
+                        let vhandle = ('handleof module v)
+                        dispatch vhandle
+                        case imagestorage (self)
+                            let v = (gentexstorage module self ctx)
+                            #define-type "imagestorage"  (RIFF "IMST") (tuple (type = AnyId) (x = u32) (y = u32) (z = u32) (levels = u32) (samples = u32))
+                            'append retargs v
+                            let imgfmt =
+                                dispatch ('handleof module self.type)
+                                case image (self)
+                                    imageformat->GL self.format
+                                default
+                                    error "invalid type for image"
+                            let b = (sc_global_binding (get k))
+                            assert (b >= 0)
+                            from GL let FALSE WRITE_ONLY BindImageTexture
+                            sc_expression_append body
+                                spice-quote
+                                    BindImageTexture b v
+                                        0 # level
+                                        FALSE # layered
+                                        0 # layer
+                                        WRITE_ONLY # access
+                                        imgfmt
+                        default
+                            error
+                                .. "invalid binding source for image: " (string vhandle.typeid.name)
+                    default
+                        error
+                            .. "invalid binding type: " (string khandle.typeid.name)
+                    #
+                        v as:= Id
+                        assert ((opof v) == Op.BUFSTORAGE)
+                        let v = (genbufstorage module v ctx)
+                        'append retargs v
+                        let b = (sc_global_binding k)
+                        assert (b >= 0)
+                        from GL let BindBufferBase SHADER_STORAGE_BUFFER
+                        sc_expression_append body
+                            spice-quote
+                                BindBufferBase SHADER_STORAGE_BUFFER b v
+
+            sc_expression_append body dispatchcmd
+            sc_expression_append body `(UseProgram 0)
+            sc_expression_append ctx.drive-body body
+            sc_argument_list_new ((countof retargs) as i32) (& (retargs @ 0))
+        case input (self)
+            read-input module ctx self.source
+        case output (self)
+            write-output module ctx self.sink (get self.value)
+            `()
+        case outputs (self) `()
+        default
+            error "unhandled node type"
+        'set ctx.values id value
+        ;
+
+    let setup-fn = (sc_template_new 'setup)
+
+    let alloc-ctx = (sc_template_new 'alloc-ctx)
+    sc_template_set_inline alloc-ctx
+    let setup-body = (sc_expression_new)
+    sc_expression_append setup-body `(raising Error)
+    let setup-ctx = (sc_call_new alloc-ctx)
+    sc_expression_append setup-body setup-ctx
+
+    let drive-ctx = (sc_parameter_new 'ctx)
+    let drive-ins = (sc_parameter_new 'ins)
+    let drive-outs = (sc_parameter_new 'outs)
+    let drive-fn = (sc_template_new 'drive)
+    sc_template_append_parameter drive-fn drive-ctx
+    sc_template_append_parameter drive-fn drive-ins
+    sc_template_append_parameter drive-fn drive-outs
+
+    let drop-ctx = (sc_parameter_new 'ctx)
+    let drop-fn = (sc_template_new 'drop)
+    sc_template_append_parameter drop-fn drop-ctx
+
+    let drive-body = (sc_expression_new)
+    let drop-body = (sc_expression_new)
+
+    let drive-ctx = `(bitcast drive-ctx @u8)
+    sc_expression_append drive-body drive-ctx
+
+    let drop-ctx = `(bitcast drop-ctx @u8)
+    sc_expression_append drop-body drop-ctx
+
+    local ctx =
+        Context
+            ctx-size = 0
+            setup-ctx = setup-ctx
+            setup-body = setup-body
+            drive-ctx = drive-ctx
+            ins = drive-ins
+            outs = drive-outs
+            drive-body = drive-body
+            drop-ctx = drop-ctx
+            drop-body = drop-body
+
+    'descend module ('rootid module)
+        on-leave =
+            capture (module id) {&ctx}
+                try
+                    visit module id ctx
+                except (err)
+                    hide-traceback;
+                    error@+ err unknown-anchor
+                        .. "while compiling " ('repr module id)
+
+    sc_expression_append ctx.setup-body `(bitcast [(copy setup-ctx)] voidstar)
+    sc_expression_append ctx.drive-body `()
+    sc_expression_append ctx.drop-body `(free [(copy ctx.drop-ctx)])
+
+    sc_template_set_body alloc-ctx `(malloc-array u8 [(copy ctx.ctx-size)])
+
+    sc_template_set_body setup-fn ctx.setup-body
+    sc_template_set_body drive-fn ctx.drive-body
+    sc_template_set_body drop-fn ctx.drop-body
+
+    spice-quote
+        fn realize-functions ()
+            return
+                setup-fn as VMSetupFunctionType
+                drive-fn as VMDriveFunctionType
+                drop-fn as VMDropFunctionType
+    let RealizeType =
+        pointer
+            function
+                Arguments VMSetupFunctionType VMDriveFunctionType \
+                    VMDropFunctionType
+
+    let func = (sc_typify_template realize-functions 0 null)
+    let fptr = (sc_compile func 0)
+    fptr := fptr as RealizeType
+    (fptr)
 
 ################################################################################
 

          
@@ 718,28 2043,62 @@ local module : FIR
                 ILCall sc_write (ILString "hello me\n")
             ILVA param0 param0
 
+do
+    let _uvec3 = uvec3
+    from (methodsof module.builder) let input uniform uvec wimage dispatch
+        \ bindings computefn imagestorage imagewrite globalid load fdiv
+        \ fconst comp utof fadd fmul sin fvec2 fvec4 udiv add uconst image
+        \ outputs output uvec2
 
-do
-    from (methodsof module.builder) let uvec fvec2 fvec3 fvec4 input output uconst
-        \ fconst range comp and xor utof sin cos fadd fmul fdiv sample
-        \ nativefn symbol
-
+    let inpss = (input SystemKey.ScreenSize)
+    let inpit = (input SystemKey.Iteration)
 
-    do
-        let inpss = (input (uvec 2) SystemKey.ScreenSize)
-        let inpit = (input (uvec 1) SystemKey.Iteration)
-
-        let TS = (uconst 32)
-        let checkers_texture =
+    let ss = (uniform (uvec 2) 0)
+    let u_it = (uniform (uvec 1) 1)
+    let imgtype = (image ImageDim.2D ImageFormat.RGBA8UNORM false false)
+    let img = (wimage imgtype 1)
+    let func =
+        computefn 8 8 1
             do
-                let pos = (range TS TS (uconst 1))
+                # screen size
+                let ss = (load ss)
+                let it = (fdiv (utof (load u_it)) (fconst 60.0))
+                let w h =
+                    comp 0 ss
+                    comp 1 ss
+                let pos = (globalid)
                 let x y =
                     comp 0 pos
                     comp 1 pos
-                utof (xor (and x (uconst 1)) (and y (uconst 1)))
+                let u = (fdiv (utof x) (utof w))
+                let v = (fdiv (utof y) (utof h))
+                let z = (fadd (fmul (sin it) (fconst 0.5)) (fconst 0.5))
+                imagewrite
+                    fvec4 u v z (fconst 1)
+                    uvec2 x y
+                    load img
+    outputs
+        output SystemKey.Screen
+            # indirect dispatch
+            dispatch func
+                udiv (add (comp 0 inpss) (uconst 7)) (uconst 8)
+                udiv (add (comp 1 inpss) (uconst 7)) (uconst 8)
+                uconst 1
+                bindings
+                    tupleof inpss ss
+                    tupleof inpit u_it
+                bindings
+                    tupleof
+                        imagestorage imgtype 4096 4096 1 1 0
+                        img
 
-        output
-            tupleof SystemKey.Screen
+#do
+    from (methodsof module.builder) let uvec fvec2 fvec3 fvec4 input output uconst
+        \ fconst range comp and xor utof sin cos fadd fmul fdiv sample
+        \ nativefn symbol outputs
+
+        outputs
+            output SystemKey.Screen
                 do
                     # frame time
                     let it = (fdiv (utof inpit) (fconst 60.0))

          
@@ 753,28 2112,64 @@ do
                         comp 1 pos
                     let u = (fdiv (utof x) (utof w))
                     let v = (fdiv (utof y) (utof h))
-                    let q = (sample checkers_texture (fvec2 u v))
-                    #let q = (fconst 1.0)
+                    #let q = (sample checkers_texture (fvec2 u v))
+                    let q = (fconst 1.0)
                     let u = (fmul q u)
                     let v = (fmul q v)
                     let z = (fmul q (fadd (fmul (sin it) (fconst 0.5)) (fconst 0.5)))
-                    (fvec4 u v z (fconst 1)) as AnyId
+                    fvec4 u v z (fconst 1)
+
+    do
+        let inpss = (input SystemKey.ScreenSize)
+        let inpit = (input SystemKey.Iteration)
+
+        let TS = (uconst 32)
+        #let checkers_texture =
+            do
+                let pos = (range TS TS (uconst 1))
+                let x y =
+                    comp 0 pos
+                    comp 1 pos
+                utof (xor (and x (uconst 1)) (and y (uconst 1)))
+
+        outputs
+            output SystemKey.Screen
+                do
+                    # frame time
+                    let it = (fdiv (utof inpit) (fconst 60.0))
+                    # screen size
+                    let w h =
+                        comp 0 inpss
+                        comp 1 inpss
+                    let pos = (range w h (uconst 1))
+                    let x y =
+                        comp 0 pos
+                        comp 1 pos
+                    let u = (fdiv (utof x) (utof w))
+                    let v = (fdiv (utof y) (utof h))
+                    #let q = (sample checkers_texture (fvec2 u v))
+                    let q = (fconst 1.0)
+                    let u = (fmul q u)
+                    let v = (fmul q v)
+                    let z = (fmul q (fadd (fmul (sin it) (fconst 0.5)) (fconst 0.5)))
+                    fvec4 u v z (fconst 1)
 
 # perform an identity transform and swap out the new module
     all transformations are immutable.
-do
-    local newmodule : FIR
-    let newid = ('translate newmodule module ('rootid module))
-    module = newmodule
+inline cleanup ()
+    do
+        local newmodule : FIR
+        let newid = ('translate newmodule module ('rootid module))
+        module = newmodule
+cleanup;
 'dump module
+#'showdot module ('rootid module)
+    module-dir .. "/tukdag"
 do
-    local newmodule : FIR
-    let newid = (translate-FIR newmodule module)
-    module = newmodule
-'showdot module ('rootid module)
-    module-dir .. "/tukdag"
-#let f =
-    generate-IL module
+    let fsetup fdrive fdrop = (generate-IL module)
+
+    local opts : VMOptions
+    runvm fsetup fdrive fdrop opts
 
 drop module
 unlet module