9041f8753465 — Leonard Ritter 24 days ago
* more work on arena GC
3 files changed, 280 insertions(+), 1375 deletions(-)

M testing/arena_gc.sc
R testing/test_node3.sc => 
M testing/toposort.sc
M testing/arena_gc.sc +229 -24
@@ 2,11 2,15 @@ 
 
 using import struct
 using import Array
+using import Set
 
 import ..lib.tukan.use
 using import tukan.logtile
 
-let WordType = u64
+let WordType = u32
+let WordTypeSize = (sizeof WordType)
+
+let PointerWordType = u64
 
 type APointer
 type ARef

          
@@ 19,12 23,12 @@ inline genatypes (T)
     let ElementType = T
     let MutablePointerType = (mutable @T)
     let APtr =
-        type (.. "(APointer " Tstr ")") < APointer : WordType
+        type (.. "(APointer " Tstr ")") < APointer : PointerWordType
             let ElementType
             let MutablePointerType
 
     let ARef =
-        type (.. "(ARef " Tstr ")") < ARef : WordType
+        type (.. "(ARef " Tstr ")") < ARef : PointerWordType
             let ElementType
             let MutablePointerType
             let APointerType = APtr

          
@@ 32,37 36,66 @@ inline genatypes (T)
     _ APtr ARef
 
 type+ APointer
-    inline __typecall (cls T)
-        let aptrT = (genatypes T)
-        aptrT
+    inline __typecall (cls ...)
+        static-if (cls == this-type)
+            let T = ...
+            let aptrT = (genatypes T)
+            aptrT
+        else
+            #static-error "APointer has no constructor"
+            nullof cls
+
+let avoidstar = (APointer void)
 
 type+ ARef
-    inline __typecall (cls T)
-        let x arefT = (genatypes T)
-        arefT
+    inline __typecall (cls ...)
+        static-if (cls == this-type)
+            let T = ...
+            let x arefT = (genatypes T)
+            arefT
+        else
+            static-error "ARef has no constructor"
+
+@@ memo
+inline wordcount (T)
+    size := ((sizeof T) + (WordTypeSize - 1)) // WordTypeSize
+    alignsizeu size
 
 struct Arena
     mem : (Array WordType)
 
