ea4af1152505 — Leonard Ritter 24 days ago
* implemented toposorter in tukan
3 files changed, 118 insertions(+), 71 deletions(-)

M lib/tukan/uvm.sc
M testing/test_compiler.tuk
M testing/test_native.tuk
M lib/tukan/uvm.sc +31 -15
@@ 1373,7 1373,7 @@ let builtins global-env =
     fold (scope env = (Scope) (Cell)) for name in
         sugar-quote + - * / // % & | ^ fn quote set get nextindex < <= > >= == !=
             \ not all any dump totext .. cond setmeta getmeta macro eval maptext
-            \ tou32 floor sqrt fold do cell sin cos map
+            \ tou32 floor sqrt fold do cell sin cos map kindof
         sym := (Atom (name as Symbol))
         code := ('hashbits sym)
         _

          
@@ 1924,6 1924,19 @@ struct CachedEval
                         (Atom)
                 # (countof table)
                 case builtins.nextindex (eval-countof)
+                case builtins.kindof
+                    let value = ('get-index args 0)
+                    Atom
+                        switch ('kind value)
+                        case Atom.Kind.None 'none
+                        case Atom.Kind.False 'bool
+                        case Atom.Kind.True 'bool
+                        case Atom.Kind.Number 'number
+                        case Atom.Kind.Blob 'blob
+                        case Atom.Kind.Text 'text
+                        case Atom.Kind.Symbol 'symbol
+                        case Atom.Kind.Cell 'cell
+                        default 'unknown
                 case builtins.cell
                     return (Atom args)
                 # (fold limit init f) (f value index) -> 2-cell

          
@@ 1937,17 1950,14 @@ struct CachedEval
                             if (i == limit)
                                 break state
                             else
-                                let expr = (Cell.new (copy func)
-                                    (Cell.new (copy tok-quote) state)
-                                    (Atom i))
-                                let result = (ueval env expr)
+                                let result =
+                                    ueval
+                                        uapply-env func 
+                                            Cell.new (copy state) (Atom i)
+                                            0
                                 repeat (i + 1)
-                                    if (('kind result) == Atom.Kind.Cell)
-                                        let result = (result as Cell)
-                                        let nextstate = ('get-index result 0)
-                                        if ('none? nextstate)
-                                            break ('get-index result 1)
-                                        else nextstate
+                                    if ('none? result)
+                                        break state
                                     else result
                     else
                         return (Atom)

          
@@ 1959,9 1969,12 @@ struct CachedEval
                         let sz = (limit as Number as integer)
                         local cell = (Cell)
                         for i in (range sz)
-                            let expr = (Cell.new (copy func) (Atom i))
                             cell =
-                                'set-index cell i (ueval env expr)
+                                'set-index cell i
+                                    ueval
+                                        uapply-env func 
+                                            Cell.new (Atom i)
+                                            0
                         return (Atom cell)
                     else
                         if (not (any-none? limit))

          
@@ 1975,8 1988,11 @@ struct CachedEval
                         let sz = (size as Number as integer)
                         local str : String
                         for i in (range sz)
-                            let expr = (Cell.new (copy func) (Atom i))
-                            let result = (ueval env expr)
+                            let result =
+                                ueval
+                                    uapply-env func 
+                                        Cell.new (Atom i)
+                                        0
                             if (('kind result) == Atom.Kind.Text)
                                 'append str (result as String)
                         return (Atom str)

          
M testing/test_compiler.tuk +87 -24
@@ 31,27 31,90 @@ let source
                             all break "enter empty line to exit\n"
                             readline
                     = state state
-let program
-    quote
-        fn (ins outs)
-            let required-flags =
-                | InputFlags.ScreenSize InputFlags.Iteration
-            if ((ins.flags & required-flags) != required-flags)
-                return;
-            let ssz = ins.screen-size
-            let w h = (unpack ssz)
-            let w = (w // 1)
-            let h = (h // 1)
-            outs.flags = OutputFlags.Screen
-            'resize outs.screen (w * h * 4)
-            let s = outs.screen
-            let ptr = ((& (s @ 0)) as (mutable @u32))
-            if ((ins.iteration & 1) == 0)
-                for y in (range h)
-                    for x in (range w)
-                        ptr @ (y * w + x) = 0xffff0000 as u32
-            else
-                for y in (range h)
-                    for x in (range w)
-                        ptr @ (y * w + x) = 0xff0000ff as u32
-= native-program (all setup program)
+let countof nextindex
+fn empty? (c)
+    == (nextindex c) 0
+fn lastindex (c)
+    - (nextindex c) 1
+fn last (c)
+    let idx (lastindex c)
+    get c idx
+fn pop (c)
+    let idx (lastindex c)
+    set c idx
+fn swap (c i1 i2)
+    set (set c i1 (get c i2)) i2 (get c i1)
+fn append (c value)
+    set c (nextindex c) value
+fn topowalk (user root edgef visitf)
+    let STATE_UNSEEN 'unseen
+    let STATE_QUEUED 'queued
+    let STATE_COMPLETE 'complete
+    fn get-state (self v)
+        any (get (get self 'state) v) STATE_UNSEEN
+    fn set-state (self v state)
+        set self 'state
+            set (get self 'state) v state
+    fn get-stacksize (self)
+        countof (get self 'stack)
+    fn push-vertex (self v)
+        any
+            all v
+                do
+                    let vs (get-state self v)
+                    cond (== vs 'unseen)
+                        set self 'stack
+                            append (get self 'stack) v
+            self
+    let self
+        fold
+            do
+                = stack (cell root)
+                = state (cell)
+                = user user
+            65536
+            fn (self i)
+                let stack (get self 'stack)
+                let done? (empty? stack)
+                cond (not done?)
+                    do
+                        let v (last stack)
+                        let vs (get-state self v)
+                        cond (== vs STATE_UNSEEN) # not yet seen
+                            do
+                                let self (set-state self v STATE_QUEUED)
+                                let stackp1 (get-stacksize self)
+                                let self (edgef self v push-vertex)
+                                let stackp2 (get-stacksize self)
+                                let stackp1p2 (+ stackp1 stackp2)
+                                let m (// stackp1p2 2)
+                                let rend (- stackp1p2 1)
+                                let stack (get self 'stack)
+                                # swap stack order
+                                set self 'stack
+                                    fold stack (- m stackp1)
+                                        fn (stack i)
+                                            let i (+ i stackp1)
+                                            swap stack i (- rend i)
+                            do
+                                let self
+                                    cond (== vs STATE_QUEUED) # children previously queued
+                                        do
+                                            let self (set-state self v STATE_COMPLETE)
+                                            set self 'user
+                                                visitf (get self 'user) v
+                                        self
+                                set self 'stack (pop stack)
+    get self 'user
+dump # prints (a b c d (c d) e f (a b (c d) d e (c d) f))
+    topowalk (cell)
+        quote (a b (c d) d e (c d) f)
+        fn (self v push-vertex)
+            cond (== (kindof v) 'cell)
+                fold self (countof v)
+                    fn (self i)
+                        push-vertex self (get v i)
+                self
+        append
+= stdout
+    "nothing to do.\n"

          
M testing/test_native.tuk +0 -32
@@ 1,36 1,4 @@ 
 #!/usr/bin/env -S scopes tuk_interpreter.sc
-let source
-    quote
-        do
-            let exit?
-                == "\n" readline
-            let state
-                any
-                    state
-                    do
-                        : meta
-                            cell
-                                : class "state"
-                        = index 0
-            cond (any exit? false)
-                do
-                    = exit 0
-                    = stdout "exiting...\n"
-                    = state state
-                do
-                    let state
-                        any
-                            all readline
-                                set state 'index (+ (get state 'index) 1)
-                            state
-                    = block-break true
-                    = prompt
-                        .. (totext (get state 'index)) "> "
-                    = stdout
-                        any
-                            all break "enter empty line to exit\n"
-                            readline
-                    = state state
 let program
     quote
         fn (ins outs)