38aa626754c0 — Leonard Ritter 8 days ago
cleanup
2 files changed, 12 insertions(+), 928 deletions(-)

R lib/tukan/CADAG.sc => 
M testing/tukdag.sc
R lib/tukan/CADAG.sc =>  +0 -918
@@ 1,918 0,0 @@ 
-
-# CADAG - Content Agnostic Directed Acyclic Graph
-
-using import struct
-using import switcher
-using import Array
-using import Map
-using import Set
-using import Capture
-using import String
-
-using import .SHA256
-
-let u32_size = (sizeof u32)
-
-################################################################################
-
-type Id
-
-    @@ memo
-    inline __== (cls T)
-        static-if (T < this-type)
-            inline (a b)
-                (storagecast a) == (storagecast b)
-
-'define-symbol Id '__copy integer.__copy
-'define-symbol Id '__hash integer.__hash
-
-type+ Id
-    inline __tobool (self)
-        (storagecast self) as bool
-
-    @@ 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)
-
-################################################################################
-
-global id-offset-func-map : (Map type (tuple Value usize))
-
-fn idtype? (QT)
-    ('strip-qualifiers QT) < Id
-
-# given a type, produce a function that maps indices to byte offsets to Id
-    fields within the type. the first invalid index will produce -1:usize
-fn... gen-id-offset-func (QT : type)
-    returning Value usize
-    raising Error
-    let QT = ('storageof QT)
-    try
-        return (unpack (copy ('get id-offset-func-map QT)))
-    else;
-    let gen-id-offset-func = this-function
-    fn... recur (sw : Value, defaultblock : Value, index : Value, QT : type,
-                    offset : usize, nextindex)
-        returning bool
-        raising Error
-        let recur = this-function
-        let T = ('storageof QT)
-        let sz = ('sizeof T)
-        switch ('kind T)
-        case type-kind-array
-            let unsized? = ('unsized? T)
-            let ET = ('element@ T 0)
-            let ETsz = ('sizeof ET)
-            if (ETsz == 0)
-                return false
-            assert ((sz % ETsz) == 0)
-            let numelements = (sz // ETsz)
-            let startindex = (deref nextindex)
-            vvv bind numindices cond_body
-            if (idtype? ET)
-                _ 1:usize
-                    spice-quote
-                        let localindex = (index - startindex)
-                        return (offset + localindex * ETsz)
-            else
-                switch ('kind ('storageof ET))
-                pass type-kind-array
-                pass type-kind-tuple
-                do;
-                default
-                    # not going to contain any ids
-                    return false
-                let f numindices = (gen-id-offset-func ET)
-                if (numindices == 0)
-                    return false
-                if (numindices == -1:usize)
-                    error "array elements must not contain unsized array"
-                _ numindices
-                    spice-quote
-                        let localindex = (index - startindex)
-                        let blockindex = (localindex // numindices)
-                        return (offset + blockindex * ETsz
-                            + (f (localindex % numindices)))
-            if unsized?
-                sc_expression_append defaultblock cond_body
-                true
-            else
-                let totalcount = (numindices * numelements)
-                nextindex += totalcount
-                let endindex = (startindex + totalcount)
-                sc_expression_append defaultblock
-                    spice-quote
-                        if ((index >= startindex) & (index < endindex)) cond_body
-                false
-        case type-kind-tuple
-            let count = ('element-count T)
-            for i in (range count)
-                let ET = ('element@ T i)
-                let ofs = (offset + ('offsetof T i))
-                if (recur sw defaultblock index ET ofs nextindex)
-                    if ((i + 1) != count)
-                        error "unsized array must be last field"
-                    break true
-            else false
-        default
-            if (idtype? QT)
-                let idx = (deref nextindex)
-                sc_switch_append_case sw `idx `(return offset)
-                nextindex += 1
-            false
-
-    local nextindex = 0:usize
-    spice-quote
-        inline idoffsets (index)
-            spice-unquote
-                let sw = (sc_switch_new index)
-                let defaultblock = (sc_expression_new)
-                let period? = (recur sw defaultblock index QT 0:usize nextindex)
-                sc_switch_append_default sw defaultblock
-                if (not period?)
-                    sc_expression_append defaultblock `(return -1:usize)
-                else
-                    nextindex = -1:usize
-                sw
-    let nextindex = (deref nextindex)
-    'set id-offset-func-map QT (tupleof idoffsets nextindex)
-    _ idoffsets nextindex
-
-fn _flexible-struct-type (T)
-    let T = ('storageof T)
-    if (('kind T) == type-kind-tuple)
-        let count = ('element-count T)
-        if (count > 0)
-            let ET = ('element@ T (count - 1))
-            if (('kind ET) == type-kind-array)
-                if ('unsized? ET)
-                    return ('element@ ET 0) (count - 1)
-    _ Nothing -1
-
-spice flexible-struct-type (T)
-    T as:= type
-    _flexible-struct-type T
-
-################################################################################
-
-fn riff->string (code)
-    local str : String
-    'resize str 4
-    str @ 0 = (code & 0xff:u32) as char
-    str @ 1 = ((code >> 8) & 0xff:u32) as char
-    str @ 2 = ((code >> 16) & 0xff:u32) as char
-    str @ 3 = ((code >> 24) & 0xff:u32) as char
-    str
-
-spice RIFF (name)
-    name as:= string
-    if ((countof name) != 4)
-        error "RIFF code must have four characters"
-    |
-        (name @ 0) as u32
-        (name @ 1) as u32 << 8
-        (name @ 2) as u32 << 16
-        (name @ 3) as u32 << 24
-
-################################################################################
-
-struct TypeInfo plain
-    T : type
-    name : string
-    dedup? : bool = true
-
-struct CADAGEnvData
-    typeid->info-map : (Map u32 TypeInfo)
-    name->typeid-map : (Map string u32)
-
-    inline __drop (self)
-        print "drop"
-
-let InstancePointerType = (viewof (mutable @CADAGEnvData) 999)
-
-spice new-env-data ()
-    let data = (malloc CADAGEnvData)
-    store (CADAGEnvData) data
-    sc_const_pointer_new voidstar data
-
-fn repr-atomic-value (ET value)
-    if (idtype? ET)
-        spice-quote
-            default-styler style-symbol
-                .. "%" (tostring value)
-    else `(repr value)
-
-fn value-typeid-repr (T value sz)
-    returning Value
-    try
-        let func = ('@ T '__CADAG_repr)
-        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 " "
-                                    repr
-                                        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
-                                repr-atomic-value ET `(value @ i)
-                sc_expression_append body str
-                str
-        sc_expression_append body str
-        body
-    default
-        `(.. " " [(repr-atomic-value T value)])
-
-spice value-typeid-repr (value sz)
-    value-typeid-repr ('typeof value) value sz
-
-run-stage;
-
-type CADAG < Struct
-
-    inline getinstance (T)
-        let self = ('@ (T as type) 'instance)
-        # hack to turn pointer into view
-        let ptr = (sc_const_pointer_extract self)
-        let ptr = (bitcast ptr InstancePointerType)
-        let val = (alloca InstancePointerType)
-        store ptr val
-        let self = @@val
-        self
-
-    #spice typeidof (cls T)
-        let self = (getinstance cls)
-        T as:= type
-        if (not ('in? self.typeid->info-map T))
-            error
-                .. "type " (repr T) " has no typeinfo"
-        ('getdefault self.type->info-map T (TypeInfo 0 "")) . typeid
-
-    spice typeinfo (cls code)
-        let self = (getinstance cls)
-        cls as:= type
-        let TypeIdType = (('@ cls 'TypeId) as type)
-        if (('typeof code) != TypeIdType)
-            error
-                .. "typeid must be of type " (repr TypeIdType) ", not "
-                    repr ('typeof code)
-        if (not ('constant? code))
-            error "argument must be constant"
-        let code = ((sc_const_int_extract code) as u32)
-        if (not ('in? self.typeid->info-map code))
-            error
-                .. "typeid " (repr code) " has no typeinfo"
-        'getdefault self.typeid->info-map code (TypeInfo Nothing "")
-
-    #spice typeoftypeid (cls code)
-        let self = (getinstance cls)
-        cls as:= type
-        code as:= u32
-        try ('get self.typeid->type-map code)
-        else
-            error
-                .. "no such typeid: " (repr code)
-
-    spice dispatch-type (cls typeid ptr ...)
-        let self = (getinstance cls)
-        let sw = ('tag (sc_switch_new typeid) ('anchor args))
-        let mutable? = ('writable? ('typeof ptr))
-        for arg in ('args ...)
-            let k v = ('dekey arg)
-            if (k == unnamed)
-                sc_switch_append_default sw `(v)
-            else
-                name := (k as string)
-                let code =
-                    try (copy ('get self.name->typeid-map name))
-                    else
-                        error
-                            .. "cannot dispatch unbound type name: " name
-                let T =
-                    try (deref (('get self.typeid->info-map code) . T))
-                    else Nothing
-                let PT = (pointer.type T)
-                let PT =
-                    if mutable? ('mutable PT)
-                    else PT
-                sc_switch_append_case sw code `(v (@ (ptr as PT)))
-        sw
-
-    spice define-type (cls name code T ...)
-        cls as:= type
-        let self = (getinstance cls)
-        T as:= type
-        code as:= u32
-        name as:= string
-        local dedup? = true
-        for arg in ('args ...)
-            let k v = ('dekey arg)
-            switch k
-            case 'dedup
-                dedup? = ((sc_prove v) as bool)
-            default;
-        let name =
-            if (name == "") (tostring T)
-            else name
-        if ('in? self.typeid->info-map code)
-            let info =
-                try ('get self.typeid->info-map code)
-                else
-                    unreachable;
-            error
-                .. "typeid " (repr code) " already mapped to type " (repr info.T)
-
-        'set self.typeid->info-map code
-            TypeInfo
-                T = T
-                name = name
-                dedup? = dedup?
-
-        'set self.name->typeid-map name code
-
-        #let IdType = (('@ cls 'Id) as type)
-        let TypeIdType = (('@ cls 'TypeId) as type)
-        let enumval = (sc_const_int_new TypeIdType code)
-
-        let namesym = (Symbol name)
-        'set-symbol TypeIdType namesym enumval
-
-        let code = `code
-        let enum-id-offset = (('@ cls '_enum-id-offset) as type)
-        Switcher.stage-case enum-id-offset code
-            spice-quote
-                inline "#hidden" (code index)
-                    ([(gen-id-offset-func T)] index)
-
-        let get-typename = (('@ cls '_get-typename) as type)
-        Switcher.stage-case get-typename code
-            spice-quote
-                inline "#hidden" ()
-                    name as rawstring
-
-        let dispatch-any-type = (('@ cls 'dispatch-any-type) as type)
-        Switcher.stage-case dispatch-any-type code
-            spice-quote
-                inline "#hidden" (code f) (f T)
-
-        let do-dedup? = (('@ cls '_do-dedup?) as type)
-        Switcher.stage-case do-dedup? code
-            spice-quote
-                inline "#hidden" () dedup?
-
-        let builder = (('@ cls 'BuilderType) as type)
-        'set-symbol builder namesym
-            spice-quote
-                inline (self ...)
-                    'store (bitcast self cls) enumval ...
-
-        spice-quote
-            'define-symbol cls [(Symbol (.. "Id-" name))]
-                cls.Id enumval
-
-    inline vacount (cls typeid sz)
-        cls.dispatch-any-type typeid
-            inline (T)
-                let ET idx = (flexible-struct-type T)
-                static-if (ET == Nothing) 0:u32
-                else ((sz * u32_size - (sizeof T)) // (sizeof ET))
-
-run-stage;
-
-let memset =
-    extern 'memset (function void (mutable @u32) u32 usize)
-let memcpy =
-    extern 'memcpy (function void (mutable @u32) @u32 usize)
-
-inline alignoffsetu (offset align)
-    """"align `offset` up to `align`, which must be a power of 2
-    (offset + align - 1) & -align
-
-type TypeId < CEnum
-
-type Handle
-    let __dispatch =
-        inline "#hidden" (self ...)
-            let cls = (typeof self)
-            let typeid sz ptr = (unpack (storagecast self))
-            'dispatch-type cls.CADAGType typeid ptr ...
-
-    inline __unpack (self)
-        unpack (storagecast self)
-
-    fn vacount (self)
-        let cls = (typeof self)
-        let typeid sz = (unpack (storagecast self))
-        'vacount cls.CADAGType typeid sz
-
-    let name =
-        Accessor
-            inline (self key)
-                let cls = (typeof self)
-                let typeid sz ptr = (unpack (storagecast self))
-                'typenameof cls.CADAGType typeid
-
-type CADAGBuilder
-
-type+ CADAG
-    let builder =
-        Accessor
-            inline (value key)
-                let cls = (typeof value)
-                bitcast (view value) cls.BuilderType
-
-    inline new-type (name)
-        let T =
-            struct (do name) < this-type
-                words : (Array u32)
-
-                let instance = (new-env-data)
-
-                switcher _enum-id-offset
-                    default -1:usize
-                switcher _get-typename
-                    default ("?undefined?" as rawstring)
-                switcher dispatch-any-type
-                    default
-                        assert false "cannot dispatch type"
-                        unreachable;
-                switcher _do-dedup?
-                    default false
-
-                fn do-dedup? (cls typeid)
-                    _do-dedup? typeid
-
-                fn enum-id-offset (cls typeid index)
-                    _enum-id-offset typeid index
-
-                fn typenameof (cls typeid)
-                    _get-typename typeid
-
-        let BuilderType =
-            type (.. name "Builder") < CADAGBuilder :: (storageof T)
-                let CADAGType = T
-
-        let TypeIdType =
-            type (.. name "TypeId") < TypeId : u32
-                let CADAGType = T
-
-                inline typeinfo (self)
-                    'typeinfo T self
-
-                fn __repr (self)
-                    ..
-                        sc_default_styler style-number
-                            string ('typenameof T self)
-                        sc_default_styler style-operator ":"
-                        repr (typeof self)
-
-        let HandleType =
-            type (.. name "Handle") < Handle : (tuple TypeIdType u32 @u32)
-                let CADAGType = T
-
-        let MutableHandleType =
-            type (.. name "MutableHandle") < Handle : (tuple TypeIdType u32 (mutable @u32))
-                let CADAGType = T
-
-        let IdType =
-            type (.. name "Id") < Id
-                let CADAGType = T
-
-                @@ memo
-                inline __typecall (cls typeid)
-                    let info = ('typeinfo typeid)
-                    let T =
-                        type (.. "(" (tostring cls) " " info.name ")") < cls : u32
-                            let Type = info.T
-                            let TypeId = typeid
-                            let Name = info.name
-                    'define-symbol T '__typecall integer.__typecall
-                    T
-
-        type+ T
-            let BuilderType
-            let HandleType
-            let MutableHandleType
-            let Id = IdType
-            let TypeId = TypeIdType
-
-        'define-type T "none" 0:u32 Nothing
-
-        type+ T
-            let AnyId = T.Id-none
-            let NoId = (nullof AnyId)
-
-        T
-
-    inline __typecall (cls ...)
-        static-if (cls == this-type)
-            new-type ...
-        else
-            local self =
-                super-type.__typecall cls
-            do
-                # add null element
-                let words = self.words
-                'resize words 3
-                words @ 0 = 0:u32 # typeid
-                words @ 1 = 0:u32 # size
-                words @ 2 = 0:u32 # root id
-            deref self
-
-    fn... allocate (self, typeid : u32, wordcount : u32)
-        let words = self.words
-        # replace tail index
-        let offset = (((countof words) as u32) - 1)
-        let endoffset = (offset + wordcount + 2)
-        'resize words (endoffset + 1)
-        let dataptr = (& (words @ (offset + 2)))
-        memset dataptr 0:u8 ((wordcount as u64) * u32_size)
-        words @ offset = typeid
-        words @ (offset + 1) = wordcount
-        words @ endoffset = offset
-        _ offset dataptr
-
-    fn... rootid (self)
-        # raw u32 without type id
-        deref ('last self.words)
-
-    @@ memo
-    inline alloc-func (cls typeid)
-        let T = (('typeinfo typeid) . T)
-        let ET = (flexible-struct-type T)
-        IdType := (cls.Id typeid)
-        static-assert ((alignof T) <= 4)
-            .. "type " (tostring T) " must have alignment <= 4, but has "
-                tostring (alignof T)
-        static-if (ET == Nothing)
-            sz := (((sizeof T) + (u32_size - 1)) // u32_size) as u32
-            fn (self)
-                let a b = (allocate self typeid sz)
-                _ (bitcast a IdType) (bitcast b (mutable @T))
-        else
-            # flexible array
-            fn (self numelements)
-                let numelements =
-                    static-if (none? numelements) 0
-                    else numelements
-                sz := (((sizeof T) + (sizeof ET) * numelements
-                    + (u32_size - 1)) // u32_size) as u32
-                let a b = (allocate self typeid sz)
-                _ (bitcast a IdType) (bitcast b (mutable @T))
-
-    inline... alloc (self, typeid : TypeId, ...)
-        (alloc-func (typeof self) typeid) self ...
-
-    fn... handleof (self, offset : u32)
-        let cls = (typeof self)
-        let typeid sz = ('headerof self offset)
-        let ptr = ('load self offset)
-        bitcast
-            ((storageof cls.HandleType) typeid sz ptr)
-            cls.HandleType
-
-    fn... headerof (self, offset : u32)
-        _
-            deref (self.words @ offset)
-            deref (self.words @ (offset + 1))
-
-    struct StackEntry plain
-        id : u32
-        offset : u32
-        typeid : u32
-        size : u32
-        # last reference offset
-        refoffset : u32
-        # next reference index
-        refindex : u32
-
-    struct DescendStack
-        metadata : (Array StackEntry)
-
-        inline __countof (self)
-            countof self.metadata
-
-        fn peek (self)
-            'last self.metadata
-
-        fn pop (self)
-            from self let metadata
-            let md = ('pop metadata)
-
-        fn push (self module id)
-            from self let metadata
-            let typeid sz = ('headerof module id)
-            'append metadata
-                StackEntry
-                    id = id
-                    offset = ('offsetof module id)
-                    typeid = typeid
-                    size = sz
-                    refoffset = -1:u32
-                    refindex = 0
-
-    fn descend (self root ...)
-        let cls = (typeof self)
-        let visit =
-            va-option visit ...
-                inline (module id)
-                    let handle = ('handleof module id)
-                    report "done" id handle.name
-        let on-enter =
-            va-option on-enter ...
-                inline (module id) true
-        local stack : DescendStack
-        local seen : (Set u32)
-        if (on-enter (view self) root)
-            'push stack self root
-        loop ()
-            let md = ('peek stack)
-            let ofs = ('enum-id-offset cls (copy md.typeid) (copy md.refindex))
-            let wordofs = (ofs // u32_size)
-            if (wordofs >= md.size)
-                let oldid = (copy md.id)
-                visit (view self) oldid
-                # clear
-                'pop stack
-                if (empty? stack)
-                    return;
-            else
-                assert ((ofs % u32_size) == 0)
-                let ofs = (md.offset + wordofs)
-                md.refoffset = (ofs as u32)
-                md.refindex += 1
-                let nextid = (copy (self.words @ ofs))
-                if (not ('in? seen nextid))
-                    'insert seen nextid
-                    if (on-enter (view self) nextid)
-                        'push stack self nextid
-
-    struct TransformStack
-        data : (Array u32)
-        metadata : (Array StackEntry)
-
-        inline __countof (self)
-            countof self.metadata
-
-        fn peek (self)
-            'last self.metadata
-
-        fn pop (self)
-            from self let data metadata
-            let md = ('pop metadata)
-            'resize data ((countof data) - md.size)
-
-        fn push (self module id)
-            from self let data metadata
-            let typeid sz = ('headerof module id)
-            let ptr = ('load module id)
-            let dataoffset = (countof data)
-            'resize data (dataoffset + sz)
-            if (sz != 0)
-                memcpy (& (data @ dataoffset)) ptr (u32_size * sz)
-            'append metadata
-                StackEntry
-                    id = id
-                    offset = (dataoffset as u32)
-                    typeid = typeid
-                    size = sz
-                    refoffset = -1:u32
-                    refindex = 0
-
-    let u256 = (integer 256)
-
-    fn transform (self root ...)
-        let cls = (typeof self)
-        local newmodule : cls
-        local dedup_map : (Map u256 u32)
-        local aliases : (Map u32 u32)
-        let alias =
-            va-option alias ...
-                inline (id)
-                    copy ('get aliases id)
-        let on-enter =
-            va-option on-enter ...
-                inline (id)
-        let on-alias =
-            va-option on-alias ...
-                inline (oldid newid)
-                    'set aliases oldid newid
-        let visit =
-            va-option visit ...
-                inline (module 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
-        loop ()
-            let md = ('peek stack)
-            let ofs = ('enum-id-offset cls (copy md.typeid) (copy md.refindex))
-            let wordofs = (ofs // u32_size)
-            vvv bind oldid newid
-            if (wordofs >= md.size)
-                let stackptr =
-                    if md.size (& (stack.data @ md.offset))
-                    else (null as (mutable @u32))
-                capture finalize () {&newmodule &md stackptr &dedup_map}
-                    let dedup? = ('do-dedup? cls md.typeid)
-                    if dedup?
-                        local sha : SHA256
-                        'hash sha (bitcast &md.typeid rawstring) u32_size
-                        'hash sha (bitcast stackptr rawstring) (u32_size * md.size)
-                        let digest = ('digest sha)
-                        let digest = (@ (bitcast &digest @u256))
-                        try
-                            return (copy ('get dedup_map digest))
-                        else;
-                        let newid ptr = ('allocate newmodule (copy md.typeid) (copy md.size))
-                        'set dedup_map digest newid
-                        memcpy ptr stackptr (u32_size * md.size)
-                        newid
-                    else
-                        let newid ptr = ('allocate newmodule (copy md.typeid) (copy md.size))
-                        memcpy ptr stackptr (u32_size * md.size)
-                        newid
-                let handle = (bitcast
-                    ((storageof cls.MutableHandleType) md.typeid md.size stackptr)
-                    cls.MutableHandleType)
-                let newid = (visit (view newmodule) handle finalize)
-                let oldid = (copy md.id)
-                on-alias oldid newid
-                # clear
-                'pop stack
-                if (empty? stack)
-                    return newmodule (copy newid)
-                _ oldid newid
-            else
-                assert ((ofs % u32_size) == 0)
-                let ofs = (md.offset + wordofs)
-                md.refoffset = (ofs as u32)
-                md.refindex += 1
-                let oldid = (copy (stack.data @ ofs))
-                let newid =
-                    try (alias oldid)
-                    else
-                        on-enter oldid
-                        # no alias
-                        'push stack self oldid
-                        repeat;
-                _ oldid newid
-            # update reference in parent
-            let md = ('peek stack)
-            let ofs = ('enum-id-offset cls (copy md.typeid) (md.refindex - 1))
-            let idref = (stack.data @ md.refoffset)
-            assert (idref == oldid)
-            idref = newid
-
-    @@ memo
-    inline store-func (typeid)
-        let T = (('typeinfo typeid) . T)
-        static-if ((storageof T) < aggregate)
-            let ET idx = (flexible-struct-type T)
-            let ET... =
-                static-if ((storageof T) < aggregate)
-                    elementsof T
-                else T
-            let ETcount = (va-countof ET...)
-            static-if (ET == Nothing) # not variadic
-                inline (self ...)
-                    let id ptr = (alloc self typeid)
-                    let ptr = (@ ptr)
-                    va-map
-                        inline (i)
-                            (extractvalue ptr i) = (va@ i ...)
-                        va-range ETcount
-                    id
-            else
-                let string? = (ET == char)
-                let ETcount = (ETcount - 1)
-                inline (self ...)
-                    let argcount = (va-countof ...)
-                    let extra =
-                        static-if string?
-                            + 1
-                                va-map
-                                    inline (i)
-                                        let arg = (va@ i ...)
-                                        static-if ((typeof arg) == string)
-                                            (countof arg) as i32
-                                        else 1
-                                    va-range ETcount argcount
-                        else (argcount - ETcount)
-                    let id ptr = (alloc self typeid extra)
-                    let ptr = (@ ptr)
-                    va-map
-                        inline (i)
-                            (extractvalue ptr i) = (va@ i ...)
-                        va-range ETcount
-                    let tail = (extractvalue ptr idx)
-                    static-if string?
-                        va-lfold 0
-                            inline (k i idx)
-                                let arg = (va@ i ...)
-                                let dest = (extractvalue tail idx)
-                                static-if ((typeof arg) == string)
-                                    let count = (countof arg)
-                                    memcpy ((& dest) as (mutable @u32))
-                                        \ (arg as rawstring as @u32) count
-                                    idx + count
-                                else
-                                    dest = arg
-                                    idx + 1
-                            va-range ETcount argcount
-                    else
-                        va-map
-                            inline (i)
-                                (extractvalue tail i) = (va@ (i + ETcount) ...)
-                            va-range extra
-                    id
-        else
-            inline (self value)
-                let id ptr = (alloc self typeid)
-                let ptr = (@ ptr)
-                ptr = value
-                id
-
-    inline... store (self, typeid : TypeId, ...)
-        (store-func typeid) self ...
-
-    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)
-        offset := (id as u32) + 2
-        & (self.words @ offset)
-
-    fn... repr (self, id : u32)
-        let cls = (typeof self)
-        let typeid sz = ('headerof self id)
-        let ptr = ('load self id)
-        ..
-            default-styler style-symbol
-                .. "%" (tostring id)
-            default-styler style-operator " = "
-            default-styler style-keyword
-                string ('typenameof cls typeid)
-            cls.dispatch-any-type typeid
-                inline (T)
-                    value-typeid-repr (@ (bitcast ptr @T)) sz
-
-    fn dump (self)
-        descend self ('rootid self)
-            visit =
-                capture (module id) {}
-                    print ('repr module id)
-
-do
-    let CADAG RIFF riff->string
-    locals;

          
M testing/tukdag.sc +12 -10
@@ 598,6 598,17 @@ fn translate-FIR (self module)
     local ctx : FIRContext
     'append ctx.pginfostack ('getcpuprogramkey ctx)
 
+    vvv bind on-enter
+    capture (module oldmodule id) {&ctx}
+        let handle = ('handleof oldmodule id)
+        dispatch handle
+        case range (self)
+            'append ctx.pginfostack ('getcpuprogramkey ctx)
+        case input (self)
+            return false
+        default;
+        true
+
     vvv bind visit
     capture (module handle finalize) {&ctx}
         from (methodsof module.builder) let ILConstInt ILIntegerType

          
@@ 681,16 692,7 @@ fn translate-FIR (self module)
         finalize;
 
     'translate self module ('rootid module)
-        on-enter =
-            capture (module oldmodule id) {&ctx}
-                let handle = ('handleof oldmodule id)
-                dispatch handle
-                case range (self)
-                    'append ctx.pginfostack ('getcpuprogramkey ctx)
-                case input (self)
-                    return false
-                default;
-                true
+        on-enter = on-enter
         visit = visit
 
 ################################################################################