15b2e2cf48aa — Leonard Ritter 19 days ago
* removed `any`/`all`
* added `defined?` form
M lib/tukan/uvm.sc +8 -19
@@ 1089,7 1089,7 @@ type+ Atom
                                             'set t key value
                                     default;
                         key := (recur elem)
-                        'append t key
+                        'set-index t i key
             return (t as Atom)
         case string
             return (value as string as Atom)

          
@@ 1380,8 1380,8 @@ sugar uquote (expr...)
 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 tof32 floor sqrt fold do cell sin cos map kindof
+            \ not dump totext .. cond setmeta getmeta macro eval maptext
+            \ tou32 tof32 floor sqrt fold do cell sin cos map kindof defined?
         sym := (Atom (name as Symbol))
         code := ('hashbits sym)
         _

          
@@ 1653,29 1653,15 @@ struct CachedEval
                 # (do (let k v) ... expr... (: k v))
                 case builtins.do
                     return (eval-do self env args 1)
-                # (all first then)
-                case builtins.all
-                    let a = (ueval env ('get-index args 1))
-                    let b = ('get-index args 2)
-                    return
-                        if ('none? a) a
-                        else (ueval env b)
-                # (any try else)
-                case builtins.any
-                    let a = (ueval env ('get-index args 1))
-                    let b = ('get-index args 2)
-                    return
-                        if ('none? a) (ueval env b)
-                        else a
                 # (fn (param ...) expr)
                 case builtins.fn
                     let expr = (rewrite-fn-body expr)
                     let args = (expr as Cell)
-                    let reduced_env = ('capture-env self env ('get args 2) (Cell))
+                    #let env = ('capture-env self env ('get args 2) (Cell))
                     return
                         Atom
                             'set-meta
-                                Cell.new reduced_env (copy expr)
+                                Cell.new (copy env) (copy expr)
                                 copy mt_closure
                 # (macro (param ...) expr)
                 case builtins.macro

          
@@ 1698,6 1684,9 @@ struct CachedEval
                         if (not ('none? cond))
                             errormsg "condition must be bool, but is" ('tostring cond)
                         return (Atom)
+                case builtins.defined?
+                    let cond = (ueval env ('get-index args 1))
+                    return (Atom (not ('none? cond)))
                 default;
             case Atom.Kind.Cell
                 let headtable = (head as Cell)

          
M testing/test_audio.tuk +2 -1
@@ 1,4 1,5 @@ 
-let t (any state 0)
+let t
+    cond (defined? state) state 0
 = state
     + t samplecount
 = sound

          
M testing/test_compiler.tuk +22 -85
@@ 19,97 19,35 @@ let source
     quote
         do
             let exit?
-                == "\n" readline
+                cond (defined? readline)
+                    == "\n" readline
+                    false
             let state
-                any
-                    state
+                cond (defined? state) state
                     do
                         : meta
                             cell
                                 : class "state"
                         = index 0
-            cond (any exit? false)
+            cond exit?
                 do
                     = exit 0
                     = stdout "exiting...\n"
                     = state state
                 do
                     let state
-                        any
-                            all readline
-                                set state 'index (+ (get state 'index) 1)
+                        cond (defined? 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"
+                        cond (defined? break)
+                            "enter empty line to exit\n"
                             readline
                     = state state
 
-
-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
-
 # call-continuation engine
 fn cc (ftable f args)
     fn final (_ args)

          
@@ 119,7 57,8 @@ fn cc (ftable f args)
             65536
             fn (self i)
                 let@ f fret args self
-                let f (any (get ftable f) f)
+                let fval (get ftable f)
+                let f (cond (defined? fval) fval f)
                 f fret args
     get self 2
 let: order

          
@@ 129,31 68,30 @@ let: order
                 fn (ret nodeit)
                     let@ self node i nodeit
                     let child (get node i)
-                    any
-                        all child
-                            cell 'visit
-                                fn (_ self)
-                                    cell 'visit-child ret
-                                        cell self node (+ i 1)
-                                cell self child
-                        cell ret false self
+                    cond (defined? child)
+                        cell 'visit
+                            fn (_ self)
+                                cell 'visit-child ret
+                                    cell self node (+ i 1)
+                            cell self child
+                        cell ret none self
             = visit
                 fn (ret args)
                     let@ self node args
                     fn post (_ self)
-                        cell ret false
+                        cell ret none
                             set self 'order
                                 append (get self 'order) node
                     let visited (get self 'visited)
-                    cond (any (get visited node) false)
-                        cell ret false self
+                    cond (defined? (get visited node))
+                        cell ret none self
                         do
                             let visited (set visited node true)
                             let self (set self 'visited visited)
                             cond (== (kindof node) 'cell)
                                 cell 'visit-child post
                                     cell self node 0
-                                post false self
+                                post none self
         'visit
         cell
             do

          
@@ 161,7 99,6 @@ let: order
                 = visited (cell)
             quote (a b (c d) d e (c d) f)
 dump order # prints (a b c d (c d) e f (a b (c d) d e (c d) f))
-
 #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)

          
M testing/test_echo.tuk +9 -9
@@ 1,29 1,29 @@ 
 let exit?
-    == "\n" readline
+    cond (defined? readline)
+        == "\n" readline
+        false
 let state
-    any
-        state
+    cond (defined? state) state
         do
             : meta
                 cell
                     : class "state"
             = index 0
-cond (any exit? false)
+cond exit?
     do
         = exit 0
         = stdout "exiting...\n"
         = state state
     do
         let state
-            any
-                all readline
-                    set state 'index (+ (get state 'index) 1)
+            cond (defined? 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"
+            cond (defined? break)
+                "enter empty line to exit\n"
                 readline
         = state state

          
M testing/test_fold.tuk +4 -0
@@ 1,3 1,7 @@ 
+macro any (a b)
+    cell 'cond (cell 'defined? a) a b
+macro all (a b)
+    cell 'cond (cell 'defined? a) b a
 dump
     do
         # fibonacci, head recursive - this one is illegal

          
M testing/test_native.tuk +2 -2
@@ 37,5 37,5 @@ let program
                 for y in (range h)
                     for x in (range w)
                         ptr @ (y * w + x) = 0xff0000ff as u32
-= sound "\x00\x00\x00\x00\x00\x00\x00\x00"
-= native-program (all setup program)
+= sound '((0 0))
+= native-program (cond (defined? setup) program)

          
M testing/topowalk.tuk +4 -0
@@ 1,3 1,7 @@ 
+macro any (a b)
+    cell 'cond (cell 'defined? a) a b
+macro all (a b)
+    cell 'cond (cell 'defined? a) b a
 let countof nextindex
 fn empty? (c)
     == (nextindex c) 0