-    fn alloc-bytes (self size)
-        let mem = self.mem
-        sz := (countof mem)
-        'resize mem (sz + size)
-        bitcast sz (APointer void)
+    fn... alloc-words (self, size : u64)
+        if (size > 0)
+            let mem = self.mem
+            offset := (countof mem)
+            size := (alignsizeu size)
+            offset := (alignoffsetu offset size)
+            'resize mem (offset + size)
+            ptr := (enctile offset size)
+            bitcast ptr avoidstar
+        else (avoidstar)
 
     inline... alloc (self, T : type)
         assert ('plain? T) "type must be plain"
-        let ptr = (alloc-bytes self (sizeof T))
-        bitcast ptr (APointer T)
+        let AT = (APointer T)
+        bitcast (alloc-words self ('wordcount AT)) AT
+
+    inline... alloc-array (self, T : type, count : u64)
+        assert ('plain? T) "type must be plain"
+        let AT = (APointer T)
+        bitcast (alloc-words self (count * ('wordcount AT))) AT
 
     inline aptrtoptr (self aptr)
-        bitcast (reftoptr (self.mem @ (storagecast aptr)))
+        let ofs = (dectile (storagecast aptr))
+        bitcast (reftoptr (self.mem @ ofs))
             (typeof aptr) . MutablePointerType
 
     inline store (self value dest)
+        assert ((storagecast dest) != 0) "nullpointer store"
         store value (aptrtoptr self dest)
 
     inline load (self src)
+        assert ((storagecast src) != 0) "nullpointer load"
         load (aptrtoptr self src)
 
 global arena : Arena

          
@@ 83,6 116,25 @@ type+ ARef
                 imply ('load arena self) T
 
     @@ memo
+    inline __rimply (cls T)
+        inline wrap (value)
+            # compute arena pointer from system pointer
+            let T = (typeof value)
+            let ptr = (ptrtoint (reftoptr value) usize)
+            let memsize = ((countof arena.mem) * WordTypeSize)
+            let memptr = (ptrtoint (reftoptr (arena.mem @ 0)) usize)
+            assert ((ptr >= memptr) & (ptr < (memptr + memsize))) "pointer not in range"
+            let offset = (ptr - memptr)
+            assert ((offset % WordTypeSize) == 0) "pointer word-unaligned"
+            let offset = (offset // WordTypeSize)
+            let Tsize = (wordcount T)
+            assert ((offset % Tsize) == 0) "pointer size-unaligned"
+            bitcast (enctile offset Tsize) (ARef T)
+        static-if (&? cls)
+            static-if (T == ARef) wrap
+            elseif (T == (ARef (unqualified cls))) wrap
+
+    @@ memo
     inline __as (cls T)
         let ET = cls.ElementType
         static-if (as? ET T)

          
@@ 92,6 144,12 @@ type+ ARef
     inline tomemref (self)
         ptrtoref ('aptrtoptr arena self)
 
+    spice __methodcall (symbol self args...)
+        'tag `(symbol (tomemref self) args...) ('anchor args)
+
+    spice __getattr (self key)
+        'tag `(getattr (tomemref self) key) ('anchor args)
+
     fn __repr (self)
         repr (tomemref self)
 

          
@@ 100,16 158,45 @@ type+ ARef
 
 type+ APointer
     inline __toref (self)
+        assert ((storagecast self) != 0) "can not dereference nullpointer"
         bitcast self ((typeof self) . ARefType)
 
+    @@ memo
+    inline wordcount (cls)
+        size := ((sizeof cls.ElementType) + (WordTypeSize - 1)) // WordTypeSize
+        alignsizeu size
+
+    fn region (self)
+        dectile (storagecast self)
+
+    fn __tobool (self)
+        (storagecast self) != 0
+
+    fn __countof (self)
+        let T = (typeof self)
+        let Tsize = ('wordcount T)
+        let tile = (storagecast self)
+        let ofs size = (dectile tile)
+        assert ((size % Tsize) == 0) "unexpected misalignment of size"
+        return (size // Tsize)
+
+    fn __@ (self index)
+        let T = (typeof self)
+        let tile = (storagecast self)
+        let size = ('wordcount T)
+        let ofs = (dectile tile)
+        let subtile = (enctile (ofs + size * index) size)
+        let l r = (tilexbounds tile)
+        assert ((subtile > l) & (subtile < r)) "pointer index out of bounds"
+        bitcast subtile T.ARefType
+
 from (methodsof arena) let alloc alloc-array
 
-let locarena =
+let alocal =
     gen-allocator-sugar
         spice "locarena-copy" (expr-head T value)
             spice-quote
                 let val = (alloc T)
-                dump (qualifiersof val)
                 'store arena (imply value T) val
                 @ val
         spice "locarena-new" (expr-head T args...)

          
@@ 118,12 205,130 @@ let locarena =
                 'store arena (T args...) val
                 @ val
 
+#
+        let vinit vvalid vat vnext = ((vertices as Generator))
+        let it... = (vinit)
+        if (not (vvalid it...))
+            return;
+        let first = (vat it...)
+        let it... = (vnext it...)
+        let init valid at next = (((edgef first ctx...) as Generator))
+        local stack : (Array (tuple usize (va-map typeof (init))))
+        local visited : (Set usize)
+
+        for vx in vertices
+            vx as:= usize
+            if (not (vx in visited))
+                'insert visited vx
+                'append stack (tupleof vx ((((edgef vx ctx...) as Generator))))
+                while (not (empty? stack))
+                    let v it... = (unpack ('last stack))
+                    let init valid at next = (((edgef v) as Generator))
+                    if (valid it...)
+                        let vx = (at it...)
+                        vx as:= usize
+                        let nextit... = (next it...)
+                        va-map
+                            inline (i)
+                                (va@ i it...) = (va@ i nextit...)
+                            va-range (va-countof it...)
+                        if (not (vx in visited))
+                            'insert visited vx
+                            'append stack
+                                tupleof vx ((((edgef vx ctx...) as Generator)))
+                    else
+                        'pop stack
+                        visitf v ctx...
+                        ;
+
+inline walkvalue (value f ctx...)
+    """"call f for elements of referenced value
+    let elements... = (elementsof (storageof (typeof value)))
+    let value = (reftoptr value)
+    va-lfold 0
+        inline (k v i)
+            let MT = (unqualified v)
+            static-if ((MT < APointer) or (MT < ARef))
+                f (ptrtoref (getelementptr value 0 i)) ctx...
+            i + 1
+        elements...
+    ;
+
+inline walker (f)
+    fn... visit (value : ARef, visited, ctx...)
+        returning void
+        let tile = (storagecast value)
+        if (tile in visited)
+            return;
+        'insert visited tile
+        walkvalue (ARef.tomemref value) this-function visited ctx...
+        f value ctx...
+        ;
+    case (value : APointer, visited, ctx...)
+        returning void
+        let tile = (storagecast value)
+        if (tile in visited)
+            return;
+        'insert visited tile
+        let T = ((typeof value) . ElementType)
+        for i in (range (countof value))
+            let val = (imply (value @ i) T)
+            if &val
+                this-function val visited ctx...
+        f value ctx...
+        ;
+
+    local visited : (Set PointerWordType)
+    inline (root ctx...)
+        visit root visited ctx...
+
 run-stage;
 
-locarena x = 0
-x = 2
-print (x + 3)
-print (as x u16)
-print (tupleof x)
+struct Node plain
+    sources : (APointer (ARef this-type))
+    id : i32 = 0
+
+    fn edges (self edges...)
+        let self = (imply self ARef)
+        let edgecount = (va-countof edges...)
+        let arr = (alloc-array (ARef this-type) edgecount)
+        va-map
+            inline (i)
+                arr @ i = (va@ i edges...)
+            va-range edgecount
+        self.sources = arr
+        #print "sources" self.sources
+
+fn addnode (i edges...)
+    alocal n : Node
+    n.id = i
+    'edges n edges...
+    #print "edges" (& n) n.sources
+    n
+
+let n10 = (addnode 10)
+let n12 = (addnode 12)
+let n11 = (addnode 11 n12)
+let n9 = (addnode 9 n10 n12 n11)
+let n4 = (addnode 4 n9)
+let n6 = (addnode 6 n9 n4)
+let n7 = (addnode 7 n6)
+let n8 = (addnode 8 n7)
+let n1 = (addnode 1)
+let n5 = (addnode 5)
+let n3 = (addnode 3 n4 n5)
+let n2 = (addnode 2 n3)
+let n0 = (addnode 0 n6 n1 n2 n3 n5)
+print n0.sources
+print ('region n0.sources)
+let walk =
+    walker
+        inline (value)
+            static-if (((typeof value) . ElementType) == Node)
+                print "visit" value.id
+walk n8
+walk n0
+
+
 
 ;
  No newline at end of file

          
R testing/test_node3.sc =>  +0 -1311
@@ 1,1311 0,0 @@ 
-
-using import enum
-using import struct
-using import Rc
-using import Option
-using import Array
-using import Map
-using import Set
-using import String
-using import testing
-using import itertools
-using import UTF-8
-
-""""two-dimensional entry of expressions
-
-    Usage:
-
-        :::scopes
-        2d print    'X0 'X1 'X2
-            -------------------
-            'Y0     1   2   3
-            'Y1     4   5   6
-            'Y2     7   8   9
-
-    Will expand to:
-
-        :::scopes
-        embed
-            print 'X0 'Y0 1; print 'X1 'Y0 2; print 'X2 'Y0 3
-            print 'X0 'Y1 4; print 'X1 'Y1 5; print 'X2 'Y1 6
-            print 'X0 'Y2 7; print 'X1 'Y2 8; print 'X2 'Y2 9
-sugar 2d (f args...)
-    let header rest =
-        loop (header rest = '() args...)
-            if (empty? rest)
-                error "-* expected"
-            let arg rest = (decons rest)
-            if (('typeof arg) == Symbol)
-                let s = (arg as Symbol as string)
-                if ((lslice s 1) == "-")
-                    break header rest
-            repeat
-                cons arg header
-                rest
-    let numcolumns = (countof header)
-    let reversed_header = ('reverse header)
-    cons embed
-        'reverse
-            fold (result = '()) for row in rest
-                let y z-entries = (decons (row as list))
-                fold (result = result) for z x in
-                    zip z-entries reversed_header
-                    cons ('tag `[(list f x y z)] ('anchor z)) result
-
-sugar makevisitor (s)
-    if (('typeof s) == string)
-        spice-quote
-            inline "visit" (cls visitor)
-                spice-unquote
-                    let expr = (sc_expression_new)
-                    str := s as string
-                    for i c in (enumerate str)
-                        let op =
-                            switch c
-                            case (char "*") # ignore
-                                continue;
-                            case (char "u") `(visitor.visit-i32)
-                            case (char "b") `(visitor.visit-bool)
-                            case (char "@") `(visitor.visit-id)
-                            case (char "s") `(visitor.visit-string)
-                            case (char "I") `(visitor.visit-input)
-                            case (char "O") `(visitor.visit-output)
-                            default
-                                local c = c
-                                hide-traceback;
-                                error@
-                                    sc_anchor_offset ('anchor s) (i + 1)
-                                    "while parsing signature"
-                                    .. "unknown signature token: "
-                                        string (& c) 1
-                        let op =
-                            switch (str @ (i + 1))
-                            case (char "*")
-                                `(for i in (visitor.oprange) op)
-                            default op
-                        sc_expression_append expr op
-                    expr
-
-    else s
-
-# enumerate the bit indices of integer
-inline... iterbits (value : integer)
-    let zero = (0 as (typeof value))
-    let bit = (1 as (typeof value))
-    let eob = (-1 as (typeof value))
-    Generator
-        inline () (findlsb value)
-        inline (pos) (pos != eob)
-        inline (pos) pos
-        inline (pos)
-            pos := pos + bit
-            ofs := (findlsb (lshr value pos))
-            ? (ofs == eob) ofs (pos + ofs)
-
-run-stage;
-
-sugar defnode (attr name value)
-    #vvv report
-    switch (attr as Symbol)
-    case 'super
-        qq type [name] < [value]
-    case 'signature
-        list ''define-symbol name ''visit #(list sugar-quote attr)
-            'tag `[(list makevisitor value)] ('anchor value)
-    default
-        if
-            and (('typeof value) == Symbol)
-                (value as Symbol == '-)
-            '()
-        else
-            qq 'define-symbol [name] '[attr] [value]
-
-spice va-each-key (scope f)
-    scope as:= Scope
-    let expr = (sc_expression_new)
-    for k v in scope
-        sc_expression_append expr ('tag `(f k v) ('anchor k))
-    expr
-
-spice va-switch-case (scope enum-type funcname cond defaultf ...)
-    scope as:= Scope
-    let sw = (sc_switch_new cond)
-    for k v in scope
-        sc_switch_append_case sw
-            `(getattr enum-type k)
-            `((getattr v funcname) v ...)
-    sc_switch_append_default sw `(defaultf ...)
-    sw
-
-run-stage;
-
-let Id = u32
-
-let NoId = (Id 0)
-let NoType = NoId
-
-#
-    fundamental idea:
-        all processing flow organized around single I/O wait blackbox,
-        therefore purely functional
-
-    sync options:
-
-    sequencer pattern that repeats in custom unit of time?
-
-    supply audio frames
-        per sample
-        per N samples
-
-    supply video frames
-        per pixel
-        per full frame
-
-    supply network packets
-        per received packet
-        conditional source linked to periodic event?
-
-    supply filestream
-
-    always pull timecode from audio?
-
-    custom sync sources?
-        every N audio samples
-        every N video frames
-        every N nanoseconds
-        per input event
-        ?
-
-
-enum Input : u32
-    # TypeInt 32 false
-    Samplerate
-
-    # TypeVector (TypeInt 32 false) 2
-    ScreenSize
-
-    # TypeVector (TypeInt 32 false) 2
-    ScreenCoord
-
-    # TypeString
-    Readline
-
-    # TypeTuple
-    Setup
-
-enum Output : u32
-    # TypeVector (TypeReal 32) 2
-    Audio
-
-    # TypeVector (TypeReal 32) 4
-    Color
-
-    # TypeString
-    Stdout
-
-    # TypeString
-    Stderr
-
-    # TypeTuple
-    Exit
-
-    # TypeString
-    Prompt
-
-#
-    function definitions w. closure support:
-
-    Environment <parent-env>
-
-    Parameter <environment | previous-parameter>
-
-    Function <last-parameter> <value>
-
-    -- then --
-
-    fn outer (x y z)
-        fn inner (a b)
-            + x y z a b
-
-    -- translates to --
-
-    %1 = Environment NoId
-    %2 = Parameter %1
-    %3 = Parameter %2
-    %4 = Parameter %3
-    %5 = Environment %1
-    %6 = Parameter %5
-    %7 = Parameter %6
-    %8 = Add %2 %3 %4 %6 %7
-    %9 = Function %7 %8
-    %10 = Function %4 %9
-
-enum Op : u32
-struct Node
-
-struct Module
-
-type OpAny
-    inline visit (cls visitor)
-
-type OpType < OpAny
-
-type OpPure < OpAny
-
-type OpInstr < OpAny
-
-type OpControl < OpAny
-
-type OpConstant < OpPure
-    inline constant? (cls) true
-
-inline constsig (cls visitor)
-    switch (visitor.typeop)
-    case Op.TypeBool
-        visitor.visit-bool;
-    case Op.TypeInt
-        visitor.visit-i32;
-    case Op.TypeReal
-        visitor.visit-f32;
-    default;
-
-vvv bind OpDefs
-do
-    let _Input = Input
-    let _Output = Output
-    unlet Input Output
-
-    2d defnode              super       signature   eval
-        -------------------------------------------------------
-        TypeVoid            OpType      ""          -
-        TypeInt             OpType      "ub"        -
-        TypeBool            OpType      ""          -
-        TypeReal            OpType      "u"         -
-        TypeVector          OpType      "@u"        -
-        TypeArray           OpType      "@u"        -
-        TypeTuple           OpType      "@*"        -
-        TypeString          OpType      ""          -
-        Constant            OpConstant  constsig    -
-        ConstantComposite   OpConstant  "@*"        -
-        ConstantString      OpConstant  "s"         -
-        Undefined           OpPure      ""          -
-        Parameters          OpPure      "@"         -
-        Parameter           OpPure      "@u"        -
-        Function            OpPure      "@@"        -
-        Input               OpPure      "I"         -
-        Output              OpPure      "O"         -
-        State               OpPure      "@@"        -
-        Defined             OpPure      "@"         -
-        Merge               OpControl   "@@"        -
-        If                  OpControl   "@@@"       -
-        Body                OpControl   "@@"        -
-        Bind                OpInstr     "@@"        -
-        CompositeInsert     OpInstr     "@@u*"      -
-        CompositeConstruct  OpInstr     "@*"        -
-        ConvertIntToReal    OpInstr     "@"         -
-        ConvertRealToInt    OpInstr     "@"         -
-        Sin                 OpInstr     "@"         -
-        Cos                 OpInstr     "@"         -
-        FAdd                OpInstr     "@@"        -
-        FMul                OpInstr     "@@"        -
-        FDiv                OpInstr     "@@"        -
-        Equal               OpInstr     "@@"        -
-
-    unlet _Input _Output
-    locals;
-
-################################################################################
-
-enum Op
-    None = 0
-
-    va-each-key OpDefs
-        inline (name T)
-            tag name
-
-inline visit-node (code defaultf visitor)
-    va-switch-case OpDefs Op 'visit code defaultf visitor
-
-inline canonicalize-node (node)
-    va-switch-case OpDefs Op 'canonicalize node.opCode (inline ()) node
-
-################################################################################
-
-fn... append-operand (self, operand : Id)
-    'append self operand
-    ;
-case (self, text : String)
-    numbytes := (countof text)
-    let word =
-        fold (word = 0:u32) for i c in (enumerate text)
-            i0 := (i as u32 & 3:u32)
-            word := word | (c as u32 << (i0 * 8:u32))
-            if (i0 == 3:u32)
-                'append self word
-                0:u32
-            else word
-    'append self word
-    ;
-
-struct Node
-    opCode : Op
-    typeId : Id
-    operands : (Array Id)
-
-    fn __hash (self)
-        h := (hash self.opCode self.typeId)
-        fold (h = h) for operand in self.operands
-            hash h operand
-
-    fn __copy (self)
-        super-type.__typecall this-type
-            self.opCode
-            self.typeId
-            copy self.operands
-
-    fn getstring (self idx)
-        local text : String
-        let ops = self.operands
-        let count = ((countof self.operands) as i32)
-        label done
-            for idx in (range idx count)
-                let word = (ops @ idx)
-                for c in (range 4:u32)
-                    byte := (word >> (c * 8:u32)) as i8
-                    if (byte == 0:i8)
-                        merge done
-                    'append text byte
-        text
-
-    @@ memo
-    inline __== (cls T)
-        static-if (cls == T)
-            fn (a b)
-                and
-                    a.opCode == b.opCode
-                    a.typeId == b.typeId
-                    a.operands == b.operands
-
-    inline... __typecall
-    case (cls, opCode : Op, typeId : Id, ...)
-        super-type.__typecall cls opCode typeId
-            static-if (va-empty? ...) ()
-            else
-                local ops : (Array Id)
-                va-map
-                    inline (value)
-                        append-operand ops value
-                    ...
-                ops
-    case (cls, opCode : Op, typeId : Id, ...)
-        this-function cls NoId opCode typeId ...
-
-let RcNode = (Rc Node)
-
-################################################################################
-
-fn idstr (id)
-    if (id == 0) "none"
-    else
-        "%" .. (tostring id)
-
-################################################################################
-
-struct Module
-    nodes : (Array RcNode)
-    root : Id
-    # maps node specification to id
-    rnodes :
-        Map RcNode Id
-            fn (rcnode)
-                hash (rcnode as Node)
-    # cached select simplifications
-    select_cache : (Map (tuple Id Id Id) Id)
-    rnodes_valid = false
-
-    inline __typecall (cls)
-        local nodes : (Array RcNode)
-        'append nodes (RcNode Op.None NoType)
-        super-type.__typecall cls
-            nodes = nodes
-
-    fn rebuild-rnodes (self)
-        if self.rnodes_valid
-            return;
-        'clear self.rnodes
-        for id node in (enumerate self.nodes u32)
-            let oldid = ('getdefault self.rnodes node NoId)
-            if (oldid == NoId)
-                'set self.rnodes (copy node) id
-        self.rnodes_valid = true
-
-    fn... insert-node (self, node : RcNode)
-        let newid = ((countof self.nodes) as Id)
-        'append self.nodes (copy node)
-        'set self.rnodes node newid
-        copy newid
-
-    fn... nodeId
-    case (self, node : RcNode)
-        rebuild-rnodes self
-        let id = ('getdefault self.rnodes node NoId)
-        if (id == NoId)
-            insert-node self node
-        else (copy id)
-    case (self, node : Node)
-        rebuild-rnodes self
-        let id = ('getdefault self.rnodes node NoId)
-        if (id == NoId)
-            insert-node self (Rc.wrap (deref node))
-        else (copy id)
-
-    fn... integerType (self, width : i32, signed : bool)
-        'nodeId self
-            Node Op.TypeInt NoType
-                width as u32; signed as u32
-
-    fn... realType (self, width : i32)
-        'nodeId self
-            Node Op.TypeReal NoType
-                width as u32
-
-    fn boolType (self)
-        'nodeId self
-            Node Op.TypeBool NoType
-
-    fn voidType (self)
-        'nodeId self
-            Node Op.TypeVoid NoType
-
-    fn... vectorType (self, compId : Id, count : i32)
-        'nodeId self
-            Node Op.TypeVector NoType compId (count as u32)
-
-    fn... arrayType (self, elemId : Id, count : i32)
-        'nodeId self
-            Node Op.TypeArray NoType elemId (count as u32)
-
-    fn... tupleType (self, ...)
-        'nodeId self
-            Node Op.TypeTuple NoType ...
-
-    fn stringType (self)
-        'nodeId self
-            Node Op.TypeString NoType
-
-    fn... constInt (self, typeId : Id, value : u32)
-        'nodeId self
-            Node Op.Constant typeId value
-    case (self, value : i32)
-        this-function self ('integerType self 32 true) (value as u32)
-
-    fn... constUInt (self, value : u32)
-        'constInt self ('integerType self 32 true) value
-
-    fn... constFloat (self, typeId : Id, value : f32)
-        'nodeId self
-            Node Op.Constant typeId (bitcast value u32)
-    case (self, value : f32)
-        this-function self ('floatType self 32) value
-
-    fn... constBool (self, value : bool)
-        'nodeId self
-            Node Op.Constant ('boolType self) (value as u32)
-
-    fn... constString (self, value : String)
-        'nodeId self
-            Node Op.ConstantString ('stringType self) value
-
-    fn... constComposite (self, typeId : Id, ...)
-        'nodeId self
-            Node Op.ConstantComposite typeId ...
-
-    fn... constBang (self)
-        constComposite self (tupleType self)
-
-    fn... parameters (self, typeId : Id, parent : Id = NoId)
-        'nodeId self
-            Node Op.Parameters typeId parent
-
-    fn... function (self, typeId : Id, params : Id, value : Id)
-        'nodeId self
-            Node Op.Function typeId params value
-
-    fn... parameter (self, params : Id, index : u32)
-        typeId := ('getArg self ('getType self params) index)
-        'nodeId self
-            Node Op.Parameter typeId params index
-
-    fn... rawinput (self, typeId : Id, name : Input)
-        'nodeId self
-            Node Op.Input typeId name
-
-    fn... defined? (self, source : Id)
-        'nodeId self
-            Node Op.Defined ('boolType self) source
-
-    fn... input
-    case (self, typeId : Id, name : Input)
-        let inp = (rawinput self typeId name)
-        'then self
-            'defined? self inp
-            inp
-    case (self, name : Input)
-        let inp = (rawinput self NoId name)
-        'defined? self inp
-
-    fn... output (self, typeId : Id, name : Output)
-        'nodeId self
-            Node Op.Output typeId name
-
-    fn... intToReal (self, typeId : Id, node : Id)
-        'nodeId self
-            Node ('getCond self node) Op.ConvertIntToReal typeId node
-
-    fn... realToInt (self, typeId : Id, node : Id)
-        'nodeId self
-            Node ('getCond self node) Op.ConvertRealToInt typeId node
-
-    fn... state (self, typeId : Id, default : Id, name : String)
-        'nodeId self
-            Node Op.State typeId default name
-
-    fn... getArgs (self, node : Id, index : u32, ...)
-        ops := (self.nodes @ node) . operands
-        va-map
-            inline (i)
-                copy (ops @ i)
-            \ index ...
-    fn... getArg (self, node : Id, index : u32)
-        copy ((self.nodes @ node) . operands @ index)
-    fn... getType (self, node : Id)
-        copy ((self.nodes @ node) . typeId)
-    fn... getOp (self, node : Id)
-        copy ((self.nodes @ node) . opCode)
-
-    inline unary_op (op)
-        fn... (self, x : Id)
-            'nodeId self
-                Node ('getCond self x) op (getType self x) x
-
-    inline binary_op (op)
-        fn... (self, a : Id, b : Id)
-            'nodeId self
-                Node
-                    \ op (getType self a) a b
-
-    inline binary_bool_op (op)
-        fn... (self, a : Id, b : Id)
-            'nodeId self
-                Node op ('boolType self) a b
-    let
-        sin = (unary_op Op.Sin)
-        cos = (unary_op Op.Cos)
-        fadd = (binary_op Op.FAdd)
-        fmul = (binary_op Op.FMul)
-        fdiv = (binary_op Op.FDiv)
-        equal = (binary_bool_op Op.Equal)
-
-    fn... compositeInsert (self, value : Id, target : Id, ...)
-        'nodeId self
-            Node Op.CompositeInsert (getType self target) value target ...
-
-    fn... compositeConstruct (self, typeId : Id, ...)
-        'nodeId self
-            Node Op.CompositeConstruct typeId ...
-
-    @@ memo
-    inline genvisitor (visit-id visit-input visit-output visit-i32 visit-f32 visit-bool visit-string visit-unknown)
-        fn (self node ctx...)
-            local idx = 0
-            let operand-count = (countof node.operands)
-            inline readop ()
-                assert (idx < operand-count)
-                    .. "missing operand in node of type "
-                        repr node.opCode
-                let operand = (node.operands @ idx)
-                idx += 1
-                operand
-            inline nop ()
-            visit-unknown := visit-unknown or nop
-            visit-id := visit-id or visit-unknown
-            visit-input := visit-input or visit-unknown
-            visit-output := visit-output or visit-unknown
-            visit-i32 := visit-i32 or visit-unknown
-            visit-f32 := visit-f32 or visit-unknown
-            visit-bool := visit-bool or visit-unknown
-            visit-string := visit-string or visit-unknown
-            let visitor =
-                do
-                    inline visit-id ()
-                        visit-id self (readop) ctx...
-                    inline visit-input ()
-                        visit-input self (bitcast (readop) Input) ctx...
-                    inline visit-output ()
-                        visit-output self (bitcast (readop) Output) ctx...
-                    inline visit-i32 ()
-                        visit-i32 self ((readop) as i32) ctx...
-                    inline visit-f32 ()
-                        visit-f32 self (bitcast (readop) f32) ctx...
-                    inline visit-bool ()
-                        visit-bool self (? ((readop) != 0) true false) ctx...
-                    inline visit-string ()
-                        local text : String
-                        label done
-                            while (idx < operand-count)
-                                let word = (readop)
-                                for c in (range 4:u32)
-                                    byte := (word >> (c * 8:u32)) as i8
-                                    if (byte == 0:i8)
-                                        merge done
-                                    'append text byte
-                        visit-string self text ctx...
-                    inline visit-unknown ()
-                        visit-unknown self (readop) ctx...
-                    inline oprange () (range idx operand-count)
-                    inline typeop () ('getOp self node.typeId)
-                    locals;
-            visit-node node.opCode
-                inline "default" ()
-                    for i in (visitor.oprange)
-                        visitor.visit-unknown;
-                \ visitor
-            for i in (visitor.oprange)
-                visitor.visit-unknown;
-
-    fn remap (self remap)
-        for id node in (enumerate self.nodes u32)
-            fn visit (self id remap)
-                id = remap @ id
-            visit self node.typeId remap
-            call
-                genvisitor
-                    visit-id = visit
-                \ self node remap
-        self.root = remap @ self.root
-        self.rnodes_valid = false
-        'clear self.select_cache
-
-    fn... topolist (self, root : Id)
-        let nodes = self.nodes
-        let count = ((countof nodes) as u32)
-        local visited : (Set Id)
-
-        # find roots
-        local queue : (Array Id)
-        'insert visited root
-        'append queue root
-        # tag all reachable nodes
-        for nodeid in queue
-            node := nodes @ nodeid
-            fn visit (self id queue visited)
-                if (id != NoType)
-                    if (not ('in? visited id))
-                        'append queue id
-                    'insert visited id
-            visit self (copy node.typeId) queue visited
-            call
-                genvisitor
-                    visit-id = visit
-                \ self node queue visited
-        queue
-
-    fn... reachable-indegrees (self)
-        let nodes = self.nodes
-        let count = ((countof nodes) as u32)
-        local visited : (Array i32)
-        'resize visited count 0
-
-        local queue : (Array Id)
-        do
-            let id = self.root
-            visited @ id = 1
-            'append queue id
-        # tag all reachable nodes
-        for nodeid in queue
-            node := nodes @ nodeid
-            fn visit (self id queue visited)
-                if (id != NoType)
-                    if ((visited @ id) == 0)
-                        'append queue id
-                    visited @ id += 1
-            visit self (copy node.typeId) queue visited
-            call
-                genvisitor
-                    visit-id = visit
-                \ self node queue visited
-        visited
-
-    fn cull (self)
-        let nodes = self.nodes
-        let count = ((countof nodes) as u32)
-        let visited = (reachable-indegrees self)
-
-        local newnodes : (Array RcNode)
-        'append newnodes (RcNode Op.None NoType)
-        local remap : (Array u32)
-        'resize remap count 0:u32
-        local nextid = 1:u32
-        for oldid node in (enumerate nodes u32)
-            if (visited @ oldid)
-                newid := (copy nextid)
-                nextid += 1
-
-                remap @ oldid = newid
-                'append newnodes (copy node)
-
-        self.nodes = newnodes
-        'remap self remap
-
-    fn indegrees (self)
-        let nodes = self.nodes
-        let count = ((countof nodes) as u32)
-        local used : (Array u32)
-        'resize used count 0:u32
-
-        # build refcount
-        for id in (range 1:u32 count)
-            node := nodes @ id
-            fn visit (self id used)
-                if (id != NoType)
-                    used @ id += 1
-            visit self (copy node.typeId) used
-            call
-                genvisitor
-                    visit-id = visit
-                \ self node used
-
-        used
-
-    fn toposort (self)
-        let nodes = self.nodes
-        let count = ((countof nodes) as u32)
-
-        let noderange = (range 1:u32 count)
-
-        let used = (indegrees self)
-
-        local queue : (Array u32)
-        for id in noderange
-            if ((used @ id) == 0)
-                'append queue id
-        for nodeid in queue
-            fn visit (self id used queue)
-                if (id != NoType)
-                    used @ id -= 1
-                    if (used @ id == 0)
-                        'append queue id
-            node := nodes @ nodeid
-            visit self (copy node.typeId) used queue
-            call
-                genvisitor
-                    visit-id = visit
-                \ self node used queue
-
-        local newnodes : (Array RcNode)
-        'append newnodes (RcNode Op.None NoType)
-        local remap : (Array u32)
-        'resize remap count 0:u32
-        for newid oldid in (enumerate ('reverse queue) u32)
-            newid := newid + 1
-            remap @ oldid = newid
-            node := nodes @ oldid
-            'append newnodes (copy node)
-
-        self.nodes = newnodes
-        'remap self remap
-
-    fn... tolist
-    case (self, nodeId : Id)
-        returning list
-        local result = '()
-        inline append (...)
-            va-map
-                inline (s)
-                    result = (cons s result)
-                ...
-        node := self.nodes @ nodeId
-        append (Symbol (tostring node.opCode))
-        let recur = this-function
-        do
-            inline append (result ...)
-                va-map
-                    inline (s)
-                        result = (cons s result)
-                    ...
-            inline write-any (self v out)
-                append out v
-            inline write-enum (self v out)
-                append out (Symbol (tostring v))
-            vvv bind visit
-            genvisitor
-                visit-id =
-                    inline "write-id" (self v out)
-                        append out
-                            recur self v
-                visit-input = write-enum
-                visit-output = write-enum
-                visit-i32 = write-any
-                visit-f32 = write-any
-                visit-bool = write-any
-                visit-string =
-                    inline "write-string" (self v out)
-                        append out (v as string)
-                visit-unknown =
-                    inline "write-unknown" (self v out)
-                        static-if ((typeof v) == u32)
-                            append out " ?0x" (hex v)
-                        else
-                            append out " ?" (repr v)
-            visit self node result
-        'reverse result
-    case (self)
-        this-function self (copy self.root)
-
-    fn... tostring
-    case (self, nodeId : Id, result : (mutable &String))
-        fn outidstr (id)
-            if (id == 0) "none"
-            else
-                .. "(" (tostring id) ")"
-        inline write (...)
-            va-map
-                inline (s)
-                    'append result s
-                ...
-        node := self.nodes @ nodeId
-        if (nodeId == self.root)
-            write "(" (idstr nodeId) ") "
-        else
-            write (idstr nodeId)
-            if (node.typeId != NoType)
-                write " : " (idstr node.typeId)
-            write " = "
-        write (repr node.opCode)
-        inline write (result ...)
-            va-map
-                inline (s)
-                    'append result s
-                ...
-        inline write-any (self v out)
-            write out " " (repr v)
-        vvv bind visit
-        genvisitor
-            visit-id =
-                inline "write-id" (self v out)
-                    write out " " (idstr v)
-            visit-input = write-any
-            visit-output = write-any
-            visit-i32 = write-any
-            visit-f32 = write-any
-            visit-bool = write-any
-            visit-string =
-                inline "write-string" (self v out)
-                    write out " " (repr (v as string))
-            visit-unknown =
-                inline "write-unknown" (self v out)
-                    static-if ((typeof v) == u32)
-                        write out " ?0x" (hex v)
-                    else
-                        write out " ?" (repr v)
-        visit self node result
-    case (self, nodeId : Id)
-        local result : String
-        this-function self nodeId result
-        result
-    case (self)
-        local result : String
-        inline write (...)
-            va-map
-                inline (s)
-                    'append result s
-                ...
-        for id in (range 1 (countof self.nodes))
-            this-function self (id as Id) result
-            write "\n"
-        result
-
-    fn distsort (self)
-        let nodes = self.nodes
-
-        fn visit-source-argument (self id nodeid dist maxdist)
-            if (id != NoId)
-                d := (max (dist @ nodeid) ((dist @ id) + 1))
-                dist @ nodeid = d
-                maxdist = (max maxdist d)
-            ;
-
-        local dist : (Array i32)
-        'resize dist (countof nodes) 0
-        local maxdist = 0
-
-        for id in (range 1:u32 (countof nodes))
-            node := nodes @ id
-            # compute distance from sources
-            let visitctx... = id dist maxdist
-            visit-source-argument self (copy node.typeId) visitctx...
-            call
-                genvisitor
-                    visit-id = visit-source-argument
-                \ self node visitctx...
-
-        local rows : (Array (Array Id))
-        'resize rows (maxdist + 1)
-
-        for id in (range 1:u32 (countof nodes))
-            'append (rows @ (dist @ id)) id
-
-        local newnodes : (Array RcNode)
-        'append newnodes (RcNode Op.None NoType)
-        local remap : (Array u32)
-        'resize remap (countof nodes) 0:u32
-
-        for row in rows
-            'sort row
-                fn (id self)
-                    node := self.nodes @ id
-                    tupleof
-                        node.opCode as integer
-                        node.typeId
-                \ self
-            for oldid in row
-                newid := (countof newnodes) as Id
-                remap @ oldid = newid
-                'append newnodes (copy (nodes @ oldid))
-
-        self.nodes = newnodes
-        'remap self remap
-
-    fn isbool? (self id)
-        ('getOp self ('getType self id)) == Op.TypeBool
-
-    fn isconstant? (self id)
-        va-switch-case OpDefs Op 'constant? ('getOp self id)
-            inline (cls) false
-
-    fn isundef? (self id)
-        ('getOp self id) == Op.Undefined
-
-    fn isthen? (self id)
-        and (('getOp self id) == Op.If)
-            or
-                isundef? self ('getArg self id 1)
-                isundef? self ('getArg self id 2)
-
-    fn isif? (self id)
-        ('getOp self id) == Op.If
-
-    fn unthen (self id)
-        returning Id Id
-        loop (cond id = ('constBool self true) id)
-            if (('getOp self id) == Op.If)
-                let tval fval =
-                    'getArg self id 1
-                    'getArg self id 2
-                if (isundef? self fval)
-                    repeat ('and self cond ('getArg self id 0)) tval
-                elseif (isundef? self tval)
-                    repeat ('and self cond ('not self ('getArg self id 0))) fval
-            break (copy cond) (copy id)
-
-    fn... getbool (self, id : Id)
-        """"returns bool as signed integer; zero = undefined
-        if ('isbool? self id)
-            if ('isconstant? self id)
-                ? (('getArg self id 0) != 0) 1 -1
-            else 0
-        else 0
-
-    fn... subst (self, id : Id, substmap : (Map Id Id))
-        """"recursive substitution
-        returning Id
-        # see if there is a direct replacement
-        for k v in substmap
-            assert (k != v)
-        try
-            assert (('get substmap id) != id)
-        else;
-        for id in ('reverse (topolist self id))
-            local found = false
-            # see if any change is necessary
-            node := self.nodes @ id
-            fn visit-argument (self id substmap found)
-                if (id != NoId)
-                    if ('in? substmap id)
-                        found = true
-                        raise;
-                ;
-            let visitctx... = substmap found
-            try
-                visit-argument self node.typeId visitctx...
-                call
-                    genvisitor
-                        visit-id = visit-argument
-                    \ self node visitctx...
-            else;
-            if (not found)
-                continue;
-            # make the changes
-            local node = (copy ((self.nodes @ id) as Node))
-            fn visit-argument (self id substmap found)
-                if (id != NoId)
-                    try
-                        let newid = ('get substmap id)
-                        assert (id != newid)
-                        id = newid
-                    else;
-                ;
-            let visitctx... = substmap found
-            visit-argument self node.typeId visitctx...
-            call
-                genvisitor
-                    visit-id = visit-argument
-                \ self node visitctx...
-            let newid =
-                vvv copy
-                'nodeId self (deref node)
-            assert (id != newid)
-            # update select statements that have become constant
-            let newid =
-                if (('getOp self newid) == Op.If)
-                    let cond = ('getArg self newid 0)
-                    let b = ('getbool self cond)
-                    let tval = ('getArg self newid 1)
-                    let fval = ('getArg self newid 2)
-                    if (b != 0)
-                        if (b > 0) tval
-                        else fval
-                    elseif (tval == fval) tval
-                    elseif
-                        and
-                            ('getbool self fval) == -1
-                            ('getbool self tval) == 1
-                        cond
-                    else newid
-                else newid
-            if (id != newid)
-                'set substmap id newid
-        try (copy ('get substmap id))
-        else (copy id)
-
-'define-symbols Module
-    if =
-        fn... "if" (self, cond : Id, tvalue : Id, fvalue : Id)
-            'nodeId self
-                Node Op.If ('getType self tvalue) cond tvalue fvalue
-
-    merge =
-        fn... "merge" (self, value1 : Id, value2 : Id)
-            'nodeId self
-                Node Op.Merge ('voidType self) value1 value2
-
-    bind =
-        fn... "bind" (self, target : Id, source : Id)
-            let id =
-                'nodeId self
-                    Node Op.Bind ('voidType self) target source
-            self.root =
-                do
-                    if (self.root == NoId) id
-                    else
-                        'body self (copy self.root) id
-
-    body =
-        fn... "body" (self, value1 : Id, value2 : Id)
-            'nodeId self
-                Node Op.Body ('getType self value1) value1 value2
-
-    then =
-        fn... "then" (self, cond : Id, value : Id)
-            'if self cond value ('undef self ('getType self value))
-
-    undef =
-        fn... "undef" (self, typeId : Id)
-            'nodeId self
-                Node Op.Undefined typeId
-
-    else =
-        fn... "else" (self, cond : Id, value : Id)
-            'if self cond ('undef self ('getType self value)) value
-
-    or =
-        fn... "or" (self, value1 : Id, value2 : Id)
-            'if self value1 value1 value2
-
-    and =
-        fn... "and" (self, value1 : Id, value2 : Id)
-            'if self value1 value2 value1
-
-    not =
-        fn... "not" (self, _value : Id)
-            'if self _value ('constBool self false) ('constBool self true)
-
-    xor =
-        fn... "xor" (self, value1 : Id, value2 : Id)
-            'if self value1
-                'not self value2
-                value2
-
-################################################################################
-
-type+ Module
-    fn evaluate (self)
-
-        fn... visit (self, ctx : RcContext, id : Id)
-            returning Id
-            raising Error
-            viewing ctx
-            let visit = this-function
-            try
-                return (copy ('get ctx id))
-            else;
-            vvv bind id2
-            switch ('getOp self id)
-            case Op.If
-                let _cond _tval _fval = ('getArgs self id 0 1 2)
-                cond := (visit self ctx _cond)
-                if ('isundef? self cond)
-                    cond
-                #elseif ('isconstant? self cond)
-                    let b = ('getbool self cond)
-                    if (b > 0)
-                elseif ('isif? self cond)
-                    # if(if(a,b,c),d,e) -> if(a,if(b,d,e),if(c,d,e))
-                    let cc ct cf = ('getArgs self cond 0 1 2)
-                    'if self cc
-                        'if self ct _tval _fval
-                        'if self cf _tval _fval
-                else
-                    #(replace (f a b) x y) -> (f (replace a x y) (replace b x y))
-                    #define tval
-                        subctx := (RcContext.subctx ctx)
-                        'set subctx cond ('constBool self true)
-                        visit self subctx _tval
-                    #define fval
-                        subctx := (RcContext.subctx ctx)
-                        'set subctx cond ('constBool self false)
-                        visit self subctx _fval
-                    #'set ctx _tval tval
-                    #'set ctx _fval fval
-                    'if self cond tval fval
-            case Op.Bind
-                let target source = ('getArgs self id 0 1)
-                if ('isundef? self source)
-                    'undef self ('voidType self)
-                elseif (('getOp self source) == Op.If)
-                    let c t f = ('getArgs self source 0 1 2)
-                    'if self c
-                        'bind self target t
-                        'bind self target f
-                else
-                    'nodeId self
-                        Node Op.Bind ('voidType self) target source
-            #case Op.Equal
-                let lhs rhs = ('getArgs self id 0 1)
-                lhs := (visit self ctx lhs)
-                rhs := (visit self ctx rhs)
-                if ('isthen? self lhs)
-                    let lc lt lf = ('getArgs self lhs 0 1 2)
-                    'if self lc
-                        if ('isundef? self lt) lt
-                        else ('equal self lt rhs)
-                        if ('isundef? self lf) lf
-                        else ('equal self lf rhs)
-                elseif ('isthen? self rhs)
-                    let rc rt rf = ('getArgs self rhs 0 1 2)
-                    'if self rc
-                        if ('isundef? self rt) rt
-                        else ('equal self lhs rt)
-                        if ('isundef? self rf) rf
-                        else ('equal self lhs rf)
-                else
-                    'equal self lhs rhs
-            default
-                local node =
-                    copy ((self.nodes @ id) as Node)
-                inline visit-arg (self id ctx)
-                    id = (visit self ctx (copy id))
-                    ;
-                let visitctx... = ctx
-                visit-arg self node.typeId visitctx...
-                call
-                    Module.genvisitor
-                        visit-id = visit-arg
-                    \ self node visitctx...
-                'nodeId self (deref node)
-            'set ctx id id2
-            id2
-
-        local ctx : RcContext
-        local
-        'set ctx 0:u32 0:u32
-        self.root =
-            visit self ctx (copy self.root)
-        ;
-
-################################################################################
-
-static-if main-module?
-    local module : Module
-    do
-        from (methodsof module) let integerType realType arrayType stringType
-            \ getType vectorType intToReal state constFloat fadd fmul fdiv sin cos
-            \ constComposite compositeInsert compositeConstruct constBool constString
-            \ parameter parameters function tupleType else bind then merge
-            \ equal input load output constInt and or not xor if
-
-        let string =
-            stringType;
-        let inttype =
-            integerType 32 true
-        let readline =
-            input string Input.Readline
-        let setup =
-            input Input.Setup
-        let stdout =
-            output string Output.Stdout
-        let exit =
-            output inttype Output.Exit
-        let prompt =
-            output string Output.Prompt
-
-        let exit? =
-            equal (constString "\n") readline
-
-        bind exit
-            then exit? (constInt inttype 0)
-
-        bind prompt
-            then (merge setup (not exit?)) (constString "> ")
-
-        bind stdout
-            merge
-                then exit? (constString "exiting...\n")
-                else exit? readline
-            #if exit? (constString "exiting...\n") readline
-
-    #'toposort module
-    #'catsort module
-
-    print
-        'tostring module
-    print
-        'serialize
-            list
-                'tolist module
-    print;
-
-    'evaluate module
-    'cull module
-    #'toposort module
-    #'distsort module
-    print
-        'tostring module
-    print
-        'serialize
-            list
-                'tolist module
-
-
-
-;

          
M testing/toposort.sc +51 -40
@@ 3,43 3,51 @@ using import Set
 using import Array
 using import Rc
 
-inline toposort (edgef visitf vertices)
-    # vertex index, edge index
-    let vinit vvalid vat vnext = ((vertices as Generator))
-    let first = (vat (vinit))
-    let ET = (typeof first)
+inline topowalker (edgef visitf)
+    fn (vertices ctx...)
+        """"call `visitf` for each vertex in generator `vertices` in topological
+            order. `edgef` must return a generator for each provided vertex index,
+            which provides vertex indices of incoming edges. The generators must
+            be of same iterator type.
 
-    local visited : (Set ET)
-    let init valid at next = (((edgef first) as Generator))
-    local stack : (Array (tuple ET (va-map typeof (init))))
+            vertex indices may be sparse and must be of type `usize`. `vertices`
+            may only contain a subset of indices in the graph.
+        let vinit vvalid vat vnext = ((vertices as Generator))
+        let it... = (vinit)
+        if (not (vvalid it...))
+            return;
+        let first = (vat it...)
+        let it... = (vnext it...)
+        let init valid at next = (((edgef first ctx...) as Generator))
+        local stack : (Array (tuple usize (va-map typeof (init))))
+        local visited : (Set usize)
 
-    for vx in vertices
-        if (not (vx in visited))
-            'insert visited (copy vx)
-            'append stack (tupleof (copy vx) ((((edgef vx) as Generator))))
-            while (not (empty? stack))
-                let v it... = (unpack ('last stack))
-                let init valid at next = (((edgef v) as Generator))
-                'pop stack
-                if (valid it...)
-                    #print ">" v it...
-                    let vx = (at it...)
-                    'append stack (tupleof (copy v) (va-map copy (next it...)))
-                    if (not (vx in visited))
-                        'insert visited (copy vx)
-                        'append stack (tupleof (copy vx)
-                            ((((edgef vx) as Generator))))
-                else
-                    visitf v
-                    ;
-
-type+ (Array i32)
-    inline __hash (self)
-        fold (h = (hash 0)) for k in self
-            hash h k
+        for vx in vertices
+            vx as:= usize
+            if (not (vx in visited))
+                'insert visited vx
+                'append stack (tupleof vx ((((edgef vx ctx...) as Generator))))
+                while (not (empty? stack))
+                    let v it... = (unpack ('last stack))
+                    let init valid at next = (((edgef v) as Generator))
+                    if (valid it...)
+                        let vx = (at it...)
+                        vx as:= usize
+                        let nextit... = (next it...)
+                        va-map
+                            inline (i)
+                                (va@ i it...) = (va@ i nextit...)
+                            va-range (va-countof it...)
+                        if (not (vx in visited))
+                            'insert visited vx
+                            'append stack
+                                tupleof vx ((((edgef vx ctx...) as Generator)))
+                    else
+                        'pop stack
+                        visitf v ctx...
+                        ;
 
 global arr : (Array (Rc (Array i32)))
-global indices : (Array i32)
 fn addnode (arr edges...)
     local edges : (Array i32)
     va-map

          
@@ 47,7 55,6 @@ fn addnode (arr edges...)
             'append edges i
         edges...
     'append arr (Rc.wrap (deref edges))
-    'append indices ((countof indices) as i32)
 inline addnode (edges...)
     addnode arr edges...
 

          
@@ 65,9 72,13 @@ addnode; # 10
 addnode 12 # 11
 addnode; # 12
 
-toposort
-    inline (vertex)
-        ((arr @ vertex) as Generator)
-    inline (vertex)
-        print vertex
-    indices
+
+local sinks = (arrayof usize 0:usize)
+let walk =
+    topowalker
+        inline (vertex)
+            ((arr @ vertex) as Generator)
+        inline (vertex)
+            print vertex
+walk sinks
+