397b5abfc0b5 — Leonard Ritter 8 days ago
* dot: convert declaration to string
4 files changed, 432 insertions(+), 118 deletions(-)

M lib/tukan/CADAG/dot.sc
M lib/tukan/CADAG/init.sc
M testing/test_cadag.sc
M testing/tukdag.sc
M lib/tukan/CADAG/dot.sc +4 -3
@@ 17,8 17,8 @@ type+ CADAG
             'clear tmp
         'append tmp
             """"digraph "CADAG" {
-                    ranksep=0.2 rankdir="TB";
-                    bgcolor = "#1d1f21";
+                    rankdir="TB";
+                    bgcolor="#1d1f21";
                     splines=ortho;
                     node [color="#c5c8c6" fillcolor="#1d1f21" fontcolor="#c5c8c6"
                         style="rounded, filled" shape=box height=0.01 fontsize=8

          
@@ 47,7 47,8 @@ type+ CADAG
                     let handle = ('handleof module id)
                     writeattr "label"
                         tostring
-                            .. "%" idstr " = " (string handle.typeid.name)
+                            'tostring module id
+                            #.. "%" idstr " = " (string handle.typeid.name)
                     let typeid = (unpack handle)
                     let fontcolor =
                         'dispatch typeid

          
M lib/tukan/CADAG/init.sc +100 -22
@@ 219,6 219,12 @@ fn repr-atomic-value (ET value)
                 .. "%" (tostring value)
     else `(repr value)
 
+fn tostring-atomic-value (ET value)
+    if (idtype? ET)
+        spice-quote
+            .. "%" (tostring value)
+    else `(tostring value)
+
 fn value-typeid-repr (T value sz)
     returning Value
     try

          
@@ 278,9 284,71 @@ fn value-typeid-repr (T value sz)
     default
         `(.. " " [(repr-atomic-value T value)])
 
+fn value-typeid-tostring (T value sz)
+    returning Value
+    try
+        let func = ('@ T '__CADAG_tostring)
+        return
+            spice-quote
+                .. " " (func value sz)
+    else;
+    let ST = ('storageof T)
+    switch ('kind ST)
+    pass type-kind-array
+    pass type-kind-tuple
+    do
+        let value = `(storagecast value)
+        let body = (sc_expression_new)
+        let SZ = (('sizeof ST) as u32)
+        vvv bind str
+        fold (str = `"") for i ET in (enumerate ('elements ST))
+            if ('unsized? ET) # last element
+                let ET = ('element@ ET 0)
+                let ETsz = (('sizeof ET) as u32)
+                if (ET == char)
+                    sc_expression_append body
+                        spice-quote
+                            let numelements = ((sz * u32_size - SZ) // ETsz)
+                            let arr = (value @ i)
+                            let str =
+                                .. str " "
+                                    tostring
+                                        string (& (arr @ 0)) numelements
+                    str
+                else
+                    sc_expression_append body
+                        spice-quote
+                            let numelements = ((sz * u32_size - SZ) // ETsz)
+                            let arr = (value @ i)
+                            let str =
+                                loop (k str = 0:u32 str)
+                                    if (k == numelements)
+                                        break str
+                                    let elem = (arr @ k)
+                                    let elemrepr =
+                                        spice-unquote
+                                            this-function ET elem 0
+                                    _ (k + 1) (.. str elemrepr)
+                    str
+            else
+                spice-quote
+                    let str =
+                        .. str " "
+                            spice-unquote
+                                tostring-atomic-value ET `(value @ i)
+                sc_expression_append body str
+                str
+        sc_expression_append body str
+        body
+    default
+        `(.. " " [(tostring-atomic-value T value)])
+
 spice value-typeid-repr (value sz)
     value-typeid-repr ('typeof value) value sz
 
+spice value-typeid-tostring (value sz)
+    value-typeid-tostring ('typeof value) value sz
+
 run-stage;
 
 type CADAG < Struct

          
@@ 641,8 709,9 @@ type+ CADAG
         id
 
     fn... rootid (self)
+        let cls = (typeof self)
         # raw u32 without type id
-        deref ('last self.words)
+        bitcast (deref ('last self.words)) cls.AnyId
 
     @@ memo
     inline alloc-func (cls typeid)

          
@@ 788,30 857,31 @@ type+ CADAG
                     refoffset = -1:u32
                     refindex = 0
 
-    fn transform (self root ...)
+    fn translate (self oldmodule root ...)
+        viewing self
+        viewing oldmodule
         let cls = (typeof self)
-        local newmodule : cls
         local aliases : (Map u32 u32)
         let alias =
             va-option alias ...
-                inline (id)
+                inline (self oldmodule id)
                     copy ('get aliases id)
         let on-enter =
             va-option on-enter ...
-                inline (id)
+                inline (self oldmodule id)
         let on-alias =
             va-option on-alias ...
-                inline (oldid newid)
+                inline (self newid oldmodule oldid)
                     'set aliases oldid newid
         let visit =
             va-option visit ...
-                inline (module handle finalize)
+                inline (self handle finalize)
                     let newid = (finalize)
                     #report "done" md.id "->" newid (string (get-typename md.typeid))
                     newid
         local stack : TransformStack
-        on-enter root
-        'push stack self root
+        on-enter self oldmodule root
+        'push stack oldmodule root
         loop ()
             let md = ('peek stack)
             let ofs = ('enum-id-offset ((copy md.typeid) as cls.TypeId) (copy md.refindex))

          
@@ 820,8 890,8 @@ type+ CADAG
             if (wordofs >= md.size)
                 # includes header
                 let stackptr = (& (stack.data @ md.offset))
-                capture finalize () {&newmodule &md stackptr}
-                    'commit-from newmodule stackptr
+                capture finalize () {&self stackptr}
+                    'commit-from self stackptr
                 # skip header
                 let stackptr =
                     if md.size (& (stackptr @ 2))

          
@@ 829,13 899,13 @@ type+ CADAG
                 let handle = (bitcast
                     ((storageof cls.MutableHandleType) md.typeid md.size stackptr)
                     cls.MutableHandleType)
-                let newid = (visit (view newmodule) handle finalize)
+                let newid = (visit self handle finalize)
                 let oldid = (copy md.id)
-                on-alias oldid newid
+                on-alias self newid oldmodule oldid
                 # clear
                 'pop stack
                 if (empty? stack)
-                    return newmodule (copy newid)
+                    return (copy newid)
                 _ oldid (storagecast newid)
             else
                 assert ((ofs % u32_size) == 0)

          
@@ 844,11 914,11 @@ type+ CADAG
                 md.refindex += 1
                 let oldid = (copy (stack.data @ ofs))
                 let newid =
-                    try (alias oldid)
+                    try (alias self oldmodule oldid)
                     else
-                        on-enter oldid
                         # no alias
-                        'push stack self oldid
+                        on-enter self oldmodule oldid
+                        'push stack oldmodule oldid
                         repeat;
                 _ oldid newid
             # update reference in parent

          
@@ 933,11 1003,7 @@ type+ CADAG
     fn offsetof (self id)
         (id as u32) + 2
 
-    fn... load (self, id : Id)
-        let IdT = (typeof id)
-        let T = IdT.Type
-        bitcast (this-function self id) @T
-    case (self, id : u32)
+    fn... load (self, id : u32)
         offset := (id as u32) + 2
         & (self.words @ offset)
 

          
@@ 956,6 1022,18 @@ type+ CADAG
                     T := ('typeinfo cls code) . T
                     value-typeid-repr (@ (bitcast ptr @T)) sz
 
+    fn... tostring (self, id : u32)
+        let cls = (typeof self)
+        let typeid sz = ('headerof self id)
+        let ptr = ('load self id)
+        ..
+            .. "%" (tostring id) " = "
+            string typeid.name
+            'dispatch typeid
+                inline "#hidden" (code cls)
+                    T := ('typeinfo cls code) . T
+                    value-typeid-tostring (@ (bitcast ptr @T)) sz
+
     fn dump (self)
         descend self ('rootid self)
             visit =

          
M testing/test_cadag.sc +4 -3
@@ 63,7 63,7 @@ do
     # instantiate a module
     local module : TestDAG
 
-    from (methodsof module) let store load rootid headerof transform descend alloc
+    from (methodsof module) let store load headerof descend alloc
 
     from (methodsof module.builder) let const const2 vec3 u32x str empty
 

          
@@ 80,8 80,9 @@ do
             vec3 k q m
 
     # perform a topological transform where we increment the constant values
-    let newmodule newid =
-        transform (rootid)
+    local newmodule : TestDAG
+    let newid =
+        'translate newmodule module ('rootid module)
             visit =
                 capture (module handle finalize) {}
                     dispatch handle

          
M testing/tukdag.sc +324 -90
@@ 10,6 10,8 @@ import ..lib.tukan.use
 using import tukan.CADAG
 using import tukan.CADAG.dot
 
+using import tukan.vm
+
 let SYSKEY_START = 0x80000000:u32
 
 enum SystemKey : u32

          
@@ 59,6 61,86 @@ enum SystemKey : u32
     # f32[samplecount * 2]
     Sound
 
+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)
+
+################################################################################
+
+enum ImageDim : u32
+    1D
+    2D
+    3D
+    Cube
+    Rect
+    Buffer
+
+enum ImageFormat : u32
+    # R|RG|RGBA .. 8|16|32 .. UNORM|SNORM|U|S|F
+
+    let UNORM SNORM U S F = 0 1 2 3 4
+
+    do
+        let comp-sym... = "R" "RG" "RGBA"
+        let fmt-sym... = "UNORM" "SNORM" "U" "S" "F"
+
+        va-map
+            inline (c)
+                let cname = (va@ c comp-sym...)
+                va-map
+                    inline (b)
+                        w := (1 << b)
+                        va-map
+                            inline (f)
+                                let fmtname = (va@ f fmt-sym...)
+                                static-if ((w == 32) & (f <= 1))
+                                    # no unorm/snorm for 32 bit
+                                else
+                                    let lit =
+                                        | c
+                                            (b - 3) << 2
+                                            f << 4
+                                    let sym =
+                                        Symbol
+                                            ..
+                                                cname
+                                                (tostring w)
+                                                fmtname
+                                    tag sym Nothing lit
+                            va-range (va-countof fmt-sym...)
+                    va-range 3 6
+            va-range (va-countof comp-sym...)
+
+    fn setcomponents (self count)
+        let bits =
+            switch count
+            case 1 0:u32
+            case 2 1:u32
+            case 3 2:u32
+            case 4 2:u32
+            default
+                assert false
+                unreachable;
+        bitcast ((self & (~ 3:u32)) | bits) this-type
+
+    inline components (self)
+        1:u32 << (self & 3:u32)
+    inline bitwidth (self)
+        1:u32 << (((self >> 2:u32) & 3:u32) + 3:u32)
+    inline format (self)
+        (self >> 4:u32) & 7:u32
+
 ################################################################################
 
 # generate a new DAG module type

          
@@ 75,16 157,19 @@ let
     instrcolor... = (_ (dot.fontcolor = "#de5f84") (dot.color = "#de5f84"))
     commentcolor... = (_ (dot.fontcolor = "#969896") (dot.color = "#969896"))
 
-define-type "ILSymbol"          (RIFF "ISYM") (tuple (size = u32) (str = (array char)))
-    constcolor...
 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))

          
@@ 93,6 178,8 @@ define-type "ILTemplate"        (RIFF "I
 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...

          
@@ 102,6 189,8 @@ define-type "ILIntegerType"     (RIFF "I
     typecolor...
 define-type "ILRealType"        (RIFF "IREA") (tuple (width = i32))
     typecolor...
+define-type "ILVectorType"        (RIFF "IVET") (tuple (element = AnyId) (count = i32))
+    typecolor...
 define-type "ILArgumentsType"   (RIFF "IATY") (tuple (types = (array AnyId)))
     typecolor...
 define-type "ILStringType"      (RIFF "ISTY") (tuple)

          
@@ 133,12 222,17 @@ define-type "ILXValue"          (RIFF "I
         inline __CADAG_repr (self)
             repr (self as Value)
 
-define-type "vec"       (RIFF "VECT") (tuple i32)
+define-type "fvec"      (RIFF "FVEC") (tuple (count = i32))
+    typecolor...
+define-type "uvec"      (RIFF "UVEC") (tuple (count = i32))
     typecolor...
-define-type "vec2"      (RIFF "VEC2") (tuple AnyId AnyId)
-define-type "vec3"      (RIFF "VEC3") (tuple AnyId AnyId AnyId)
-define-type "vec4"      (RIFF "VEC4") (tuple AnyId AnyId AnyId AnyId)
-define-type "input"     (RIFF "INPT") (tuple AnyId SystemKey)
+define-type "fvec2"     (RIFF "FVC2") (tuple (x = AnyId) (y = AnyId))
+define-type "fvec3"     (RIFF "FVC3") (tuple (x = AnyId) (y = AnyId) (z = AnyId))
+define-type "fvec4"     (RIFF "FVC4") (tuple (x = AnyId) (y = AnyId) (z = AnyId) (w = AnyId))
+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))
     instrcolor...
 define-type "output"    (RIFF "OUTP") (tuple (array (tuple SystemKey AnyId)))
     instrcolor...

          
@@ 146,39 240,49 @@ define-type "uconst"    (RIFF "U32C") (t
     constcolor...
 define-type "fconst"    (RIFF "F32C") (tuple (value = f32))
     constcolor...
-define-type "range"     (RIFF "RANG") (tuple AnyId AnyId)
+define-type "range"     (RIFF "RANG") (tuple (x = AnyId) (y = AnyId) (z = AnyId))
     stringcolor...
-define-type "comp"      (RIFF "COMP") (tuple i32 AnyId)
-define-type "and"       (RIFF "BAND") (tuple AnyId AnyId)
+define-type "comp"      (RIFF "COMP") (tuple (index = i32) (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") (tuple AnyId AnyId)
+define-type "xor"       (RIFF "BXOR") Operator2Type
     funccolor...
-define-type "utof"      (RIFF "UTOF") (tuple AnyId)
+define-type "utof"      (RIFF "UTOF") Operator1Type
     funccolor...
-define-type "sin"       (RIFF "FSIN") (tuple AnyId)
+define-type "sin"       (RIFF "FSIN") Operator1Type
     funccolor...
-define-type "cos"       (RIFF "FCOS") (tuple AnyId)
+define-type "cos"       (RIFF "FCOS") Operator1Type
     funccolor...
-define-type "fadd"      (RIFF "FADD") (tuple AnyId AnyId)
+define-type "fadd"      (RIFF "FADD") Operator2Type
     funccolor...
-define-type "fmul"      (RIFF "FMUL") (tuple AnyId AnyId)
+define-type "fmul"      (RIFF "FMUL") Operator2Type
     funccolor...
-define-type "fdiv"      (RIFF "FDIV") (tuple AnyId AnyId)
+define-type "fdiv"      (RIFF "FDIV") Operator2Type
     funccolor...
-define-type "sample"    (RIFF "SAMP") (tuple AnyId AnyId)
+define-type "sample"    (RIFF "SAMP") (tuple (value = AnyId) (uv = AnyId))
     instrcolor...
 
 ################################################################################
 
 type+ FIR.BuilderType
-    let ILSymbol = this-type.ILSymbol
-    inline ILSymbol (self str)
-        static-if (none? str) (ILSymbol self 0)
-        else (ILSymbol self ((countof str) as u32) str)
-
     let ILString = this-type.ILString
     inline ILString (self str)
-        ILString self ((countof str) as u32) str
+        static-if (none? str) (ILString self 0)
+        else (ILString self ((countof str) as u32) str)
+
+    let ILSymbol = this-type.ILSymbol
+    inline... ILSymbol (self, str : AnyId)
+        ILSymbol self str
+    case (self, str : string)
+        ILSymbol self (ILString self str)
+
+    let ILBuiltin = this-type.ILBuiltin
+    inline... ILBuiltin (self, str : AnyId)
+        ILBuiltin self str
+    case (self, str : string)
+        ILBuiltin self (ILSymbol self str)
 
     let ILDo = this-type.ILDo
     inline ILEmbed (self ...)

          
@@ 320,7 424,10 @@ fn generate-IL (self)
                     f
                 case ILSymbol (self)
                     global? = true
-                    `[(Symbol (string (& (self.str @ 0)) (min vacount self.size)))]
+                    `[(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))]

          
@@ 406,58 513,191 @@ fn generate-IL (self)
 
 ################################################################################
 
-fn translate-FIR (self)
-    'transform self ('rootid self)
-        #on-enter =
-            capture (module id) {&funcstack}
-                #report "enter" id
-                let handle = ('handleof module id)
+struct ProgramInfo
+    range : AnyId
+    read_order : i32
+    ptr : Value = null
+    body : Value = null
+    bindbody : Value = null
+    dim : i32
+    buffersize : ivec3
+    next_location_index : i32
+    next_binding_index : i32
+    next_tu_index : i32
+    values : (Map AnyId Value)
+
+struct BufferInfo plain
+    ptr : Value = null
+    type : type
+    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
+    ins : AnyId
+    outs : AnyId
+    drive-body : Value
+    drop-ctx : Value
+    drop-body : Value
+    pginfostack : (Array (tuple AnyId i32))
+
+    inline __typecall (cls)
+        local self = (super-type.__typecall cls)
+        let key = ('getcpuprogramkey self)
+        'set self.programs key (ProgramInfo)
+        'append self.pginfostack key
+        deref self
+
+    fn getcpuprogramkey (self)
+        tupleof NoId 0
+
+    fn read-input (self module key)
+        from (methodsof module.builder) let ILSymbol ILConstInt
+            \ ILIntegerType ILCall ILBuiltin
+        let ins = (copy self.ins)
+        let flag = (syskey->flag key)
+        inline readfield (fieldname)
+            ILCall (ILBuiltin "extractvalue") ins
+                ILSymbol (fieldname as string)
+            #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
+            ILConstInt (ILIntegerType 32 false) 1
+        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 translate-FIR (self module)
+    viewing self
+    viewing module
+    local ctx : FIRContext
+    'append ctx.pginfostack ('getcpuprogramkey ctx)
+
+    vvv bind visit
+    capture (module handle finalize) {&ctx}
+        from (methodsof module.builder) let ILConstInt ILIntegerType
+            \ ILConstReal ILRealType ILGlobal ILSymbol ILVectorType
+            \ ILBuiltin ILCall ILKeyed
+        let vacount = ('vacount handle)
+        vvv bind op1
+        inline "#hidden" (self name)
+            return
+                ILCall (ILBuiltin name) self.value
+        vvv bind op2
+        inline "#hidden" (self name)
+            return
+                ILCall (ILBuiltin name) self.lhs self.rhs
+        inline constint (value)
+            ILConstInt (ILIntegerType 32 true) (bitcast value u32)
+        inline constfloat (value)
+            ILConstReal (ILRealType 32) value
+        dispatch handle
+        case output (self)
+        case uconst (self)
+            return
+                ILConstInt (ILIntegerType 32 false) self.value
+        case fconst (self)
+            return
+                ILConstReal (ILRealType 32) self.value
+        case range (self)
+            'pop ctx.pginfostack
+            return
+                ILCall (ILBuiltin "load")
+                    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")
+        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))
+            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))
+            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))
+            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)
+        default
+            error@ unknown-anchor
+                .. "while translating " (string handle.typeid.name)
+                "invalid node type"
+        finalize;
+
+    'translate self module ('rootid module)
+        on-enter =
+            capture (module oldmodule id) {&ctx}
+                let handle = ('handleof oldmodule 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
+                case range (self)
+                    'append ctx.pginfostack ('getcpuprogramkey ctx)
+                case input (self)
+                    return false
                 default;
                 true
-        visit =
-            capture (module handle finalize) {}
-                from (methodsof module.builder) let ILConstInt ILIntegerType
-                    \ ILConstReal ILRealType
-                let vacount = ('vacount handle)
-                dispatch handle
-                case output (self)
-                case uconst (self)
-                    return
-                        ILConstInt (ILIntegerType 32 false) self.value
-                case fconst (self)
-                    return
-                        ILConstReal (ILRealType 32) self.value
-                default;
-                    #error@ unknown-anchor
-                        .. "while translating " (string handle.typeid.name)
-                        "invalid node type"
-                finalize;
+        visit = visit
 
 ################################################################################
 
 # instantiate a module
 local module : FIR
 
-from (methodsof module) let rootid transform descend
-
 #do
     from (methodsof module.builder) let ILGlobal ILSymbol ILFunctionType
         \ ILArgumentsType ILNoReturnType ILStringType ILSymbol ILTemplate ILParams

          
@@ 478,19 718,19 @@ from (methodsof module) let rootid trans
 
 
 do
-    from (methodsof module.builder) let vec vec2 vec3 vec4 input output uconst
+    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
 
 
     do
-        let inpss = (input (vec 2) SystemKey.ScreenSize)
-        let inpit = (input (vec 1) SystemKey.Iteration)
+        let inpss = (input (uvec 2) SystemKey.ScreenSize)
+        let inpit = (input (uvec 1) SystemKey.Iteration)
 
         let TS = (uconst 32)
         let checkers_texture =
             do
-                let pos = (range TS TS)
+                let pos = (range TS TS (uconst 1))
                 let x y =
                     comp 0 pos
                     comp 1 pos

          
@@ 505,43 745,37 @@ do
                     let w h =
                         comp 0 inpss
                         comp 1 inpss
-                    let pos = (range w h)
+                    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 (vec2 u v))
+                    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)))
-                    (vec4 u v z (fconst 1)) as AnyId
+                    (fvec4 u v z (fconst 1)) as AnyId
 
 # perform an identity transform and swap out the new module
     all transformations are immutable.
-let newmodule newid = (transform (rootid))
-module = newmodule
-#module = newmodule
-#assert (newid == (rootid))
-#descend newid
+do
+    local newmodule : FIR
+    let newid = ('translate newmodule module ('rootid module))
+    module = newmodule
 'dump module
-let newmodule newid = (translate-FIR module)
-module = newmodule
+do
+    local newmodule : FIR
+    let newid = (translate-FIR newmodule module)
+    module = newmodule
 'showdot module ('rootid module)
     module-dir .. "/tukdag"
-let f =
+#let f =
     generate-IL module
 
 drop module
 unlet module
-unlet newmodule
-run-stage;
-
-compile
-    typify f bool
-    'dump-function
-    'dump-disassembly
 
 
 ;
  No newline at end of file