6b7525fa56f8 — Leonard Ritter 26 days ago
* support for launching native programs
4 files changed, 628 insertions(+), 355 deletions(-)

M lib/tukan/uvm.sc
A => testing/test_compiler.tuk
M testing/test_screen.tuk
M testing/tuk_interpreter.sc
M lib/tukan/uvm.sc +430 -323
@@ 468,6 468,27 @@ struct Cell
             recur table.ivalues table.depth 0:u64 ...
 
     @@ memo
+    inline gen-each-index-reverse (f)
+        fn process (table ...)
+            fn recur (node depth index ...)
+                returning void
+                dispatch node
+                case CellLimb (limb)
+                    let maxindex = (depth-maxindex depth)
+                    let slot-capacity = ((maxindex >> IndexBits) + 1)
+                    for i in (rrange ArrayCellCount)
+                        let index = (index + slot-capacity * i)
+                        this-function
+                            limb.cells @ i
+                            depth - 1
+                            index
+                            ...
+                case None ()
+                default
+                    f index node ...
+            recur table.ivalues table.depth 0:u64 ...
+
+    @@ memo
     inline gen-each-pair (f)
         fn process (table ...)
             fn recur (key value ...)

          
@@ 502,6 523,7 @@ struct Cell
                 case CellLimb (vlimb)
                     let kl = klimb.cells
                     let vl = vlimb.cells
+                    print (bin klimb.mask) (bin vlimb.mask)
                     for i in (range ArrayCellCount)
                         let k v =
                             kl @ i

          
@@ 700,8 722,8 @@ struct Cell
                 local newvl = (copy (valuelimb as CellLimb))
                 let subkeylimb subvaluelimb =
                     this-function (newkl.cells @ mask) (newvl.cells @ mask) key value (depth + 1)
