d915fd5f93f5 — Leonard Ritter 26 days ago
* syntax improvements; `do` permits returning multiple arguments, setting metacell
M lib/tukan/uvm.sc +76 -27
@@ 700,6 700,15 @@ struct Cell
             default
                 break (index + 1)
 
+    fn empty? (self)
+        and
+            'none? self.ivalues
+            'none? self.values
+            'none? self.meta
+
+    fn keys? (self)
+        not ('none? self.values)
+
     fn... append (self, value : Atom)
         set-index self (next-index self) value
 

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

          
@@ 1383,6 1392,12 @@ global tok_wildcard : Atom =
     Atom '*
 global tok_let : Atom =
     Atom 'let
+global tok_= : Atom =
+    Atom '=
+global tok_do : Atom =
+    Atom 'do
+global tok_meta : Atom =
+    Atom 'meta
 
 let global-env = ('set global-env 'globals (copy global-env))
 

          
@@ 1397,7 1412,7 @@ fn global-environment ()
 
 fn... rewrite-fn-body (expr : Atom)
     let expr = (expr as Cell)
-    local newbody = (Cell.new (copy tok_let))
+    local newbody = (Cell.new (copy tok_do))
     call
         Cell.gen-each-index
             inline (i expr newbody)

          
@@ 1494,6 1509,57 @@ struct CachedEval
         default
             copy target
 
+    fn... eval-do (self, env : Atom, args : Cell, start : i32)
+        returning (uniqueof Atom -1)
+        local newenv = (copy (env as Cell))
+        local result = (Cell)
+        local nextindex = 0
+        call
+            Cell.gen-each-index
+                inline (index expr env self result start nextindex)
+                    if (index < start)
+                    elseif (('kind expr) == Atom.Kind.Cell)
+                        let triplet = (expr as Cell)
+                        let tok = ('get-index triplet 0)
+                        if (tok == tok_let)
+                            let k = ('get-index triplet 1)
+                            env =
+                                'set env (copy k)
+                                    'eval-do self (copy env) triplet 2
+                        elseif (tok == tok_=)
+                            let key = ('get-index triplet 1)
+                            let outv = ('eval-do self (copy env) triplet 2)
+                            result =
+                                'set result
+                                    if (('kind key) == Atom.Kind.Symbol) (copy key)
+                                    else ('eval self (copy env) (copy key))
+                                    outv
+                        else
+                            result =
+                                'set-index result nextindex
+                                    ('eval self (copy env) expr)
+                            nextindex += 1
+                    else
+                        result =
+                            'set-index result nextindex
+                                ('eval self (copy env) expr)
+                        nextindex += 1
+                    ;
+            \ args newenv self result start nextindex
+        let meta = ('get args tok_meta)
+        if (not ('none? meta))
+            result =
+                'set-meta result
+                    'eval self newenv meta
+        call
+            Cell.gen-each-pair
+        if ('empty? result)
+            return (Atom)
+        elseif ((('next-index result) == 1) and (not ('keys? result)))
+            return ('get-index result 0)
+        else
+            return (Atom result)
+
     fn... uncached_eval (self, env : Atom, expr : Atom)
         inline ueval (env expr)
             'eval self env expr

          
@@ 1518,27 1584,9 @@ struct CachedEval
                 let args = (expr as Cell)
 
                 switch ('hashbits head)
-                # (let (: k v) ... expr)
-                case builtins.let
-                    local newenv = (copy (env as Cell))
-                    let lastindex = (('next-index args) - 1)
-                    call
-                        Cell.gen-each-index
-                            inline (index pair origenv env self lastindex)
-                                if (index == 0)
-                                elseif (index == lastindex)
-                                elseif (('kind pair) == Atom.Kind.Cell)
-                                    let pair = (pair as Cell)
-                                    let k = ('get-index pair 0)
-                                    let v = ('get-index pair 1)
-                                    env =
-                                        'set env (copy k)
-                                            'eval self (copy env) (copy v)
-                                else
-                                    print "syntax error: pair expected, not" ('tostring pair)
-                                ;
-                        \ args env newenv self lastindex
-                    return (ueval newenv ('get args lastindex))
+                # (do (let k v) ... expr... (: k v))
+                case builtins.do
+                    return (eval-do self env args 1)
                 # (fn (param ...) expr)
                 case builtins.fn
                     let expr = (rewrite-fn-body expr)

          
@@ 1594,12 1642,11 @@ struct CachedEval
                     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
+                                        else ('eval self env key)
                                         outv
                         \ table args env self
                     deref args

          
@@ 1741,6 1788,8 @@ struct CachedEval
                 case builtins.^ (binop ^)
                 case builtins.floor (unop 'floor)
                 case builtins.sqrt (unop 'sqrt)
+                case builtins.sin (unop 'sin)
+                case builtins.cos (unop 'cos)
                 case builtins.< (binop <)
                 case builtins.<= (binop <=)
                 case builtins.> (binop >)

          
@@ 1817,7 1866,7 @@ struct CachedEval
                         (Atom)
                 # (countof table)
                 case builtins.nextindex (eval-countof)
-                case builtins._
+                case builtins.cell
                     return (Atom args)
                 # (fold limit init f) (f value index) -> 2-cell
                 case builtins.fold

          
M testing/test_compiler.tuk +58 -61
@@ 1,49 1,48 @@ 
 #!/usr/bin/env -S scopes tuk_interpreter.sc
-source
+let 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
-            rgba
-                fn (r g b a)
-                    tou32
-                        |
+        do
+            = title
+                .. "test_screen "
+                    ..
+                        ..
+                            totext (get (get io 'screen-size) 0)
+                            "x"
+                        totext (get (get io 'screen-size) 1)
+            = screen
+                let w
+                    // (get (get io 'screen-size) 0) 4
+                let h
+                    // (get (get io 'screen-size) 1) 4
+                let clamp
+                    fn (x mn mx)
+                        cond (< x mn) mn
+                            cond (> x mx) mx x
+                let 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
-            shader
-                fn (i)
-                    x (/ (% i w) w)
-                    y (/ (// i w) h)
-                    x (* (- (* 2 x) 1) (/ w h))
-                    y (- (* 2 y) 1)
-                    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
+                                |
+                                    | (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)
+                        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.9)
+                                * h 0.5
+                        rgba d d d 0
+                maptext (* w h) shader
+let program
     quote
         fn (io)
             global frame = 0

          
@@ 65,21 64,19 @@ program
                         ptr @ (y * w + x) = 0xff0000ff as u32
             Cell.new
                 screen = s
-_
-    dump
-        let
-            vecsize (nextindex (_ 1 2 3 4))
-            fold 16
-                _ (_) (_ 1 2 3 4)
-                fn (s i)
-                    out (get s 0)
-                    in (get s 1)
-                    element (get in i)
-                    _
-                        all element
-                            _
-                                set out i
-                                    * element 2
-                                in
-                        get s 0
-    : 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 (get io 'setup) program)

          
M testing/test_echo.tuk +21 -22
@@ 1,30 1,29 @@ 
-exit?
+let exit?
     == "\n" (get io 'readline)
-state
+let state
     any
         get io 'state
-        setmeta
-            _
-                : index 0
-            _
-                : class "state"
+        do
+            : meta
+                cell
+                    : class "state"
+            = index 0
 cond (any exit? false)
-    _
-        : exit 0
-        : stdout "exiting...\n"
-        : state state
-    let
-        state
+    do
+        = exit 0
+        = stdout "exiting...\n"
+        = state state
+    do
+        let state
             any
                 all (get io 'readline)
                     set state 'index (+ (get state 'index) 1)
                 state
-        _
-            : block-break true
-            : prompt
-                .. (totext (get state 'index)) "> "
-            : stdout
-                any
-                    all (get io 'break) "enter empty line to exit\n"
-                    get io 'readline
-            : state state
+        = block-break true
+        = prompt
+            .. (totext (get state 'index)) "> "
+        = stdout
+            any
+                all (get io 'break) "enter empty line to exit\n"
+                get io 'readline
+        = state state

          
M testing/test_screen.tuk +44 -40
@@ 1,41 1,45 @@ 
-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
-rgba
-    fn (r g b a)
-        tou32
-            |
+= 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
+    let clamp
+        fn (x mn mx)
+            cond (< x mn) mn
+                cond (> x mx) mx x
+    let 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
-shader
-    fn (i)
-        x (/ (% i w) w)
-        y (/ (// i w) h)
-        x (* (- (* 2 x) 1) (/ w h))
-        y (- (* 2 y) 1)
-        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
+                    |
+                        | (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)
+            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

          
M testing/tuk_interpreter.sc +1 -1
@@ 393,7 393,7 @@ if main-module?
         let sourcepath = (sc_realpath sourcepath)
         opts.statepath = (.. sourcepath ".state")
         let expr = ((list-load sourcepath) as list)
-        let expr = (cons 'let expr)
+        let expr = (cons 'do expr)
         exit
             run argc argv (Atom.from-value expr) opts
     else