44e628542cb4 — Leonard Ritter 27 days ago
* implemented comparison operators, eval, globals
2 files changed, 92 insertions(+), 27 deletions(-)

M lib/tukan/uvm.sc
M testing/tuk_interpreter.sc
M lib/tukan/uvm.sc +85 -27
@@ 1300,25 1300,76 @@ sugar uquote (expr...)
 
 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
+        sugar-quote + - * / // let fn quote set get nextindex _ < <= > >= == !=
+            \ not all any dump totext .. cond setmeta getmeta macro eval
         sym := (Atom (name as Symbol))
         code := ('hashbits sym)
         _
             'bind scope name `code
             'set env sym sym
 
-global global-env : Atom = global-env
-
-run-stage;
+global mt_macro : Atom =
+    Cell.new
+        type = "macro"
 
 global mt_closure : Atom =
     Cell.new
         type = "closure"
 
+global tok_wildcard : Atom =
+    Atom '*
+
+let global-env = ('set global-env 'globals (copy global-env))
+
+global global-env : Atom = global-env
+
+run-stage;
+
 fn global-environment ()
     global-env
 
+fn... uapply-env (env : Atom, 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)
+    let params = ('get-index ftable 1)
+    let tparams = (params as Cell)
+    local used_keys = (Cell)
+    let eachf =
+        Cell.gen-each-index
+            inline (i name env used_keys args argoffset)
+                if (name == tok_wildcard)
+                    local varenv =
+                        fold (varenv = (Cell)) \
+                            for j k in
+                            enumerate
+                                range (i + argoffset) ('next-index args)
+                            'set-index varenv j
+                                'get-index args k
+                    call
+                        Cell.gen-each-pair
+                            inline (key value varenv used_keys)
+                                if ('none? ('get used_keys key))
+                                    varenv =
+                                        'set varenv (copy key) (copy value)
+                        \ args varenv used_keys
+                    env =
+                        'set env name varenv
+                else
+                    let value = ('get-index args (i + argoffset))
+                    env =
+                        'set env name
+                            if ('none? value)
+                                used_keys =
+                                    'set used_keys name true
+                                'get args name
+                            else value
+                ;
+    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
 

          
@@ 1358,6 1409,13 @@ fn... ueval (env : Atom, expr : 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)

          
@@ 1373,6 1431,11 @@ fn... ueval (env : Atom, expr : Atom)
                         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 env head expr 1)))
         default;
 
         # evaluate all table elements

          
@@ 1382,7 1445,7 @@ fn... ueval (env : Atom, expr : Atom)
                 let table = (expr as Cell)
                 call
                     Cell.gen-each-index
-                        inline (index node result env anynone?)
+                        inline (index node result env)
                             if (index > 0)
                                 let outval = (ueval env node)
                                 result =

          
@@ 1390,7 1453,7 @@ fn... ueval (env : Atom, expr : Atom)
                     \ table args env
                 call
                     Cell.gen-each-pair
-                        inline (key value result env anynone?)
+                        inline (key value result env)
                             let outk = (ueval env key)
                             let outv = (ueval env value)
                             result =

          
@@ 1404,26 1467,9 @@ fn... ueval (env : Atom, expr : Atom)
         switch ('kind head)
         case Atom.Kind.Cell
             let headtable = (head as Cell)
-            if (('get-meta headtable) == mt_closure)
-                let origenv = env
-                local env = (copy (('get-index headtable 0) as Cell))
-                let f = ('get-index headtable 1)
-                let ftable = (f as Cell)
-                let params = ('get-index ftable 1)
-                let tparams = (params as Cell)
-                let eachf =
-                    Cell.gen-each-index
-                        inline (i name origenv env args)
-                            let value = ('get-index args i)
-                            env =
-                                'set env name
-                                    if ('none? value)
-                                        'get args name
-                                    else value
-                            ;
-                eachf tparams origenv env (args as Cell)
-                let expr = ('get-index ftable 2)
-                return (ueval env expr)
+            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)

          
@@ 1539,6 1585,11 @@ fn... ueval (env : Atom, expr : Atom)
             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.== (eval-eq)
             case builtins.!= (eval-neq)
             case (getattr builtins '..)

          
@@ 1550,6 1601,13 @@ fn... ueval (env : Atom, expr : Atom)
                     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)

          
M testing/tuk_interpreter.sc +7 -0
@@ 61,6 61,13 @@ fn run (argc argv program opts)
             stdout : text
                 when set, prints text to stdout.
 
+        Graphics
+        ========
+
+        outputs:
+            screen : cell
+
+
 
     let env = ((global-environment) as Cell)