95e6eebefb93 — Leonard Ritter a month ago
* rasterize keyword works
5 files changed, 620 insertions(+), 349 deletions(-)

M lib/tukan/CADAG/dot.sc
M lib/tukan/CADAG/init.sc
M lib/tukan/FIR.sc
M testing/test_cadag.sc
M testing/tukdag.sc
M lib/tukan/CADAG/dot.sc +5 -4
@@ 19,7 19,7 @@ type+ CADAG
             """"digraph "CADAG" {
                     rankdir="TB";
                     bgcolor="#1d1f21";
-                    splines=ortho;
+                    splines=polyline;
                     node [color="#c5c8c6" fillcolor="#1d1f21" fontcolor="#c5c8c6"
                         style="rounded, filled" shape=box height=0.01 fontsize=8
                         fontname="mono bold"];

          
@@ 69,7 69,7 @@ type+ CADAG
                         'append tmp " -> "
                         'append tmp idstr
                         'append tmp " ["
-                        writeattr "headlabel" (tostring k)
+                        writestrattr "headlabel" (tostring k)
                         writestrattr "fontcolor" fontcolor
                         'dispatch typeid
                             inline "#hidden" (code cls)

          
@@ 84,7 84,7 @@ type+ CADAG
         'append tmp "}\n"
         commit tmp
 
-    fn showdot (self root basepath)
+    fn showdot (self rootid basepath)
         let dotpath = (.. basepath ".dot")
         let pngpath = (.. basepath ".png")
         let f =

          
@@ 92,8 92,9 @@ type+ CADAG
             else
                 print "failed to open dot file for writing"
                 return 255
-        'dot self ('rootid self)
+        'dot self rootid
             capture (s) {(view f)}
+                print s
                 'write f (& (s @ 0)) (countof s)
         drop f
         let err = (system (.. "dot -Tpng " dotpath " > " pngpath))

          
M lib/tukan/CADAG/init.sc +3 -3
@@ 1129,8 1129,7 @@ type+ CADAG
         pred
 
     fn... dump-scope (self, order : Array, scopetree : IndexArrayArray)
-        #let cls = (typeof self)
-        print ('repr self (order @ 0))
+        let cls = (typeof self)
         let count = (countof order)
         # index, subindex
         local stack : (Array (tuple u32 u32))

          
@@ 1168,7 1167,8 @@ type+ CADAG
                 sc_write
                     default-styler style-operator " ="
                 sc_write "\n"
-            'append stack (tupleof (subscope @ subidx) 0:u32)
+            if (idx != cls.NoId)
+                'append stack (tupleof (subscope @ subidx) 0:u32)
             ;
     case (self, rootid : Id)
         let ordered indices = ('ordered self rootid)

          
M lib/tukan/FIR.sc +524 -218
@@ 167,9 167,9 @@ let
 # FIR Level 2
 ################################################################################
 
-define-type "range"     (RIFF "RANG") (tuple (dims = (array AnyId)))
+define-type "compute"     (RIFF "COPU") (tuple (size = AnyId) (value = AnyId))
     stringcolor...
-enum PrimitiveType : u32
+enum PrimitiveMode : u32
     Point
     Line
     LineStrip

          
@@ 177,14 177,16 @@ enum PrimitiveType : u32
     Triangle
     TriangleStrip
     TriangleFan
-define-type "primitive" (RIFF "PRIM") (tuple (mode = PrimitiveType) (vertex = AnyId))
+define-type "rasterize"   (RIFF "RAST") (tuple
+    (mode = PrimitiveMode) (size = AnyId) (vertex = AnyId) (fragment = AnyId)
+    (viewport = AnyId) (target = AnyId))
     stringcolor...
-enum FragmentType : u32
+define-type "fragparams"  (RIFF "FRGA") (tuple)
+    stringcolor...
+enum InterpolationMode : u32
     Undefined
     Flat
     Smooth
-define-type "fragment"    (RIFF "FRAG") (tuple (primitive = AnyId) (attr = AnyId) (kind = FragmentType))
-    stringcolor...
 enum DepthTestType : u32
     False
     True

          
@@ 196,9 198,9 @@ enum DepthTestType : u32
     LessEqual
 define-type "depthtest" (RIFF "ZTST") (tuple (depthfunc = DepthTestType) (value = AnyId) (default = AnyId))
     stringcolor...
-define-type "overlay"  (RIFF "NOZT") (tuple (range = AnyId) (fragment = AnyId))
+define-type "overlay"  (RIFF "NOZT") (tuple (rangevalue = AnyId) (fragmentvalue = AnyId))
     stringcolor...
-define-type "clear" (RIFF "CLRI") (tuple (range = AnyId) (value = AnyId))
+define-type "clear" (RIFF "CLRI") (tuple (size = AnyId) (value = AnyId))
     stringcolor...
 define-type "sample" (RIFF "SAMP") (tuple (source = AnyId) (uv = AnyId))
     stringcolor...

          
@@ 215,6 217,8 @@ define-type "getelementptr" (RIFF "GELP"
     instrcolor...
 define-type "globalid"      (RIFF "GLID") (tuple)
     funccolor...
+define-type "fragcoord"     (RIFF "FRCO") (tuple)
+    funccolor...
 define-type "imagewrite"    (RIFF "IMGW") (tuple (element = AnyId) (offset = AnyId) (target = AnyId))
     mutinstrcolor...
 define-type "computefn"     (RIFF "CMFN") (tuple (x = u32) (y = u32) (z = u32) (body = AnyId))

          
@@ 255,7 259,7 @@ define-type "instanceid"    (RIFF "ISID"
     funccolor...
 define-type "primitiveid"   (RIFF "PRID") (tuple)
     funccolor...
-define-type "rattr"         (RIFF "RATR") (tuple (type = AnyId) (location = u32) (kind = FragmentType))
+define-type "rattr"         (RIFF "RATR") (tuple (type = AnyId) (location = u32) (kind = InterpolationMode))
     funccolor...
 define-type "wattr"         (RIFF "WATR") (tuple (type = AnyId) (location = u32))
     funccolor...

          
@@ 267,7 271,7 @@ define-type "block"         (RIFF "BLOK"
     instrcolor...
 define-type "draw"          (RIFF "DRAI")
     struct Draw plain
-        mode : PrimitiveType
+        mode : PrimitiveMode
         count : AnyId
         instancecount : AnyId
         viewport : AnyId # viewport rect

          
@@ 280,9 284,17 @@ define-type "sampleimagelod" (RIFF "SILD
 # FIR Level 0
 ################################################################################
 
+define-type "fn"        (RIFF "FN  ") (tuple (params = AnyId) (body = AnyId))
+    funccolor...
+define-type "params"    (RIFF "PARA") (tuple (level = u32) (count = u32))
+    funccolor...
+define-type "tuple"     (RIFF "TUPL") (tuple (values = (array AnyId)))
+    funccolor...
+define-type "at"        (RIFF "AT  ") (tuple (index = u32) (value = AnyId))
+    funccolor...
 define-type "vargs"     (RIFF "ARGS") (tuple (args = (array AnyId)))
     funccolor...
-define-type "va"        (RIFF "VA  ") (tuple (index = u32) (args = AnyId))
+define-type "va"        (RIFF "VA  ") (tuple (index = u32) (value = AnyId))
     funccolor...
 define-type "fvec2"     (RIFF "FVC2") (tuple (x = AnyId) (y = AnyId))
     instrcolor...

          
@@ 404,7 416,25 @@ define-type "vectype"   (RIFF "VECT") Ve
     typecolor...
 define-type "vatype"    (RIFF "VA T") (tuple (types = (array AnyId)))
     typecolor...
-define-type "rangetype" (RIFF "RNGT") (tuple (type = AnyId) (range = AnyId))
+define-type "tupletype" (RIFF "TUPT") (tuple (types = (array AnyId)))
+    typecolor...
+enum ExecModel : u32
+    None = 0        # this value is accessible nowhere
+    Generic = 1     # this value is accessible on the host (CPU)
+    Compute = 2     # this value is accessible in compute shaders
+    Vertex = 4      # this value is accessible in vertex shaders
+    Fragment = 8    # this value is accessible in fragment shaders
+    Shader = (| Compute Vertex Fragment) # this value is accessible in all shaders
+    All = (| Shader Generic) # this value is accessible everywhere (typically a constant)
+
+    @@ memo
+    inline __& (cls T)
+        static-if (cls == T)
+            inline (a b)
+                bitcast ((storagecast a) & (storagecast b)) this-type
+
+# execution model qualifier
+define-type "execmodel" (RIFF "QPlT") (tuple (type = AnyId) (model = ExecModel))
     typecolor...
 
 enum ImageFlags : u32

          
@@ 420,12 450,16 @@ struct ImageType plain
 
     let array? = (Accessor (inline (self key) ((self.flags & ImageFlags.arrayed) != 0)))
     let ms? = (Accessor (inline (self key) ((self.flags & ImageFlags.multisampled) != 0)))
+# the execution model of this one is always Shader
 define-type "imagetype"     (RIFF "IMGT") ImageType
     typecolor...
+# the execution model of this one is always Shader
 define-type "samplertype"   (RIFF "SMPT") ImageType
     typecolor...
+# the execution model of this one is always Generic
 define-type "texturetype"   (RIFF "TEXT") (tuple (type = AnyId) (x = u32) (y = u32) (z = u32) (levels = u32) (samples = u32))
     typecolor...
+# the execution model of this one is always Generic
 define-type "buffertype"    (RIFF "BUFT") (tuple (size = u32))
     typecolor...
 

          
@@ 505,23 539,44 @@ struct FIRTyper
                     " has type "
                     'repr module tid
 
-    fn rangeof (self module id)
-        let tid = ('typeof self module id)
-        let rangeid =
-            dispatch ('handleof module tid)
-            case rangetype (rtype)
-                copy rtype.range
+    fn typevectype (module tid)
+        loop (tid)
+            let handle = ('handleof module tid)
+            if (handle.typeid == TypeId.typeid_vectype)
+                return tid
+            dispatch handle
+            case execmodel (self)
+                repeat (copy self.type)
+            case texturetype (self)
+                repeat (copy self.type)
+            case imagetype (self)
+                repeat (copy self.type)
+            case samplertype (self)
+                repeat (copy self.type)
             default
-                error "ranged type expected"
+                return NoId
+
+    fn vectypeof (ctx module source)
+        return (typevectype module ('typeof ctx module source))
 
-    fn typerangetype (module tid)
-        dispatch ('handleof module tid)
-        case rangetype (rtype)
-            copy rtype.range
-        default NoId
+    fn typeexecmodel (module tid)
+        loop (tid)
+            let handle = ('handleof module tid)
+            dispatch handle
+            case execmodel (self)
+                return (copy self.model) (copy self.type)
+            case texturetype (self)
+                return ExecModel.Generic tid
+            case imagetype (self)
+                return ExecModel.Shader tid
+            case samplertype (self)
+                return ExecModel.Shader tid
+            default
+                return ExecModel.All tid
 
     fn type-value (ctx module id)
-        from (methodsof module.builder) let uvec fvec vectype rangetype
+        from (methodsof module.builder) let uvec fvec vectype execmodel
+            \ tupletype vatype
         #report "typing" ('repr module id)
         inline get (id)
             try (copy ('get ctx.types id))

          
@@ 532,37 587,30 @@ struct FIRTyper
         vvv bind type
         dispatch handle
         case input (self)
-            switch self.source
-            case SystemKey.ScreenSize (uvec 2)
-            case SystemKey.Iteration (uvec 1)
-            default
-                error
-                    .. "don't know how to type source: " (repr self.source)
+            execmodel
+                switch self.source
+                case SystemKey.ScreenSize (uvec 2)
+                case SystemKey.Iteration (uvec 1)
+                default
+                    error
+                        .. "don't know how to type source: " (repr self.source)
+                ExecModel.Generic
         case load (self)
             get self.pointer
-        #case sample (self)
-            get self.source
+        case sample (self)
+            execmodel
+                typevectype module (get self.source)
+                typeexecmodel module (get self.uv)
         case sampleimagelod (self)
-            let tid = (get self.uv)
-            let rangeid = (typerangetype module tid)
-            let vect =
-                dispatch ('handleof module ('typevectype ctx module (get self.source)))
+            execmodel
+                dispatch ('handleof module (typevectype module (get self.source)))
                 case vectype (self)
                     vectype self.element 4
                 default
                     error "can't deduce element type"
-            if (rangeid == NoId) vect
-            else
-                rangetype vect rangeid
+                typeexecmodel module (get self.uv)
         case clearimage (self)
             get self.target
-        #case selectfragment (self)
-            let typeid count = ('vectordesc ctx module (get self.default))
-            switch typeid
-            case TypeId.typeid_fvec (fvec count)
-            case TypeId.typeid_uvec (uvec count)
-            default
-                error "can't deduce element type"
         case dispatch (self)
             let vacount = ('vacount handle)
             let bindings = self.bindings

          
@@ 583,15 631,56 @@ struct FIRTyper
                 for i entry in (enumerate wbinds u32)
                     args @ i = (get (entry @ 0))
                 'commit module
-        case range (self)
-            rangetype (uvec 3) id
+        case comp (self)
+            let tid = (get self.value)
+            let element =
+                dispatch ('handleof module (typevectype module tid))
+                case vectype (vt)
+                    vt.element
+                default
+                    trap;
+            let vect = (vectype element 1)
+            execmodel vect
+                typeexecmodel module tid
+        case vargs (self)
+            let vacount = ('vacount handle)
+            let mrv =
+                'alloc module TypeId.typeid_vatype vacount
+            let types = mrv.types
+            let args = self.args
+            for i in (range vacount)
+                types @ i = (get (args @ i))
+            'commit module
+        case va (self)
+            let index = self.index
+            let tid = (get self.value)
+            let vhandle = ('handleof module tid)
+            dispatch vhandle
+            case vatype (self)
+                if (index >= ('vacount vhandle))
+                    vatype;
+                else
+                    copy (self.types @ index)
+            default tid
         default
             let typeid = ('typeidof module id)
             switch typeid
+
             pass TypeId.typeid_globalid
-            do (uvec 3)
-            pass TypeId.typeid_primitive
-            do (uvec 2)
+            do (execmodel (uvec 3) ExecModel.Compute)
+
+            pass TypeId.typeid_vertexid
+            pass TypeId.typeid_instanceid
+            do (execmodel (uvec 1) ExecModel.Vertex)
+
+            case TypeId.typeid_primitiveid
+                execmodel (uvec 1) ExecModel.Fragment
+
+            case TypeId.typeid_fragcoord
+                execmodel (uvec 4) ExecModel.Fragment
+
+            case TypeId.typeid_fragparams
+                execmodel NoId ExecModel.Fragment
 
             # constants
             pass TypeId.typeid_fconst

          
@@ 625,14 714,6 @@ struct FIRTyper
             do
                 let count = handle.size
                 let data = handle.data
-                # try to find first range type
-                let tid =
-                    for i in (range count)
-                        let tid = (get (bitcast (data @ i) AnyId))
-                        if (('handleof module tid) . typeid == TypeId.typeid_rangetype)
-                            break tid
-                    else
-                        get (bitcast (data @ 0) AnyId)
                 let dcount =
                     switch typeid
                     pass TypeId.typeid_uvec2

          
@@ 674,25 755,20 @@ struct FIRTyper
                     default
                         error
                             .. "unhandled typeid " (repr typeid)
-                dispatch ('handleof module tid)
-                case vectype (vt)
-                    vectype vte dcount
-                case rangetype (rng)
-                    dispatch ('handleof module rng.type)
-                    case vectype (vt)
-                        rangetype (vectype vte dcount) rng.range
-                    default
-                        trap;
-                default
-                    error "vector or ranged type expected"
-
+                # try to find first exec model
+                let em =
+                    fold (em = ExecModel.All) for i in (range count)
+                        let nextem =
+                            typeexecmodel module (get (bitcast (data @ i) AnyId))
+                        em & nextem
+                execmodel (vectype vte dcount) em
             pass TypeId.typeid_outputs
             pass TypeId.typeid_output
             pass TypeId.typeid_imagewrite
             pass TypeId.typeid_computefn
             pass TypeId.typeid_rbind
             pass TypeId.typeid_wbind
-            do NoId
+            do (tupletype)
 
             # types have no type
             pass TypeId.typeid_imagetype

          
@@ 700,6 776,7 @@ struct FIRTyper
             pass TypeId.typeid_vatype
             pass TypeId.typeid_vectype
             pass TypeId.typeid_texturetype
+            pass TypeId.typeid_execmodel
             do NoId
 
             # first value is type

          
@@ 714,8 791,6 @@ struct FIRTyper
                 else NoId
 
             # type of first value
-            pass TypeId.typeid_fragment
-            pass TypeId.typeid_comp
             pass TypeId.typeid_overlay
             do
                 for srcid in ('sources handle)

          
@@ 728,25 803,12 @@ struct FIRTyper
         'set ctx.types id type
         ;
 
-    fn typevectype (ctx module tid)
-        loop (tid)
-            let handle = ('handleof module tid)
-            if (handle.typeid == TypeId.typeid_vectype)
-                return tid
-            dispatch handle
-            case rangetype (self)
-                repeat (copy self.type)
-            case texturetype (self)
-                repeat (copy self.type)
-            case imagetype (self)
-                repeat (copy self.type)
-            case samplertype (self)
-                repeat (copy self.type)
-            default
-                return NoId
-
-    fn vectypeof (ctx module source)
-        return (typevectype ctx module ('typeof ctx module source))
+    fn dump-types (ctx module rootid)
+        'descend module rootid
+            on-leave =
+                capture (module id) {&ctx}
+                    print ('repr module id)
+                    print "      " ('repr module ('typeof ctx module id))
 
     fn... typeof (ctx, module : FIR, id : AnyId)
         try

          
@@ 1470,6 1532,8 @@ fn generate-IL (module rootid)
             `((deref gl_InstanceID) as u32)
         case primitiveid (self)
             `((deref gl_PrimitiveID) as u32)
+        case fragcoord (self)
+            `(deref gl_FragCoord)
         case position (self)
             `(reftoptr gl_Position)
         case load (self)

          
@@ 1543,7 1607,7 @@ fn generate-IL (module rootid)
             let T = ((get self.type) as type)
             let flags =
                 switch self.kind
-                case FragmentType.Flat global-flag-flat
+                case InterpolationMode.Flat global-flag-flat
                 default 0:u32
             let glob = (sc_global_new 'ra T flags 'Input)
             sc_global_set_location glob (self.location as i32)

          
@@ 1623,13 1687,13 @@ fn generate-IL (module rootid)
 
             let mode =
                 switch self.mode
-                case PrimitiveType.Point GL.POINTS
-                case PrimitiveType.Line GL.LINES
-                case PrimitiveType.LineStrip GL.LINE_STRIP
-                case PrimitiveType.LineLoop GL.LINE_LOOP
-                case PrimitiveType.Triangle GL.TRIANGLES
-                case PrimitiveType.TriangleStrip GL.TRIANGLE_STRIP
-                case PrimitiveType.TriangleFan GL.TRIANGLE_FAN
+                case PrimitiveMode.Point GL.POINTS
+                case PrimitiveMode.Line GL.LINES
+                case PrimitiveMode.LineStrip GL.LINE_STRIP
+                case PrimitiveMode.LineLoop GL.LINE_LOOP
+                case PrimitiveMode.Triangle GL.TRIANGLES
+                case PrimitiveMode.TriangleStrip GL.TRIANGLE_STRIP
+                case PrimitiveMode.TriangleFan GL.TRIANGLE_FAN
                 default
                     error "unsupported primitive mode"
             #let mode = mode

          
@@ 1656,6 1720,19 @@ fn generate-IL (module rootid)
             if (empty? retargs) `()
             else
                 sc_argument_list_new ((countof retargs) as i32) (& (retargs @ 0))
+        case vargs (self)
+            if (vacount == 0)
+                sc_empty_argument_list;
+            else
+                local retargs : (Array Value)
+                let args = self.args
+                for i in (range vacount)
+                    'append retargs (get (args @ i))
+                sc_argument_list_new ((countof retargs) as i32) (& (retargs @ 0))
+        case va (self)
+            let index = (self.index as i32)
+            let value = (get self.value)
+            `(va@ index value)
         case dispatch (self)
             let pgoffset = (get self.func)
             let pg = (getgluint ctx.drive-ctx pgoffset)

          
@@ 1930,86 2007,107 @@ fn fold-constant-expressions (self rooti
 fn lower-FIR (module rootid)
     viewing module
 
-    fn get-capacity (module id)
-        dispatch ('handleof module id)
-        case uconst (self)
-            return (copy self.value)
-        case comp (self)
-            let index = self.index
-            dispatch ('handleof module self.value)
+    fn... get-capacity (module, id : AnyId, index : u32)
+        returning u32
+        loop (id index)
+            dispatch ('handleof module id)
+            case uconst (self)
+                if (index == 0:u32)
+                    return (copy self.value)
+            case uvec2 (self)
+                switch index
+                case 0:u32
+                    repeat (copy self.x) 0:u32
+                case 1:u32
+                    repeat (copy self.y) 0:u32
+                default;
+            case uvec3 (self)
+                switch index
+                case 0:u32
+                    repeat (copy self.x) 0:u32
+                case 1:u32
+                    repeat (copy self.y) 0:u32
+                case 2:u32
+                    repeat (copy self.z) 0:u32
+                default;
+            case comp (self)
+                if (index == 0:u32)
+                    repeat (copy self.value) (copy self.index)
             case input (self)
                 switch self.source
                 case SystemKey.ScreenSize
-                    return 4096:u32
+                    if (index <= 1:u32)
+                        return 4096:u32
                 default;
             default;
-        default;
-        error
-            .. "cannot derive capacity from " ('repr module id)
+            error
+                .. "cannot derive capacity from " ('repr module id)
 
     struct Context
         typer : FIRTyper
 
     local ctx : Context
 
-    struct RangeMetrics plain
+    struct ComputeMetrics plain
         dim : u32
-        size : (tuple AnyId AnyId AnyId)
+        size : AnyId
         localsize : uvec3
         capacity : uvec3
 
         fn build-dispatchsize (self module)
-            from (methodsof module.builder) let add udiv uconst uvec
+            from (methodsof module.builder) let add udiv uconst uvec comp
             let lx ly lz = (unpack self.localsize)
-            let dx dy dz = (unpack self.size)
             let x =
-                udiv (add dx (uconst (lx - 1))) (uconst lx)
+                udiv (add (comp 0 self.size) (uconst (lx - 1))) (uconst lx)
             let y =
                 if (ly == 1) (uconst 1)
                 else
-                    udiv (add dy (uconst (lx - 1))) (uconst ly)
+                    udiv (add (comp 1 self.size) (uconst (lx - 1))) (uconst ly)
             let z =
                 if (lz == 1) (uconst 1)
                 else
-                    udiv (add dz (uconst (lx - 1))) (uconst lz)
+                    udiv (add (comp 2 self.size) (uconst (lx - 1))) (uconst lz)
             _ x y z
 
-    fn range-metrics (module id)
+    fn compute-metrics (typer module id)
         let handle = ('handleof module id)
         let vacount = ('vacount handle)
-        dispatch handle
-        case range (self)
-            let dim = vacount
-            if ((dim < 1) | (dim > 3))
-                error "range must have 1 to 3 arguments"
-            let lx ly lz =
-                switch dim
-                case 1 (_ 64:u32 1:u32 1:u32)
-                case 2 (_ 8:u32 8:u32 1:u32)
-                case 3 (_ 4:u32 4:u32 4:u32)
-                default
-                    trap;
-            let dims = self.dims
-            let dx cx =
-                (copy (dims @ 0))
-                max lx (get-capacity module (copy (dims @ 0)))
-            let dy cy =
-                if (ly == 1) (_ NoId 1:u32)
-                else
-                    _ (copy (dims @ 1))
-                        max ly (get-capacity module (copy (dims @ 1)))
-            let dz cz =
-                if (lz == 1) (_ NoId 1:u32)
-                else
-                    _ (copy (dims @ 2))
-                        max lz (get-capacity module (copy (dims @ 2)))
-            RangeMetrics
-                dim = dim
-                size = (tupleof dx dy dz)
-                localsize = (uvec3 lx ly lz)
-                capacity = (uvec3 cx cy cz)
-        default
-            error "range expected"
+        let tid = ('typeof typer module id)
+        let vt =
+            dispatch ('handleof module (FIRTyper.typevectype module tid))
+            case vectype (self) self
+            default
+                trap;
+        let dim = (copy vt.count)
+        let localsize capacity =
+            switch dim
+            case 3:u32
+                let cx cy cz =
+                    get-capacity module id 0
+                    get-capacity module id 1
+                    get-capacity module id 2
+                let lx ly lz =
+                    min cx 4:u32; min cy 4:u32; min cz 4:u32
+                _ (uvec3 lx ly lz) (uvec3 cx cy cz)
+            case 2:u32
+                let cx cy =
+                    get-capacity module id 0
+                    get-capacity module id 1
+                let lx ly =
+                    min cx 8:u32; min cy 8:u32
+                _ (uvec3 lx ly 1:u32) (uvec3 cx cy 1:u32)
+            case 1:u32
+                let cx =
+                    get-capacity module id 0
+                let lx = (min cx 64:u32)
+                _ (uvec3 lx 1:u32 1:u32) (uvec3 cx 1:u32 1:u32)
+            default
+                error "compute size must have 1 to 3 arguments"
+        ComputeMetrics
+            dim = dim
+            size = id
+            localsize = localsize
+            capacity = capacity
 
     fn remapvector (ctx module source numcomp)
         let vect = ('vectypeof ctx.typer module source)

          
@@ 2056,7 2154,7 @@ fn lower-FIR (module rootid)
                     .. "source must be float or integer, but has type "
                         'repr module ('typeof ctx.typer module source)
 
-    fn gentexturetype (ctx module rangeid source)
+    fn gentexturetype (ctx module sizeid source)
         let tid = ('vectypeof ctx.typer module source)
         let imgformat =
             dispatch ('handleof module tid)

          
@@ 2065,65 2163,163 @@ fn lower-FIR (module rootid)
             default
                 error "source must be float or integer"
         from (methodsof module.builder) let imagetype texturetype
-        let met = (range-metrics module rangeid)
+        let met = (compute-metrics ctx.typer module sizeid)
         let cx cy cz = (unpack met.capacity)
         let imgtype = (imagetype tid ImageDim.2D imgformat ImageFlags.none)
         _ (texturetype imgtype cx cy cz 1 0) imgtype imgformat met
 
-    fn lower-expression (ctx module source)
-        dispatch ('handleof module ('typeof ctx.typer module source))
-        case texturetype (imgstor)
-            dispatch ('handleof module imgstor.type)
-            case imagetype (img)
-                return (copy source) (copy img.format)
+    fn collect-bindings (ctx module source aliases bindings)
+        local next_uniform_id = 0:u32
+        # replace generic values with uniforms
+        'translate module module source
+            aliases = (view aliases)
+            on-enter-param =
+                capture (self module id index paramid)
+                    {&aliases &bindings &ctx &next_uniform_id}
+                    try
+                        return false (copy ('get aliases paramid))
+                    else;
+                    let ty = ('typeof ctx.typer module paramid)
+                    let em ty = (FIRTyper.typeexecmodel module ty)
+                    if (em == ExecModel.Generic)
+                        let ty =
+                            dispatch ('handleof module ty)
+                            case texturetype (self)
+                                dispatch ('handleof module self.type)
+                                case imagetype (self)
+                                    let sampler = ('alloc module TypeId.typeid_samplertype)
+                                    @sampler = self
+                                    'commit module
+                                default (copy self.type)
+                            default ty
+                        from (methodsof module.builder) let uniform load rbind
+                        let uniid = (uniform ty next_uniform_id)
+                        next_uniform_id += 1
+                        let aliasid = (load uniid)
+                        'set aliases paramid aliasid
+                        'append bindings
+                            rbind paramid uniid
+                        return false aliasid
+                    _ true NoId
+
+    fn genrasterize (ctx module rasterize)
+        from (methodsof module.builder) let draw comp
+
+        let szt = ('vectypeof ctx.typer module rasterize.size)
+        let vect =
+            dispatch ('handleof module szt)
+            case vectype (self) self
+            default
+                trap;
+        from (methodsof module.builder) let shaderfn wbind uconst wattr rattr
+            \ fragparams fragcoord store va load position
+        let count instance =
+            switch vect.count
+            case 1 (_ (copy rasterize.size) (uconst 1))
+            case 2 (_ (comp 0 rasterize.size) (comp 1 rasterize.size))
             default
-                error "image type expected"
-        default;
+                error "size argument must be of size 1 or 2"
+        local aliases : (Map u32 AnyId)
+        local bindings : (Array AnyId)
+        let vertexsource =
+            collect-bindings ctx module rasterize.vertex aliases bindings
+        let rtypehandle = ('handleof module ('typeof ctx.typer module vertexsource))
+        let fparams = (fragparams)
+        let vertexsource =
+            dispatch rtypehandle
+            case vatype (self)
+                let types = self.types
+                let argcount = ('vacount rtypehandle)
+                local inargs : (Array AnyId)
+                local outargs : (Array AnyId)
+                for i in (range argcount)
+                    let vt = (FIRTyper.typevectype module (copy (types @ i)))
+                    let outattr =
+                    let inattr = (rattr vt i InterpolationMode.Undefined)
+                    if (i == 0)
+                        'append outargs
+                            store (va i vertexsource) (position)
+                        'append inargs (fragcoord)
+                    else
+                        'append outargs
+                            store (va i vertexsource) (wattr vt i)
+                        'append inargs
+                            load (rattr vt i InterpolationMode.Undefined)
+                let outargcount = ((countof outargs) as u32)
+                let ptr = ('alloc module TypeId.typeid_block outargcount)
+                let body = ptr.body
+                for i arg in (enumerate outargs u32)
+                    body @ i = arg
+                let vertexsource = ('commit module)
 
-        let rangeid = ('rangeof ctx.typer module source)
+                let inargcount = ((countof inargs) as u32)
+                let ptr = ('alloc module TypeId.typeid_vargs inargcount)
+                let targs = ptr.args
+                for i arg in (enumerate inargs u32)
+                    targs @ i = arg
+                let vargs = ('commit module)
+                'set aliases fparams vargs
+                vertexsource
+            default
+                'set aliases fparams (fragcoord)
+                store vertexsource (position)
+        let fragmentsource =
+            collect-bindings ctx module rasterize.fragment aliases bindings
+        let fragtype = ('typeof ctx.typer module fragmentsource)
+        let rtypehandle = ('handleof module fragtype)
+        let fragmentsource =
+            dispatch rtypehandle
+            case vatype (self)
+                let types = self.types
+                let argcount = ('vacount rtypehandle)
+                local outargs : (Array AnyId)
+                for i in (range argcount)
+                    let vt = (FIRTyper.typevectype module (copy (types @ i)))
+                    'append outargs
+                        store (va i fragmentsource) (wattr vt i)
+                let outargcount = ((countof outargs) as u32)
+                let ptr = ('alloc module TypeId.typeid_block outargcount)
+                let body = ptr.body
+                for i arg in (enumerate outargs u32)
+                    body @ i = arg
+                'commit module
+            default
+                let vt = (FIRTyper.typevectype module fragtype)
+                store fragmentsource (wattr vt 0)
+        let func =
+            shaderfn vertexsource fragmentsource
+        let colorattr_frag =
+            wattr ('vectypeof ctx.typer module rasterize.target) 0
+        'append bindings
+            wbind (copy rasterize.target) colorattr_frag
+        let bcount = ((countof bindings) as u32)
+        let drawptr =
+            'alloc module TypeId.typeid_draw bcount
+        drawptr.mode = rasterize.mode
+        drawptr.count = count
+        drawptr.instancecount = instance
+        drawptr.viewport = rasterize.viewport
+        drawptr.func = func
+        let entries = drawptr.bindings
+        for i id in (enumerate bindings u32)
+            entries @ i = id
+        let source = ('commit module)
+        source
+
+    fn gencompute (ctx module compute)
+        let sizeid = (copy compute.size)
+        let source = (copy compute.value)
         let storagetype imgtype imgformat met =
-            gentexturetype ctx module rangeid source
+            gentexturetype ctx module sizeid source
         let sx sy sz = ('build-dispatchsize met module)
         let lx ly lz = (unpack met.localsize)
         local aliases : (Map u32 AnyId)
         local bindings : (Array AnyId)
-        local next_uniform_id = 0:u32
-        from (methodsof module.builder) let globalid
-        'set aliases rangeid (globalid)
-        # replace unranged values with uniforms
         let source =
-            'translate module module source
-                aliases = (view aliases)
-                on-enter-param =
-                    capture (self module id index paramid)
-                        {&aliases &bindings &ctx &next_uniform_id}
-                        try
-                            return false (copy ('get aliases paramid))
-                        else;
-                        let ty = ('typeof ctx.typer module paramid)
-                        if ((('handleof module ty) . typeid != TypeId.typeid_rangetype)
-                            and (not ('constant? module paramid)))
-                            let ty =
-                                dispatch ('handleof module ty)
-                                case texturetype (self)
-                                    dispatch ('handleof module self.type)
-                                    case imagetype (self)
-                                        let sampler = ('alloc module TypeId.typeid_samplertype)
-                                        @sampler = self
-                                        'commit module
-                                    default (copy self.type)
-                                default ty
-                            from (methodsof module.builder) let uniform load rbind
-                            let uniid = (uniform ty next_uniform_id)
-                            next_uniform_id += 1
-                            let aliasid = (load uniid)
-                            'set aliases paramid aliasid
-                            'append bindings
-                                rbind paramid uniid
-                            return false aliasid
-                        _ true NoId
+            collect-bindings ctx module source aliases bindings
         from (methodsof module.builder) let dispatch computefn
             \ wimage imagewrite load undef uvec2 comp unpack-comp rbind wbind
+            \ globalid
         let img = (wimage imgtype 0)
         let pos = (globalid)
         let uv = (uvec2 (unpack-comp pos 2))

          
@@ 2144,43 2340,125 @@ fn lower-FIR (module rootid)
         for i id in (enumerate bindings u32)
             entries @ i = id
         let source = ('commit module)
-        _ source imgformat
+        source
 
     fn translate-value (ctx module handle oldmodule id)
         let vacount = ('vacount handle)
         dispatch handle
         case clear (self)
-            let rangeid = ('rangeof ctx.typer module self.range)
+            let sizeid = (copy self.size)
             let storagetype imgtype imgformat met =
-                gentexturetype ctx module rangeid self.value
-            from (methodsof module.builder) let clearimage uconst undef
-            let ox oy oz = (unpack met.size)
+                gentexturetype ctx module sizeid self.value
+            from (methodsof module.builder) let clearimage uconst undef comp
             let z = (uconst 0)
             let value = (remapvector ctx module
                 (copy self.value) ('components imgformat))
             clearimage value
                 z
                 \ z z z
-                ox
-                if (oy == NoId) (uconst 1)
-                else oy
-                if (oz == NoId) (uconst 1)
-                else oz
+                comp 0 sizeid
+                if (met.dim < 2) (uconst 1)
+                else (comp 1 sizeid)
+                if (met.dim < 3) (uconst 1)
+                else (comp 2 sizeid)
                 undef storagetype
         case sample (self)
-            let source imgformat =
-                lower-expression ctx module self.source
             from (methodsof module.builder) let fconst sampleimagelod
-            let newid = (sampleimagelod source self.uv (fconst 0.0))
+            let imgtype = ('imagetypeof ctx.typer module self.source)
+            let imgformat = imgtype.format
+            let newid = (sampleimagelod self.source self.uv (fconst 0.0))
             let numcomp = ('components imgformat)
             return
                 remapvector ctx module newid numcomp
-        case output (self)
+        #case overlay (self)
+            let srcrangeid = ('rangeof ctx.typer module self.rangevalue)
+            let rangevalue imgformat =
+                lower-ranged-value ctx module self.rangevalue
+
+        #
+            let srcmet = (range-metrics module srcrangeid)
+            let rangevalue imgformat =
+                lower-ranged-value ctx module self.rangevalue
+            let fragmentvalue =
+                genfragmentshader ctx module self.fragmentvalue
+            let primid = ('primitiveof ctx.typer module self.fragmentvalue)
+            let prim =
+                dispatch ('handleof module primid)
+                case primitive (prim) prim
+                default
+                    trap;
+            let frag =
+                dispatch ('handleof module
+                case fragment (frag) frag
+                default
+                    trap;
+            let primvalue =
+                genvertexshader ctx module self.primitivevalue
+            let rangeid = ('rangeof ctx.typer module prim.vertex)
+            let met = (range-metrics module rangeid)
+            from (methodsof module.builder) let draw uconst uvec4 shaderfn
+            let vxcount instancecount = (unpack met.size)
+            let instancecount =
+                if (instancecount == NoId) (uconst 1)
+                else instancecount
+            draw prim.mode
+                \ vxcount instancecount
+                uvec4
+                    uconst 0; uconst 0
+                    srcmet.size.x; srcmet.size.y
+                shaderfn
+
+                    do
+                        let vid = (vertexid)
+                        let iid = (instanceid)
+                        let it = (fadd (load u_it) (fmul (utof iid) (fconst 0.1)))
+                        let cs = (cos it)
+                        let ss = (sin it)
+                        let u = (utof (urem vid (uconst 2)))
+                        let v = (utof (udiv vid (uconst 2)))
+                        let x = (fsub u (fconst 0.5))
+                        let y = (fsub v (fconst 0.5))
+                        let x y =
+                            fadd (fmul cs x) (fmul ss y)
+                            fsub (fmul cs y) (fmul ss x)
+                        block
+                            store
+                                fvec4 u v (fconst 0) (fconst 1)
+                                colorattr_out
+                            store
+                                fvec4 x y (fconst 0) (fconst 1)
+                                position;
+                    do
+                        let pid = (primitiveid)
+                        let f = (fmul (utof pid) (fconst 1.0))
+                        let r g b a = (unpack-comp (load colorattr_in) 4)
+                        store
+                            fvec4
+                                fmul f r
+                                fmul f g
+                                fmul f b
+                                a
+                            colorattr_frag
+                rbind angle u_it
+                wbind
+                    clearimage
+                        fvec4 (uconst 0) (uconst 0) (uconst 1) (uconst 1)
+                        uconst 0
+                        uconst 0; uconst 0; uconst 0
+                        comp 0 inpss; comp 1 inpss; uconst 1
+                        undef
+                            texturetype imgtype 4096 4096 1 1 0
+                    colorattr_frag
+        case compute (self)
+            gencompute ctx module self
+        case rasterize (self)
+            genrasterize ctx module self
+        #
             switch self.sink
             case SystemKey.Screen
                 # execute dispatch
                 self.value =
-                    (_ (lower-expression ctx module self.value) ())
+                    (_ (lower-ranged-value ctx module self.value) ())
                 'commit module handle
             default
                 error "unhandled output type"

          
@@ 2193,7 2471,7 @@ fn lower-FIR (module rootid)
                     translate-value ctx module handle oldmodule id
                 except (err)
                     error@+ err unknown-anchor
-                        .. "while checking " ('repr oldmodule id)
+                        .. "while lowering " ('repr oldmodule id)
 
 ################################################################################
 

          
@@ 2235,7 2513,35 @@ type+ FIR.BuilderType
                 'comp self i value
             va-range n
 
+    let _execmodel = this-type.execmodel
+    inline execmodel (self value model)
+        if (model == ExecModel.All) value
+        else (_execmodel self value model)
+
+sugar FIRfn (name (args...) body...)
+    let module =
+        try ('@ sugar-scope 'fir-module)
+        else
+            error "`fir-module` must be defined in scope"
+    let level =
+        try (('@ sugar-scope 'fir-fn-level) as u32)
+        else 0:u32
+    let builder = `(getattr module 'builder)
+    let argcount = ((countof args...) as u32)
+    let params = `('params builder level argcount)
+    let expr =
+        list ''fn builder params
+            cons do
+                list let 'fir-fn-level '= (level + 1)
+                fold (body = body...) for i arg in (enumerate args... u32)
+                    cons
+                        list let arg '= `(report ('va builder i params))
+                        body
+    if (('typeof name) == Symbol)
+        list let name '= expr
+    else expr
+
 do
     let FIR NoId AnyId SystemKey ImageDim ImageFormat ImageFlags TypeId
-        \ PrimitiveType FragmentType DepthTestType FIRTyper
-    locals;
  No newline at end of file
+        \ PrimitiveMode InterpolationMode DepthTestType FIRTyper FIRfn
+    locals;

          
M testing/test_cadag.sc +12 -11
@@ 72,17 72,18 @@ do
     let m = (const2 20:u32)
     let p = (str "foo" 32:char "bar")
     let q = (empty)
-    u32x 25
-        i32_id 1 k
-        i32_id 2 m
-        i32_id 3 p
-        i32_id 4
-            vec3 k q m
+    let prog =
+        u32x 25
+            i32_id 1 k
+            i32_id 2 m
+            i32_id 3 p
+            i32_id 4
+                vec3 k q m
 
     # perform a topological transform where we increment the constant values
     local newmodule : TestDAG
-    let newid =
-        'translate newmodule module ('rootid module)
+    let prog =
+        'translate newmodule module prog
             on-leave =
                 capture (module handle oldmodule oldid) {}
                     dispatch handle

          
@@ 126,9 127,9 @@ do
     module = newmodule
     #assert (newid == (rootid))
     #descend newid
-    'dump module
+    'dump module prog
     do
-        let ordered indices = ('ordered module ('rootid module))
+        let ordered indices = ('ordered module prog)
         let pred = ('predecessors module ordered indices)
         let postdom = (postdominators ordered pred)
         let scope = (scopetree ordered postdom)

          
@@ 140,7 141,7 @@ do
             print (ordered @ src) "postdominated by" (ordered @ dst)
         'dump-scope module ordered scope
 
-    'showdot module ('rootid module)
+    'showdot module prog
         module-dir .. "/test_cadag_dot"
 
     ;
  No newline at end of file

          
M testing/tukdag.sc +76 -113
@@ 37,12 37,12 @@ inline gen-level1-test-geometry ()
     let angle = (fdiv (utof inpit) (fconst 60.0))
 
     let colorattr_out = (wattr (fvec 4) 0)
-    let colorattr_in = (rattr (fvec 4) 0 FragmentType.Smooth)
+    let colorattr_in = (rattr (fvec 4) 0 InterpolationMode.Smooth)
     let colorattr_frag = (wattr (fvec 4) 0)
     outputs
         output SystemKey.Screen
             draw
-                PrimitiveType.TriangleStrip
+                PrimitiveMode.TriangleStrip
                 uconst 4; uconst 10
                 uvec4
                     uconst 0; uconst 0

          
@@ 147,126 147,83 @@ inline gen-level1-test ()
 
 inline gen-level2-test-geometry ()
     from (methodsof module.builder) let uvec fvec2 fvec3 fvec4 input output uconst
-        \ fconst range comp and xor utof sin cos fadd fmul fdiv sample fsub
+        \ fconst comp and xor utof sin cos fadd fmul fdiv sample fsub
         \ outputs sub unpack-comp udiv urem primitive fragment selectfragment
-        \ clear depthtest overlay
+        \ clear depthtest overlay rasterize uvec2 vertexid instanceid vargs va
+        \ fragparams uvec4
+
+    let w h =
+        unpack-comp (input SystemKey.ScreenSize) 2
+    #outputs
+        output SystemKey.Screen
+            clear (input SystemKey.ScreenSize)
+                fvec3 (fconst 0) (fconst 0) (fconst 1)
+    outputs
+        output SystemKey.Screen
+            rasterize PrimitiveMode.TriangleStrip
+                #uvec2 (uconst 4) (uconst 1)
+                (uconst 4)
+                do
+                    let u = (utof (urem (vertexid) (uconst 2)))
+                    let v = (utof (udiv (vertexid) (uconst 2)))
+                    let x = (fsub u (fconst 0.5))
+                    let y = (fsub v (fconst 0.5))
+                    vargs
+                        fvec4 x y (fconst 0) (fconst 1)
+                        fvec3 u v (fconst 0)
+                do
+                    va 1 (fragparams)
+                uvec4 (uconst 0) (uconst 0) w h
+                clear (input SystemKey.ScreenSize)
+                    fvec3 (fconst 0) (fconst 0) (fconst 1)
+
+inline gen-level2-test ()
+    from (methodsof module.builder) let uvec fvec2 fvec3 fvec4 input output uconst
+        \ fconst comp and xor utof sin cos fadd fmul fdiv sample fsub
+        \ outputs sub unpack-comp udiv urem primitive fragment selectfragment
+        \ clear depthtest overlay map uvec2 compute globalid
+    let fir-module = module
 
     let inpit = (input SystemKey.Iteration)
 
     let TS = (uconst 32)
     let checkers_texture1 =
-        do
-            let pos = (range TS TS)
-            let x y =
-                unpack-comp pos 2
-            utof (xor (and x (uconst 1)) (and y (uconst 1)))
+        compute (uvec2 TS TS)
+            do
+                let x y =
+                    unpack-comp (globalid) 2
+                utof (xor (and x (uconst 1)) (and y (uconst 1)))
 
     let TS = (uconst 16)
     let checkers_texture2 =
-        do
-            let pos = (range TS TS)
-            let x y =
-                unpack-comp pos 2
-            utof (xor (and x (uconst 1)) (and y (uconst 1)))
+        compute (uvec2 TS TS)
+            do
+                let x y =
+                    unpack-comp (globalid) 2
+                utof (xor (and x (uconst 1)) (and y (uconst 1)))
 
     let w h =
         unpack-comp (input SystemKey.ScreenSize) 2
-    let screenrange = (range w h)
-    #outputs
-        output SystemKey.Screen
-            clear screenrange
-                fvec3 (fconst 0) (fconst 0) (fconst 1)
-
-    #do
-        let prim = (primitive PrimitiveType.TriangleStrip (uconst 4) (uconst 1))
-        let vertexid = (comp 0 prim)
-        let u = (utof (urem vertexid (uconst 2)))
-        let v = (utof (udiv vertexid (uconst 2)))
-
-        let quadvertex =
-            do
-                let x = (fsub u (fconst 0.5))
-                let y = (fsub v (fconst 0.5))
-                fvec4 x y (fconst 0) (fconst 1)
-        let vertexcolor =
-            fragment FragmentType.Smooth
-                fvec3 u v (fconst 0)
-        outputs
-            output SystemKey.Screen
-                selectfragment
-                    overlay quadvertex
-                    vertexcolor
-                    clear screenrange
-                        fvec3 (uconst 0) (uconst 0) (uconst 1)
-
-    do
-        let vxgen = (range (uconst 4))
-        let vertexid = (comp 0 vxgen)
-        let u = (utof (urem vertexid (uconst 2)))
-        let v = (utof (udiv vertexid (uconst 2)))
-
-        let quad =
-            do
-                let x = (fsub u (fconst 0.5))
-                let y = (fsub v (fconst 0.5))
-                fvec4 x y (fconst 0) (fconst 1)
-        let quadcolor = (fvec3 u v (fconst 0))
-
-        let prim = (primitive PrimitiveType.TriangleStrip quad)
-
-        outputs
-            output SystemKey.Screen
-                overlay
-                    clear screenrange
-                        fvec3 (uconst 0) (uconst 0) (uconst 1)
-                    fragment prim quadcolor FragmentType.Smooth
-
-inline gen-level2-test ()
-    from (methodsof module.builder) let uvec fvec2 fvec3 fvec4 input output uconst
-        \ fconst range comp and xor utof sin cos fadd fmul fdiv sample fsub
-        \ outputs sub unpack-comp udiv urem primitive fragment selectfragment
-        \ clear depthtest overlay
-
-    let inpit = (input SystemKey.Iteration)
-
-    let TS = (uconst 32)
-    let checkers_texture1 =
-        do
-            let pos = (range TS TS)
-            let x y =
-                unpack-comp pos 2
-            utof (xor (and x (uconst 1)) (and y (uconst 1)))
-
-    let TS = (uconst 16)
-    let checkers_texture2 =
-        do
-            let pos = (range TS TS)
-            let x y =
-                unpack-comp pos 2
-            utof (xor (and x (uconst 1)) (and y (uconst 1)))
-
-    let w h =
-        unpack-comp (input SystemKey.ScreenSize) 2
-    let screenrange = (range w h)
 
     outputs
         output SystemKey.Screen
-            do
-                # frame time
-                let it = (fdiv (utof inpit) (fconst 60.0))
-                let itsin = (fadd (fmul (sin it) (fconst 0.5)) (fconst 0.5))
-                # screen size
-                let x y =
-                    unpack-comp screenrange 2
-                let u = (fdiv (utof x) (utof w))
-                let v = (fdiv (utof y) (utof h))
-                let q0 = (sample checkers_texture1 (fvec2 (fadd u itsin) v))
-                let q1 = (sample checkers_texture2 (fvec2 u (fadd v itsin)))
-                #let q = (fconst 1.0)
-                let u = (fmul q0 u)
-                let v = (fmul q1 v)
-                let z = (fmul (fadd q0 q1) itsin)
-                fvec4 u v z (fconst 1)
+            compute (input SystemKey.ScreenSize)
+                do
+                    let x y =
+                        unpack-comp (globalid) 2
+                    # frame time
+                    let it = (fdiv (utof inpit) (fconst 60.0))
+                    let itsin = (fadd (fmul (sin it) (fconst 0.5)) (fconst 0.5))
+                    # screen size
+                    let u = (fdiv (utof x) (utof w))
+                    let v = (fdiv (utof y) (utof h))
+                    let q0 = (sample checkers_texture1 (fvec2 (fadd u itsin) v))
+                    let q1 = (sample checkers_texture2 (fvec2 u (fadd v itsin)))
+                    #let q = (fconst 1.0)
+                    let u = (fmul q0 u)
+                    let v = (fmul q1 v)
+                    let z = (fmul (fadd q0 q1) itsin)
+                    fvec4 u v z (fconst 1)
 
 # perform an identity transform and swap out the new module
     all transformations are immutable.

          
@@ 276,27 233,33 @@ inline cleanup (rootid)
         let newid = ('translate newmodule module rootid)
         module = newmodule
         newid
+inline dump-types (rootid)
+    do
+        local typer : FIRTyper
+        'dump-types typer module rootid
 inline run (rootid)
     do
         let fsetup fdrive fdrop = ('gen-templates module rootid)
 
         local opts : VMOptions
         runvm fsetup fdrive fdrop opts
-inline graphviz ()
+inline graphviz (rootid)
     do
-        'showdot module ('rootid module)
+        'showdot module rootid
             module-dir .. "/tukdag"
 
 #let prog = (gen-level1-test-geometry)
 #let prog = (gen-level1-test)
-#let prog =
+
+let prog =
     do
         let prog = (gen-level2-test-geometry)
         let prog = (cleanup prog)
-        'dump module prog
+        #'dump module prog
+        #dump-types prog
         print "lowering..."
         'lower module prog
-let prog =
+#let prog =
     do
         let prog = (gen-level2-test)
         let prog = (cleanup prog)

          
@@ 307,7 270,7 @@ print "folding constants..."
 let prog = ('fold-constant-expressions module prog)
 #cleanup;
 'dump-scope module prog
-#graphviz;
+#graphviz prog
 print "compiling..."
 run prog