65ed1687b549 — Leonard Ritter 25 days ago
* added `let@` and `let:` forms for `do`
M lib/tukan/uvm.sc +56 -4
@@ 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
+            \ tou32 floor sqrt fold do cell sin cos map
         sym := (Atom (name as Symbol))
         code := ('hashbits sym)
         _

          
@@ 1392,6 1392,10 @@ global tok_wildcard : Atom =
     Atom '*
 global tok_let : Atom =
     Atom 'let
+global tok_let@ : Atom =
+    Atom 'let@
+global tok_let: : Atom =
+    Atom 'let:
 global tok_fn : Atom =
     Atom 'fn
 global tok_macro : Atom =

          
@@ 1531,6 1535,38 @@ struct CachedEval
                             env =
                                 'set env (copy k)
                                     'eval-do self (copy env) triplet 2
+                        elseif (tok == tok_let@)
+                            let lastindex = (('next-index triplet) - 1)
+                            let value =
+                                'eval self (copy env) ('get-index triplet lastindex)
+                            if (('kind value) == Atom.Kind.Cell)
+                                let value = (value as Cell)
+                                call
+                                    Cell.gen-each-index
+                                        inline (index node env value lastindex)
+                                            if ((index >= 1) & (index < lastindex))
+                                                env =
+                                                    'set env node ('get-index value (index - 1))
+                                    \ triplet env value lastindex
+                            else
+                                print "in" expr
+                                print "error: cell expected, not" ('tostring value)
+                        elseif (tok == tok_let:)
+                            let lastindex = (('next-index triplet) - 1)
+                            let value =
+                                'eval self (copy env) ('get-index triplet lastindex)
+                            if (('kind value) == Atom.Kind.Cell)
+                                let value = (value as Cell)
+                                call
+                                    Cell.gen-each-index
+                                        inline (index node env value lastindex)
+                                            if ((index >= 1) & (index < lastindex))
+                                                env =
+                                                    'set env node ('get value node)
+                                    \ triplet env value lastindex
+                            else
+                                print "in" expr
+                                print "error: cell expected, not" ('tostring value)
                         elseif (((tok == tok_fn) or (tok == tok_macro))
                             and (('kind ('get-index triplet 1)) == Atom.Kind.Symbol))
                             let k = ('get-index triplet 1)

          
@@ 1572,7 1608,7 @@ struct CachedEval
         if (not ('none? meta))
             result =
                 'set-meta result
-                    'eval self newenv meta
+                    'eval self env meta
         call
             Cell.gen-each-pair
         if ('empty? result)

          
@@ 1892,8 1928,8 @@ struct CachedEval
                     return (Atom args)
                 # (fold limit init f) (f value index) -> 2-cell
                 case builtins.fold
-                    let limit = ('get-index args 0)
-                    let init = ('get-index args 1)
+                    let init = ('get-index args 0)
+                    let limit = ('get-index args 1)
                     let func = ('get-index args 2)
                     if (not (any-none? limit init func))
                         let limit = (limit as Number as i64)

          
@@ 1915,6 1951,22 @@ struct CachedEval
                                     else result
                     else
                         return (Atom)
+                # (map limit f)
+                case builtins.map
+                    let limit = ('get-index args 0)
+                    let func = ('get-index args 1)
+                    if (all-kinds? Atom.Kind.Number limit)
+                        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)
+                        return (Atom cell)
+                    else
+                        if (not (any-none? limit))
+                            errormsg "number expected, got " (kindstrs limit)
+                        return (Atom)
                 # (maptext size f)
                 case builtins.maptext
                     let size = ('get-index args 0)

          
M testing/test_compiler.tuk +30 -57
@@ 2,47 2,35 @@ 
 let source
     quote
         do
-            fn clamp (x mn mx)
-                cond (< x mn) mn
-                    cond (> x mx) mx x
-            fn abs (x)
-                cond (< x 0) (- 0 x) x
-            fn rgba (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
-            = title
-                .. "test_screen "
-                    ..
-                        ..
-                            totext (get (get io 'screen-size) 0)
-                            "x"
-                        totext (get (get io 'screen-size) 1)
-            = screen
-                let sz
-                    get io 'screen-size
-                let w
-                    // (get sz 0) 4
-                let h
-                    // (get sz 1) 4
-                fn shader (i)
-                    let x (/ (% i w) w)
-                    let y (/ (// i w) h)
-                    let x (* (- (* 2 x) 1) (/ w h))
-                    let y (- (* 2 y) 1)
-                    let d
-                        *
-                            abs
-                                - (sqrt (+ (* x x) (* y y)))
-                                    + 0.5
-                                        * 0.4 (sin (* 0.01 (get io 'iteration)))
-                            * h 0.5
-                    rgba d d d 0
-                maptext (* w h) shader
+            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)

          
@@ 66,19 54,4 @@ let program
                 for y in (range h)
                     for x in (range w)
                         ptr @ (y * w + x) = 0xff0000ff as u32
-= native-program (all (get io 'setup) program)
-dump
-    do
-        let vecsize (nextindex (cell 1 2 3 4))
-        fold 16
-            cell (cell) (cell 1 2 3 4)
-            fn (s i)
-                let out (get s 0)
-                let in (get s 1)
-                let element (get in i)
-                all element
-                    do
-                        set out i
-                            * element 2
-                        in
-                get s 0
+= native-program (all setup program)

          
M testing/test_echo.tuk +5 -5
@@ 1,8 1,8 @@ 
 let exit?
-    == "\n" (get io 'readline)
+    == "\n" readline
 let state
     any
-        get io 'state
+        state
         do
             : meta
                 cell

          
@@ 16,7 16,7 @@ cond (any exit? false)
     do
         let state
             any
-                all (get io 'readline)
+                all readline
                     set state 'index (+ (get state 'index) 1)
                 state
         = block-break true

          
@@ 24,6 24,6 @@ cond (any exit? false)
             .. (totext (get state 'index)) "> "
         = stdout
             any
-                all (get io 'break) "enter empty line to exit\n"
-                get io 'readline
+                all break "enter empty line to exit\n"
+                readline
         = state state

          
A => testing/test_fold.tuk +39 -0
@@ 0,0 1,39 @@ 
+dump
+    do
+        # fibonacci, head recursive
+        fn fib-rec (f n)
+            cond (< n 2) n
+                +
+                    f f (- n 1)
+                    f f (- n 2)
+        fib-rec fib-rec 10
+dump
+    do
+        # fibonacci, tail recursive
+        fold
+            do 0 1 10
+            100
+            fn (s i)
+                let@ a b n s
+                cond (> n 0)
+                    do b (+ a b) (- n 1)
+                a
+dump
+    do
+        let vec (cell 1 2 3 4)
+        let vecsize (nextindex vec)
+        fold (cell) 16 # produces (2 4 6 8)
+            fn (s i)
+                let element (get vec i)
+                all element
+                    set s i
+                        * element 2
+                s
+dump
+    do
+        let vec (cell 1 2 3 4)
+        let vecsize (nextindex vec)
+        map 16 # produces (2 (: 2 6))
+            fn (i)
+                cond (== (& i 1) 0)
+                    * (get vec i) 2

          
A => testing/test_native.tuk +57 -0
@@ 0,0 1,57 @@ 
+#!/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)
+            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)

          
M testing/test_screen.tuk +5 -7
@@ 15,16 15,14 @@ fn rgba (r g b a)
     .. "test_screen "
         ..
             ..
-                totext (get (get io 'screen-size) 0)
+                totext (get screen-size 0)
                 "x"
-            totext (get (get io 'screen-size) 1)
+            totext (get screen-size 1)
 = screen
-    let sz
-        get io 'screen-size
     let w
-        // (get sz 0) 4
+        // (get screen-size 0) 4
     let h
-        // (get sz 1) 4
+        // (get screen-size 1) 4
     fn shader (i)
         let x (/ (% i w) w)
         let y (/ (// i w) h)

          
@@ 35,7 33,7 @@ fn rgba (r g b a)
                 abs
                     - (sqrt (+ (* x x) (* y y)))
                         + 0.5
-                            * 0.4 (sin (* 0.01 (get io 'iteration)))
+                            * 0.4 (sin (* 0.01 iteration))
                 * h 0.5
         rgba d d d 0
     maptext (* w h) shader

          
M testing/tuk_interpreter.sc +17 -19
@@ 28,7 28,6 @@ global KEY_SETUP = (Atom 'setup)
 global KEY_SCREENSIZE = (Atom 'screen-size)
 global KEY_ITERATION = (Atom 'iteration)
 global KEY_STATE = (Atom 'state)
-global KEY_IO = (Atom 'io)
 global KEY_STDOUT = (Atom 'stdout)
 global KEY_BLOCKBREAK = (Atom 'block-break)
 global KEY_BREAK = (Atom 'break)

          
@@ 170,16 169,17 @@ fn run (argc argv program opts)
         native-program : Atom
         exit : i32
 
-    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 'InputFlags InputFlags)
-    let tuk-globals = ('bind tuk-globals 'OutputFlags OutputFlags)
-    let tuk-globals = ('bind tuk-globals 'InputVars InputVars)
-    let tuk-globals = ('bind tuk-globals 'OutputVars OutputVars)
-    let tuk-globals = ('bind tuk-globals 'quote sugar-quote)
+    let tuk-globals =
+        'bind-symbols (globals)
+            Atom = Atom
+            Cell = Cell
+            Number = Number
+            String = String
+            InputFlags = InputFlags
+            OutputFlags = OutputFlags
+            InputVars = InputVars
+            OutputVars = OutputVars
+            quote = sugar-quote
 
     local ins : InputVars
     local outs : OutputVars

          
@@ 215,8 215,8 @@ fn run (argc argv program opts)
 
     local ce : CachedEval
 
-    fn inputs->cell (inp)
-        let io = (Cell)
+    fn inputs->cell (inp io)
+        let io = (copy io)
         let flags = (deref inp.flags)
         let io =
             if (flags & InputFlags.Setup) ('set io KEY_SETUP true)

          
@@ 284,9 284,8 @@ fn run (argc argv program opts)
                         .. "opening " opts.statepath " failed"
             ins.state = (unpickle file)
             ins.flags |= InputFlags.State
-        let io = (inputs->cell ins)
-        debugprint "setup IO ->" ('tostring (Atom (copy io)))
-        let env = ('set env KEY_IO io)
+        #debugprint "setup IO ->" ('tostring (Atom (copy io)))
+        let env = (inputs->cell ins env)
         let state = ('eval ce env program)
         if ('none? state)
             print "error: setup unhandled"

          
@@ 404,9 403,8 @@ fn run (argc argv program opts)
         if (sys.native_function != null)
             sys.native_function ins outs
         else
-            let io = (inputs->cell ins)
-            debugprint "IO ->" ('tostring (Atom (copy io)))
-            let env = ('set (copy env) KEY_IO io)
+            #debugprint "IO ->" ('tostring (Atom (copy io)))
+            let env = (inputs->cell ins env)
             let state = ('eval ce (copy env) (copy program))
             if (('kind state) != Atom.Kind.Cell)
                 print "error: main function must return cell"