-                let skkind = (copy ('kind subkeylimb))
                 flag := 1:u64 << mask
+                let oldmask = (copy newkl.mask)
                 if ('none? subkeylimb)
                     flag := (~ flag)
                     newkl.mask &= flag

          
@@ 712,14 734,14 @@ struct Cell
                 newkl.cells @ mask = subkeylimb
                 newvl.cells @ mask = subvaluelimb
                 assert (newkl.mask != 0)
-                if (((bitcount newkl.mask) == 1) & (skkind != Atom.Kind.CellLimb))
+                if ((bitcount newkl.mask) == 1)
                     let index = (findmsb newkl.mask)
                     assert (index < ArrayCellCount)
                     let node = (newkl.cells @ index)
                     assert (not ('none? node))
-                    return (copy node) (copy (newvl.cells @ index))
-                else
-                    return (Atom newkl) (Atom newvl)
+                    if (('kind node) != Atom.Kind.CellLimb) # can not unsplit collisions
+                        return (copy node) (copy (newvl.cells @ index))
+                return (Atom newkl) (Atom newvl)
             elseif (('none? keylimb) or (keylimb == key)) # empty or same key
                 if ('none? value) # clear
                     return (Atom) (Atom)

          
@@ 993,6 1015,40 @@ type+ Atom
                 assert ((kind self) == Kind.None)
                 none
 
+    fn... to-value (self)
+        let to-value = this-function
+        dispatch self
+        case None ()
+            return `none
+        case False ()
+            return `false
+        case True () "true"
+            return `true
+        case Number (num)
+            if (('floor num) == num)
+                return `[(num as i64)]
+            else
+                return `[(num as f64)]
+        case Text (str)
+            return `[(str as string)]
+        case Blob (str)
+            return `[(str as string)]
+        case Symbol (str)
+            return `[(Symbol (str as string))]
+        case Cell (table)
+            local result = '()
+            call
+                Cell.gen-each-index-reverse
+                    inline (index node result)
+                        result =
+                            cons (to-value node) result
+                \ table result
+            return `result
+        default
+            let s =
+                .. "cannot translate " (repr self)
+            `s
+
     fn... from-value (value : Value)
         returning (uniqueof Atom -1)
         let recur = this-function

          
@@ 1308,7 1364,7 @@ let builtins global-env =
     fold (scope env = (Scope) (Cell)) for name in
         sugar-quote + - * / // % & | ^ let fn quote set get nextindex _ < <= > >= == !=
             \ not all any dump totext .. cond setmeta getmeta macro eval maptext
-            \ tou32 floor
+            \ tou32 floor sqrt
         sym := (Atom (name as Symbol))
         code := ('hashbits sym)
         _

          
@@ 1335,9 1391,8 @@ run-stage;
 fn global-environment ()
     global-env
 
-fn... uapply-env (env : Atom, closure : Atom, args : Atom, argoffset : i32)
+fn... uapply-env (closure : Atom, args : Atom, argoffset : i32)
     let headtable = (closure as Cell)
-    let origenv = env
     local env = (copy (('get-index headtable 0) as Cell))
     let f = ('get-index headtable 1)
     let ftable = (f as Cell)

          
@@ 1377,348 1432,400 @@ fn... uapply-env (env : Atom, closure : 
     eachf tparams env used_keys (args as Cell) argoffset
     return env ('get-index ftable 2)
 
-fn... ueval (env : Atom, expr : Atom)
-    let ueval = this-function
+struct CachedEval
+    cache : (Map (tuple Atom Atom) Atom)
+    hits : usize
+    misses : usize
 
-    inline errormsg (args...)
-        print "in" ('tostring expr)
-        print "error:" args...
+    fn... eval (self, env : Atom, expr : Atom)
+        returning (uniqueof Atom -1)
+        #'uncached_eval self env expr
+        let key = (tupleof (view env) (view expr))
+        try
+            let result = (copy ('get self.cache key))
+            self.hits += 1
+            result
+        else
+            self.misses += 1
+            let value = ('uncached_eval self env expr)
+            'set self.cache (tupleof (copy env) (copy expr)) (copy value)
+            value
 
-    assert (('kind env) == Atom.Kind.Cell)
-    let envtable = (env as Cell)
-    switch ('kind expr)
-    case Atom.Kind.Symbol
-        return ('get envtable expr)
-    case Atom.Kind.Cell
-        if (not ('none? ('get-meta (expr as Cell))))
-            # don't evaluate cells with metatables
-            return (copy expr)
-        let head =
-            ueval env ('get-index (expr as Cell) 0)
-        switch ('kind head)
+    fn... capture-env (self, env : Atom, expr : Atom, target : Cell)
+        # reduces env to symbols used by expr
+        returning (uniqueof Cell -1)
+        switch ('kind expr)
         case Atom.Kind.Symbol
-            let args = (expr as Cell)
+            #report "setting" ('tostring expr)
+            return ('set target expr ('get (env as Cell) expr))
+        case Atom.Kind.Cell
+            local target = (copy target)
+            let expr = (expr as Cell)
+            call
+                Cell.gen-each-index
+                    inline (index node target env self)
+                        target = ('capture-env self env node target)
+                \ expr target env self
+            call
+                Cell.gen-each-pair
+                    inline (key value target env self)
+                        if (('kind key) != Atom.Kind.Symbol)
+                            target = ('capture-env self env key target)
+                        target = ('capture-env self env value target)
+                \ expr target env self
+            return (deref target)
+        default
+            copy target
+
+    fn... uncached_eval (self, env : Atom, expr : Atom)
+        inline ueval (env expr)
+            'eval self env expr
+
+        inline errormsg (args...)
+            print "in" ('tostring expr)
+            print "error:" args...
+
+        assert (('kind env) == Atom.Kind.Cell)
+        let envtable = (env as Cell)
+        switch ('kind expr)
+        case Atom.Kind.Symbol
+            return ('get envtable expr)
+        case Atom.Kind.Cell
+            if (not ('none? ('get-meta (expr as Cell))))
+                # don't evaluate cells with metatables
+                return (copy expr)
+            let head =
+                ueval env ('get-index (expr as Cell) 0)
+            switch ('kind head)
+            case Atom.Kind.Symbol
+                let args = (expr as Cell)
 
-            switch ('hashbits head)
-            # (let (: k v) ... expr)
-            case builtins.let
-                let f =
-                    Cell.gen-each-pair
-                        inline (k v origenv env)
-                            env =
-                                'set env (copy k)
-                                    ueval origenv (copy v)
-                            ;
-                local newenv = (copy (env as Cell))
-                f args env newenv
-                return (ueval newenv ('get args 1))
-            # (fn (param ...) expr)
-            case builtins.fn
-                return
-                    Atom
-                        'set-meta
-                            Cell.new (copy env) (copy expr)
-                            copy mt_closure
-            # (macro (param ...) expr)
-            case builtins.macro
-                return
-                    Atom
-                        'set-meta
-                            Cell.new (copy env) (copy expr)
-                            copy mt_macro
-            # (quote value)
-            case builtins.quote
-                return ('get-index args 1)
-            case builtins.cond
-                let cond = (ueval env ('get-index args 1))
-                switch ('kind cond)
-                case Atom.Kind.True
-                    return (ueval env ('get-index args 2))
-                case Atom.Kind.False
-                    return (ueval env ('get-index args 3))
-                default
-                    if (not ('none? cond))
-                        errormsg "condition must be bool, but is" ('tostring cond)
+                switch ('hashbits head)
+                # (let (: k v) ... expr)
+                case builtins.let
+                    let f =
+                        Cell.gen-each-pair
+                            inline (k v origenv env self)
+                                env =
+                                    'set env (copy k)
+                                        'eval self origenv (copy v)
+                                ;
+                    local newenv = (copy (env as Cell))
+                    f args env newenv self
+                    return (ueval newenv ('get args 1))
+                # (fn (param ...) expr)
+                case builtins.fn
+                    let reduced_env = ('capture-env self env ('get args 2) (Cell))
+                    return
+                        Atom
+                            'set-meta
+                                Cell.new reduced_env (copy expr)
+                                copy mt_closure
+                # (macro (param ...) expr)
+                case builtins.macro
+                    return
+                        Atom
+                            'set-meta
+                                Cell.new (copy env) (copy expr)
+                                copy mt_macro
+                # (quote value)
+                case builtins.quote
+                    return ('get-index args 1)
+                case builtins.cond
+                    let cond = (ueval env ('get-index args 1))
+                    switch ('kind cond)
+                    case Atom.Kind.True
+                        return (ueval env ('get-index args 2))
+                    case Atom.Kind.False
+                        return (ueval env ('get-index args 3))
+                    default
+                        if (not ('none? cond))
+                            errormsg "condition must be bool, but is" ('tostring cond)
+                        return (Atom)
+                default;
+            case Atom.Kind.Cell
+                let headtable = (head as Cell)
+                let mtable = ('get-meta headtable)
+                if (mtable == mt_macro)
+                    return (ueval env (ueval (uapply-env head expr 1)))
+            default;
+
+            # evaluate all table elements
+            let args =
+                do
+                    local args = (Cell)
+                    let table = (expr as Cell)
+                    call
+                        Cell.gen-each-index
+                            inline (index node result env self)
+                                if (index > 0)
+                                    let outval = ('eval self env node)
+                                    result =
+                                        'set-index result (index - 1) outval
+                        \ table args env self
+                    call
+                        Cell.gen-each-pair
+                            inline (key value result env self)
+                                let outk = ('eval self env key)
+                                let outv = ('eval self env value)
+                                result =
+                                    'set result
+                                        if (('kind key) == Atom.Kind.Symbol) (copy key)
+                                        else outk
+                                        outv
+                        \ table args env self
+                    deref args
+
+            switch ('kind head)
+            case Atom.Kind.Cell
+                let headtable = (head as Cell)
+                let mtable = ('get-meta headtable)
+                if (mtable == mt_closure)
+                    return (ueval (uapply-env head args 0))
+                else
+                    print "cannot apply table:" ('tostring expr)
                     return (Atom)
-            default;
-        case Atom.Kind.Cell
-            let headtable = (head as Cell)
-            let mtable = ('get-meta headtable)
-            if (mtable == mt_macro)
-                return (ueval env (ueval (uapply-env env head expr 1)))
-        default;
-
-        # evaluate all table elements
-        let args =
-            do
-                local args = (Cell)
+            case Atom.Kind.Symbol
                 let table = (expr as Cell)
-                call
-                    Cell.gen-each-index
-                        inline (index node result env)
-                            if (index > 0)
-                                let outval = (ueval env node)
-                                result =
-                                    'set-index result (index - 1) outval
-                    \ table args env
-                call
-                    Cell.gen-each-pair
-                        inline (key value result env)
-                            let outk = (ueval env key)
-                            let outv = (ueval env value)
-                            result =
-                                'set result
-                                    if (('kind key) == Atom.Kind.Symbol) (copy key)
-                                    else outk
-                                    outv
-                    \ table args env
-                deref args
-
-        switch ('kind head)
-        case Atom.Kind.Cell
-            let headtable = (head as Cell)
-            let mtable = ('get-meta headtable)
-            if (mtable == mt_closure)
-                return (ueval (uapply-env env head args 0))
-            else
-                print "cannot apply table:" ('tostring expr)
-                return (Atom)
-        case Atom.Kind.Symbol
-            let table = (expr as Cell)
 
-            #
-                fn verify-same (a b)
-                    let A B = ('kind a) ('kind b)
-                    if (A != B)
-                        print "same kind expected, but" A "!=" B
-                fn verify (val K)
-                    if (('kind val) != K)
-                        print K "expected, got" ('tostring val)
-                fn verify-bool (val)
-                    switch ('kind val)
-                    pass Atom.Kind.False
-                    pass Atom.Kind.True
-                    do;
-                    default
-                        print "boolean expected, got" ('tostring val)
-
-            inline kindstrs (x...)
-                va-map (inline (x) ('tostring x)) x...
-
-            inline any-kinds? (K x...)
-                va-lfold false
-                    inline (k v result)
-                        result | (('kind v) == K)
-                    x...
+                #
+                    fn verify-same (a b)
+                        let A B = ('kind a) ('kind b)
+                        if (A != B)
+                            print "same kind expected, but" A "!=" B
+                    fn verify (val K)
+                        if (('kind val) != K)
+                            print K "expected, got" ('tostring val)
+                    fn verify-bool (val)
+                        switch ('kind val)
+                        pass Atom.Kind.False
+                        pass Atom.Kind.True
+                        do;
+                        default
+                            print "boolean expected, got" ('tostring val)
 
-            inline any-none? (x...)
-                any-kinds? Atom.Kind.None x...
-
-            inline all-kinds? (K x...)
-                va-lfold true
-                    inline (k v result)
-                        result & (('kind v) == K)
-                    x...
+                inline kindstrs (x...)
+                    va-map (inline (x) ('tostring x)) x...
 
-            inline unop (f)
-                let a = ('get-index args 0)
-                if (all-kinds? Atom.Kind.Number a)
-                    return (Atom (f (a as Number)))
-                else
-                    if (not (any-none? a))
-                        errormsg "number expected, got " (kindstrs a)
-                    return (Atom)
+                inline any-kinds? (K x...)
+                    va-lfold false
+                        inline (k v result)
+                            result | (('kind v) == K)
+                        x...
 
-            inline binop (f)
-                let a = ('get-index args 0)
-                let b = ('get-index args 1)
-                if (all-kinds? Atom.Kind.Number a b)
-                    return (Atom (f (a as Number) (b as Number)))
-                else
-                    if (not (any-none? a b))
-                        errormsg "numbers expected, got " (kindstrs a b)
-                    return (Atom)
+                inline any-none? (x...)
+                    any-kinds? Atom.Kind.None x...
 
-            inline eval-eq ()
-                let a = ('get-index args 0)
-                let b = ('get-index args 1)
-                if (any-none? a b) (Atom)
-                else (Atom (a == b))
+                inline all-kinds? (K x...)
+                    va-lfold true
+                        inline (k v result)
+                            result & (('kind v) == K)
+                        x...
+
+                inline unop (f)
+                    let a = ('get-index args 0)
+                    if (all-kinds? Atom.Kind.Number a)
+                        return (Atom (f (a as Number)))
+                    else
+                        if (not (any-none? a))
+                            errormsg "number expected, got " (kindstrs a)
+                        return (Atom)
 
-            inline eval-neq ()
-                let a = ('get-index args 0)
-                let b = ('get-index args 1)
-                if (any-none? a b) (Atom)
-                else (Atom (a != b))
+                inline binop (f)
+                    let a = ('get-index args 0)
+                    let b = ('get-index args 1)
+                    if (all-kinds? Atom.Kind.Number a b)
+                        return (Atom (f (a as Number) (b as Number)))
+                    else
+                        if (not (any-none? a b))
+                            errormsg "numbers expected, got " (kindstrs a b)
+                        return (Atom)
 
-            inline eval-not ()
-                let x = ('get-index args 0)
-                switch ('kind x)
-                case Atom.Kind.None x
-                case Atom.Kind.False (Atom true)
-                case Atom.Kind.True (Atom false)
-                default
-                    errormsg "boolean expected, got " (kindstrs x)
-                    (Atom)
+                inline eval-eq ()
+                    let a = ('get-index args 0)
+                    let b = ('get-index args 1)
+                    if (any-none? a b) (Atom)
+                    else (Atom (a == b))
+
+                inline eval-neq ()
+                    let a = ('get-index args 0)
+                    let b = ('get-index args 1)
+                    if (any-none? a b) (Atom)
+                    else (Atom (a != b))
 
-            inline eval-set ()
-                let source = ('get-index args 0)
-                if (all-kinds? Atom.Kind.Cell source)
-                    let _source = source
-                    source as:= Cell
-                    let key = ('get-index args 1)
-                    let value = ('get-index args 2)
-                    if (any-none? key) _source
-                    else
-                        Atom ('set source key value)
-                else
-                    if (not (any-none? source))
-                        errormsg "cell expected, got " (kindstrs source)
-                    (Atom)
+                inline eval-not ()
+                    let x = ('get-index args 0)
+                    switch ('kind x)
+                    case Atom.Kind.None x
+                    case Atom.Kind.False (Atom true)
+                    case Atom.Kind.True (Atom false)
+                    default
+                        errormsg "boolean expected, got " (kindstrs x)
+                        (Atom)
 
-            inline eval-get ()
-                let source = ('get-index args 0)
-                if (all-kinds? Atom.Kind.Cell source)
-                    source as:= Cell
-                    let key = ('get-index args 1)
-                    if (any-kinds? Atom.Kind.None key) (Atom)
+                inline eval-set ()
+                    let source = ('get-index args 0)
+                    if (all-kinds? Atom.Kind.Cell source)
+                        let _source = source
+                        source as:= Cell
+                        let key = ('get-index args 1)
+                        let value = ('get-index args 2)
+                        if (any-none? key) _source
+                        else
+                            Atom ('set source key value)
                     else
-                        'get source key
-                else
-                    if (not (any-none? source))
-                        errormsg "cell expected, got " (kindstrs source)
-                    (Atom)
+                        if (not (any-none? source))
+                            errormsg "cell expected, got " (kindstrs source)
+                        (Atom)
 
-            inline eval-countof ()
-                let source = ('get-index args 0)
-                if (all-kinds? Atom.Kind.Cell source)
-                    source as:= Cell
-                    Atom ('next-index source)
-                else
-                    if (not (any-none? source))
-                        errormsg "cell expected, got " (kindstrs source)
-                    (Atom)
+                inline eval-get ()
+                    let source = ('get-index args 0)
+                    if (all-kinds? Atom.Kind.Cell source)
+                        source as:= Cell
+                        let key = ('get-index args 1)
+                        if (any-kinds? Atom.Kind.None key) (Atom)
+                        else
+                            'get source key
+                    else
+                        if (not (any-none? source))
+                            errormsg "cell expected, got " (kindstrs source)
+                        (Atom)
+
+                inline eval-countof ()
+                    let source = ('get-index args 0)
+                    if (all-kinds? Atom.Kind.Cell source)
+                        source as:= Cell
+                        Atom ('next-index source)
+                    else
+                        if (not (any-none? source))
+                            errormsg "cell expected, got " (kindstrs source)
+                        (Atom)
 
-            switch ('hashbits head)
-            case builtins.+ (binop +)
-            case builtins.- (binop -)
-            case builtins.* (binop *)
-            case builtins./ (binop /)
-            case builtins.// (binop //)
-            case builtins.% (binop %)
-            case builtins.& (binop &)
-            case builtins.| (binop |)
-            case builtins.^ (binop ^)
-            case builtins.floor (unop 'floor)
-            case builtins.< (binop <)
-            case builtins.<= (binop <=)
-            case builtins.> (binop >)
-            case builtins.>= (binop >=)
-            case builtins.== (eval-eq)
-            case builtins.!= (eval-neq)
-            case (getattr builtins '..)
-                let a = ('get-index args 0)
-                let b = ('get-index args 1)
-                if (all-kinds? Atom.Kind.Text a b)
-                    return (Atom (.. (a as String) (b as String)))
-                else
-                    if (not (any-none? a b))
-                        errormsg "texts expected, got " (kindstrs a b)
-                    return (Atom)
-            case builtins.eval
-                let expr = ('get-index args 0)
-                let subenv = ('get-index args 1)
-                let subenv =
-                    if ('none? subenv) (copy env)
-                    else subenv
-                ueval subenv expr
-            case builtins.all
-                let a = ('get-index args 0)
-                let b = ('get-index args 1)
-                if ('none? a) a
-                else b
-            case builtins.any
-                let a = ('get-index args 0)
-                let b = ('get-index args 1)
-                if ('none? a) b
-                else a
-            case builtins.dump
-                let x = ('get-index args 0)
-                #if (not ('none? x))
-                print ('tostring x) "<-" ('tostring expr)
-                x
-            case builtins.totext
-                let x = ('get-index args 0)
-                'totext x
-            case builtins.tou32
-                let x = ('get-index args 0)
-                if (all-kinds? Atom.Kind.Number x)
-                    local val = (x as Number as i32)
-                    Atom (String (&val as rawstring) 4)
-                else (Atom)
-            case builtins.not (eval-not)
-            # (set table key value)
-            case builtins.set (eval-set)
-            # (get table key)
-            case builtins.get (eval-get)
-            case builtins.setmeta
-                let source = ('get-index args 0)
-                let meta = ('get-index args 1)
-                if (all-kinds? Atom.Kind.Cell source meta)
-                    let _source = source
-                    source as:= Cell
-                    Atom ('set-meta source meta)
-                else
-                    if (not (any-none? source))
-                        errormsg "cell expected, got " (kindstrs source)
-                    elseif (not (any-none? meta))
-                        errormsg "meta cell expected, got " (kindstrs source)
-                    (Atom)
-            case builtins.getmeta
-                let source = ('get-index args 0)
-                if (all-kinds? Atom.Kind.Cell source)
-                    let _source = source
-                    source as:= Cell
-                    copy ('get-meta source)
-                else
-                    if (not (any-none? source))
-                        errormsg "cell expected, got " (kindstrs source)
-                    (Atom)
-            # (countof table)
-            case builtins.nextindex (eval-countof)
-            case builtins._
-                return (Atom args)
-            # (maptext size f)
-            case builtins.maptext
-                let size = ('get-index args 0)
-                let func = ('get-index args 1)
-                if (all-kinds? Atom.Kind.Number size)
-                    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)
-                        if (('kind result) == Atom.Kind.Text)
-                            'append str (result as String)
-                    return (Atom str)
-                else
-                    if (not (any-none? size))
-                        errormsg "number expected, got " (kindstrs size)
+                switch ('hashbits head)
+                case builtins.+ (binop +)
+                case builtins.- (binop -)
+                case builtins.* (binop *)
+                case builtins./ (binop /)
+                case builtins.// (binop //)
+                case builtins.% (binop %)
+                case builtins.& (binop &)
+                case builtins.| (binop |)
+                case builtins.^ (binop ^)
+                case builtins.floor (unop 'floor)
+                case builtins.sqrt (unop 'sqrt)
+                case builtins.< (binop <)
+                case builtins.<= (binop <=)
+                case builtins.> (binop >)
+                case builtins.>= (binop >=)
+                case builtins.== (eval-eq)
+                case builtins.!= (eval-neq)
+                case (getattr builtins '..)
+                    let a = ('get-index args 0)
+                    let b = ('get-index args 1)
+                    if (all-kinds? Atom.Kind.Text a b)
+                        return (Atom (.. (a as String) (b as String)))
+                    else
+                        if (not (any-none? a b))
+                            errormsg "texts expected, got " (kindstrs a b)
+                        return (Atom)
+                case builtins.eval
+                    let expr = ('get-index args 0)
+                    let subenv = ('get-index args 1)
+                    let subenv =
+                        if ('none? subenv) (copy env)
+                        else subenv
+                    ueval subenv expr
+                case builtins.all
+                    let a = ('get-index args 0)
+                    let b = ('get-index args 1)
+                    if ('none? a) a
+                    else b
+                case builtins.any
+                    let a = ('get-index args 0)
+                    let b = ('get-index args 1)
+                    if ('none? a) b
+                    else a
+                case builtins.dump
+                    let x = ('get-index args 0)
+                    #if (not ('none? x))
+                    print ('tostring x) "<-" ('tostring expr)
+                    x
+                case builtins.totext
+                    let x = ('get-index args 0)
+                    'totext x
+                case builtins.tou32
+                    let x = ('get-index args 0)
+                    if (all-kinds? Atom.Kind.Number x)
+                        local val = (x as Number as i32)
+                        Atom (String (&val as rawstring) 4)
+                    else (Atom)
+                case builtins.not (eval-not)
+                # (set table key value)
+                case builtins.set (eval-set)
+                # (get table key)
+                case builtins.get (eval-get)
+                case builtins.setmeta
+                    let source = ('get-index args 0)
+                    let meta = ('get-index args 1)
+                    if (all-kinds? Atom.Kind.Cell source meta)
+                        let _source = source
+                        source as:= Cell
+                        Atom ('set-meta source meta)
+                    else
+                        if (not (any-none? source))
+                            errormsg "cell expected, got " (kindstrs source)
+                        elseif (not (any-none? meta))
+                            errormsg "meta cell expected, got " (kindstrs source)
+                        (Atom)
+                case builtins.getmeta
+                    let source = ('get-index args 0)
+                    if (all-kinds? Atom.Kind.Cell source)
+                        let _source = source
+                        source as:= Cell
+                        copy ('get-meta source)
+                    else
+                        if (not (any-none? source))
+                            errormsg "cell expected, got " (kindstrs source)
+                        (Atom)
+                # (countof table)
+                case builtins.nextindex (eval-countof)
+                case builtins._
+                    return (Atom args)
+                # (maptext size f)
+                case builtins.maptext
+                    let size = ('get-index args 0)
+                    let func = ('get-index args 1)
+                    if (all-kinds? Atom.Kind.Number size)
+                        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)
+                            if (('kind result) == Atom.Kind.Text)
+                                'append str (result as String)
+                        return (Atom str)
+                    else
+                        if (not (any-none? size))
+                            errormsg "number expected, got " (kindstrs size)
+                        return (Atom)
+                default
+                    print "syntax error:" ('tostring expr)
                     return (Atom)
             default
-                print "syntax error:" ('tostring expr)
+                print "cannot apply:" ('tostring expr)
                 return (Atom)
         default
-            print "cannot apply:" ('tostring expr)
-            return (Atom)
-    default
-        return (copy expr)
+            return (copy expr)
+
+fn... ueval (env : Atom, expr : Atom)
+    local ce : CachedEval
+    'eval ce env expr
 
 ###############################################################################
 
 do
     let Number Cell Atom UString CellLimb
     let uquote
-    let global-environment ueval
+    let global-environment ueval CachedEval
 
     locals;

          
A => testing/test_compiler.tuk +75 -0
@@ 0,0 1,75 @@ 
+: source
+    quote
+        let
+            : w
+                // (get (get io 'screen-size) 0) 4
+            : h
+                // (get (get io 'screen-size) 1) 4
+            : clamp
+                fn (x mn mx)
+                    cond (< x mn) mn
+                        cond (> x mx) mx x
+            : abs
+                fn (x)
+                    cond (< x 0) (- 0 x) x
+            let
+                : rgba
+                    fn (r g b a)
+                        tou32
+                            |
+                                |
+                                    | (floor (* (clamp r 0 1) 255))
+                                        * (floor (* (clamp g 0 1) 255)) 256
+                                    * (floor (* (clamp b 0 1) 255)) 65536
+                                * (floor (* (clamp a 0 1) 255)) 16777216
+                let
+                    : shader
+                        fn (i)
+                            let
+                                : x (/ (% i w) w)
+                                : y (/ (// i w) h)
+                                let
+                                    : x (* (- (* 2 x) 1) (/ w h))
+                                    : y (- (* 2 y) 1)
+                                    let
+                                        : d
+                                            *
+                                                abs (- (sqrt (+ (* x x) (* y y))) 0.9)
+                                                * h 0.5
+                                        rgba d d d 0
+                    _
+                        : title
+                            .. "test_screen "
+                                ..
+                                    ..
+                                        totext (get (get io 'screen-size) 0)
+                                        "x"
+                                    totext (get (get io 'screen-size) 1)
+                        : screen
+                            maptext (* w h) shader
+: program
+    quote
+        fn (io)
+            global frame = 0
+            frame += 1
+            let ssz = (('get io 'screen-size) as Cell)
+            let w h = (('get ssz 0) as Number as integer) (('get ssz 1) as Number as integer)
+            let w = (w // 4)
+            let h = (h // 4)
+            local s : String
+            'resize s (w * h * 4)
+            let ptr = ((& (s @ 0)) as (mutable @u32))
+            if ((frame & 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
+            Cell.new
+                screen = s
+
+_
+    dump source
+    : native-program (all (get io 'setup) program)

          
M testing/test_screen.tuk +38 -7
@@ 2,14 2,45 @@ 
     // (get (get io 'screen-size) 0) 4
 : h
     // (get (get io 'screen-size) 1) 4
-_
-    : screen
-        maptext (* w h)
+: clamp
+    fn (x mn mx)
+        cond (< x mn) mn
+            cond (> x mx) mx x
+: abs
+    fn (x)
+        cond (< x 0) (- 0 x) x
+let
+    : rgba
+        fn (r g b a)
+            tou32
+                |
+                    |
+                        | (floor (* (clamp r 0 1) 255))
+                            * (floor (* (clamp g 0 1) 255)) 256
+                        * (floor (* (clamp b 0 1) 255)) 65536
+                    * (floor (* (clamp a 0 1) 255)) 16777216
+    let
+        : shader
             fn (i)
                 let
                     : x (/ (% i w) w)
                     : y (/ (// i w) h)
-                    tou32
-                        | (floor (* x 255))
-                            * (floor (* y 255)) 256
-
+                    let
+                        : x (* (- (* 2 x) 1) (/ w h))
+                        : y (- (* 2 y) 1)
+                        let
+                            : d
+                                *
+                                    abs (- (sqrt (+ (* x x) (* y y))) 0.9)
+                                    * h 0.5
+                            rgba d d d 0
+        _
+            : title
+                .. "test_screen "
+                    ..
+                        ..
+                            totext (get (get io 'screen-size) 0)
+                            "x"
+                        totext (get (get io 'screen-size) 1)
+            : screen
+                maptext (* w h) shader

          
M testing/tuk_interpreter.sc +85 -25
@@ 92,6 92,13 @@ fn run (argc argv program opts)
 
     let env = ((global-environment) as Cell)
 
+    let tuk-globals = (globals)
+    let tuk-globals = ('bind tuk-globals 'Atom Atom)
+    let tuk-globals = ('bind tuk-globals 'Cell Cell)
+    let tuk-globals = ('bind tuk-globals 'Number Number)
+    let tuk-globals = ('bind tuk-globals 'String String)
+    let tuk-globals = ('bind tuk-globals 'quote sugar-quote)
+
     let io = (Cell)
 
     inline debugprint (...)

          
@@ 118,6 125,9 @@ fn run (argc argv program opts)
         out_Color = (texture smp (deref uv.in))
         return;
 
+    let NativeFunctionType =
+        pointer (function (uniqueof Cell -1) (viewof Cell 1))
+
     struct System
         break? = false
         close? = false

          
@@ 125,11 135,15 @@ fn run (argc argv program opts)
         screensize = (ivec2 640 360)
         title = (Atom "UVM")
         screen = (Atom)
+        native_function : NativeFunctionType = null
+        iteration = 0
     local sys : System
 
     @@ 'on GLMain.on-draw
     inline (time size glmain)
         let gfx = ('force-unwrap sys.gfx)
+        GL.BindFramebuffer GL.FRAMEBUFFER 0
+        GL.Viewport 0 0 (unpack sys.screensize)
         GL.UseProgram gfx.shader
         GL.BindTextureUnit 0 gfx.tx_screen
         GL.Uniform smp 0

          
@@ 140,10 154,31 @@ fn run (argc argv program opts)
         let x y = (unpack v)
         Atom (Cell.new (Atom x) (Atom y))
 
+    local ce : CachedEval
+
+    let
+        KEY_SETUP = (Atom 'setup)
+        KEY_SCREENSIZE = (Atom 'screen-size)
+        KEY_ITERATION = (Atom 'iteration)
+        KEY_STATE = (Atom 'state)
+        KEY_IO = (Atom 'io)
+        KEY_STDOUT = (Atom 'stdout)
+        KEY_BLOCKBREAK = (Atom 'block-break)
+        KEY_BREAK = (Atom 'break)
+        KEY_BLOCKCLOSE = (Atom 'block-close)
+        KEY_CLOSE = (Atom 'close)
+        KEY_SCREEN = (Atom 'screen)
+        KEY_TITLE = (Atom 'title)
+        KEY_NATIVE_PROGRAM = (Atom 'native-program)
+        KEY_PROMPT = (Atom 'prompt)
+        KEY_EXIT = (Atom 'exit)
+        KEY_READLINE = (Atom 'readline)
+
     vvv bind init
     do
-        let io = ('set io 'setup true)
-        let io = ('set io 'screen-size (ivec2->cell sys.screensize))
+        let io = ('set io KEY_SETUP true)
+        let io = ('set io KEY_SCREENSIZE (ivec2->cell sys.screensize))
+        let io = ('set io KEY_ITERATION sys.iteration)
         let io =
             if (sc_is_file opts.statepath)
                 debugprint "loading state from" opts.statepath

          
@@ 152,10 187,10 @@ fn run (argc argv program opts)
                     else
                         error
                             .. "opening " opts.statepath " failed"
-                'set io 'state (unpickle file)
+                'set io KEY_STATE (unpickle file)
             else io
-        let env = ('set env 'io io)
-        ueval env program
+        let env = ('set env KEY_IO io)
+        'eval ce env program
     #
             global glmain =
         GLMain

          
@@ 172,29 207,29 @@ fn run (argc argv program opts)
             break 255 (Atom)
         debugprint "IO <-" ('tostring (Atom state))
         let cstate = (state as Cell)
-        let stateval = ('get cstate 'state)
+        let stateval = ('get cstate KEY_STATE)
+        let stdoutval = ('get cstate KEY_STDOUT)
+        if (not ('none? stdoutval))
+            io-write! (stdoutval as String as string)
+        let io = (copy io)
         if sys.break?
             sys.break? = false
-            let blockbreak = ('get cstate 'block-break)
+            let blockbreak = ('get cstate KEY_BLOCKBREAK)
             if ('none? blockbreak)
                 debugprint "breaking"
                 break 255 stateval
         if sys.close?
             sys.close? = false
-            let blockclose = ('get cstate 'block-close)
+            let blockclose = ('get cstate KEY_BLOCKCLOSE)
             if ('none? blockclose)
                 debugprint "closing"
                 break 0 stateval
-        let stdoutval = ('get cstate 'stdout)
-        if (not ('none? stdoutval))
-            io-write! (stdoutval as String as string)
-        #let screensize = ('get cstate 'screen-size)
-        let screen = ('get cstate 'screen)
-        let io = (copy io)
+        #let screensize = ('get cstate KEY_SCREENSIZE)
+        let screen = ('get cstate KEY_SCREEN)
         let io =
             if (not ('none? screen))
                 # ensure GL subsystem is running
-                let titleval = ('get cstate 'title)
+                let titleval = ('get cstate KEY_TITLE)
                 if (not sys.gfx)
                     if (not ('none? titleval))
                         if (('kind titleval) == Atom.Kind.Text)

          
@@ 207,6 242,7 @@ fn run (argc argv program opts)
                                     title = (sys.title as String)
                                     width = sys.screensize.x
                                     height = sys.screensize.y
+                                    resizable = true
                             shader =
                                 do
                                     let pg = (GL.Program)

          
@@ 226,7 262,7 @@ fn run (argc argv program opts)
                     let bufferdata = (screen as String)
                     let buffersize = (countof bufferdata)
                     for scale in (range 1 5)
-                        let requiredsize = (w * h * 4 // (scale * scale))
+                        let requiredsize = ((w // scale) * (h // scale) * 4)
                         if (buffersize == requiredsize)
                             GL.BindTexture GL.TEXTURE_2D gfx.tx_screen
                             GL.TexImage2D GL.TEXTURE_2D 0 GL.RGBA8 (w // scale) (h // scale) 0 GL.RGBA \

          
@@ 240,29 276,52 @@ fn run (argc argv program opts)
                     else
                         debugprint "screen buffersize mismatch" buffersize "!=" (w * h * 4)
                 let continue? = ('step glmain)
+                sys.screensize = (ivec2 ('size glmain))
                 if continue? io
                 else
                     sys.close? = true
-                    'set io 'close true
+                    'set io KEY_CLOSE true
             else io
-        let exitval = ('get cstate 'exit)
+        let exitval = ('get cstate KEY_EXIT)
         if (not ('none? exitval))
             break (exitval as Number as integer) stateval
-        let promptval = ('get cstate 'prompt)
+        local repeat? : bool =
+            sys.gfx | (not ('none? stateval))
+        let runscopesval = ('get cstate KEY_NATIVE_PROGRAM)
+        if (not ('none? runscopesval))
+            repeat? = true
+            let expr = ('to-value runscopesval)
+            if (('typeof expr) == list)
+                let f = (sc_expand (expr as list) '() tuk-globals)
+                let types = (alloca-array type 1)
+                types @ 0 = Cell
+                let f = (sc_typify_template f 1 types)
+                let f = (sc_compile f compile-flag-cache)
+                let f = (f as NativeFunctionType)
+                sys.native_function = f
+        let promptval = ('get cstate KEY_PROMPT)
         let io =
             if (not ('none? promptval))
+                repeat? = true
                 let ok? line = (sc_prompt (promptval as String as string) "")
                 if ok?
-                    'set io 'readline (.. line "\n")
+                    'set io KEY_READLINE (.. line "\n")
                 else
                     sys.break? = true
-                    'set io 'break true
+                    'set io KEY_BREAK true
             else io
-        let io = ('set io 'screen-size (ivec2->cell sys.screensize))
-        let io = ('set io 'state stateval)
+        if (not repeat?)
+            break 0 stateval
+        let io = ('set io KEY_SCREENSIZE (ivec2->cell sys.screensize))
+        sys.iteration += 1
+        let io = ('set io KEY_ITERATION sys.iteration)
+        let io = ('set io KEY_STATE stateval)
         debugprint "IO ->" ('tostring (Atom (copy io)))
-        let env = ('set (copy env) 'io io)
-        ueval (copy env) (copy program)
+        if (sys.native_function != null)
+            Atom (sys.native_function io)
+        else
+            let env = ('set (copy env) KEY_IO io)
+            'eval ce (copy env) (copy program)
     if ((not (empty? opts.statepath)) and (not ('none? state)))
         using import tukan.File
         let testfilepath =

          
@@ 277,6 336,7 @@ fn run (argc argv program opts)
             pickle file state
             drop file
     debugprint "exiting with code" result
+    debugprint "cache stats:" ce.hits "hits," ce.misses "misses"
     return result
 
 fn print-help (exename)