bca5ff528e7e — Leonard Ritter 26 days ago
* `let` updates env per statement, entries are no longer keys
* `fn` body is implicit `let`
4 files changed, 153 insertions(+), 95 deletions(-)

M lib/tukan/uvm.sc
M testing/test_compiler.tuk
M testing/test_echo.tuk
M testing/test_screen.tuk
M lib/tukan/uvm.sc +65 -12
@@ 1364,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 sqrt
+            \ tou32 floor sqrt fold
         sym := (Atom (name as Symbol))
         code := ('hashbits sym)
         _

          
@@ 1381,16 1381,33 @@ global mt_closure : Atom =
 
 global tok_wildcard : Atom =
     Atom '*
+global tok_let : Atom =
+    Atom 'let
 
 let global-env = ('set global-env 'globals (copy global-env))
 
 global global-env : Atom = global-env
 
+global tok-quote : Atom = 'quote
+
 run-stage;
 
 fn global-environment ()
     global-env
 
+fn... rewrite-fn-body (expr : Atom)
+    let expr = (expr as Cell)
+    local newbody = (Cell.new (copy tok_let))
+    call
+        Cell.gen-each-index
+            inline (i expr newbody)
+                if (i >= 2)
+                    newbody =
+                        'append newbody (copy expr)
+        \ expr newbody
+    local newexpr = (Cell.new ('get-index expr 0) ('get-index expr 1) newbody)
+    return (Atom newexpr)
+
 fn... uapply-env (closure : Atom, args : Atom, argoffset : i32)
     let headtable = (closure as Cell)
     local env = (copy (('get-index headtable 0) as Cell))

          
@@ 1399,7 1416,7 @@ fn... uapply-env (closure : Atom, args :
     let params = ('get-index ftable 1)
     let tparams = (params as Cell)
     local used_keys = (Cell)
-    let eachf =
+    call
         Cell.gen-each-index
             inline (i name env used_keys args argoffset)
                 if (name == tok_wildcard)

          
@@ 1429,7 1446,7 @@ fn... uapply-env (closure : Atom, args :
                                 'get args name
                             else value
                 ;
-    eachf tparams env used_keys (args as Cell) argoffset
+        \ tparams env used_keys (args as Cell) argoffset
     return env ('get-index ftable 2)
 
 struct CachedEval

          
@@ 1503,18 1520,29 @@ struct CachedEval
                 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))
+                    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)
                                 ;
-                    local newenv = (copy (env as Cell))
-                    f args env newenv self
-                    return (ueval newenv ('get args 1))
+                        \ args env newenv self lastindex
+                    return (ueval newenv ('get args lastindex))
                 # (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))
                     return
                         Atom

          
@@ 1791,6 1819,31 @@ struct CachedEval
                 case builtins.nextindex (eval-countof)
                 case builtins._
                     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 func = ('get-index args 2)
+                    if (not (any-none? limit init func))
+                        let limit = (limit as Number as i64)
+                        loop (i state = 0:i64 init)
+                            if (i == limit)
+                                break state
+                            else
+                                let expr = (Cell.new (copy func)
+                                    (Cell.new (copy tok-quote) state)
+                                    (Atom i))
+                                let result = (ueval env expr)
+                                repeat (i + 1)
+                                    if (('kind result) == Atom.Kind.Cell)
+                                        let result = (result as Cell)
+                                        let nextstate = ('get-index result 0)
+                                        if ('none? nextstate)
+                                            break ('get-index result 1)
+                                        else nextstate
+                                    else result
+                    else
+                        return (Atom)
                 # (maptext size f)
                 case builtins.maptext
                     let size = ('get-index args 0)

          
M testing/test_compiler.tuk +52 -42
@@ 1,53 1,49 @@ 
-: source
+#!/usr/bin/env -S scopes tuk_interpreter.sc
+source
     quote
         let
-            : w
+            w
                 // (get (get io 'screen-size) 0) 4
-            : h
+            h
                 // (get (get io 'screen-size) 1) 4
-            : clamp
+            clamp
                 fn (x mn mx)
                     cond (< x mn) mn
                         cond (> x mx) mx x
-            : abs
+            abs
                 fn (x)
                     cond (< x 0) (- 0 x) x
-            let
-                : rgba
-                    fn (r g b a)
-                        tou32
+            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
+                                | (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
     quote
         fn (io)
             global frame = 0

          
@@ 69,7 65,21 @@ 
                         ptr @ (y * w + x) = 0xff0000ff as u32
             Cell.new
                 screen = s
-
 _
-    dump source
+    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)

          
M testing/test_echo.tuk +3 -3
@@ 1,6 1,6 @@ 
-: exit?
+exit?
     == "\n" (get io 'readline)
-: state
+state
     any
         get io 'state
         setmeta

          
@@ 14,7 14,7 @@ cond (any exit? false)
         : stdout "exiting...\n"
         : state state
     let
-        : state
+        state
             any
                 all (get io 'readline)
                     set state 'index (+ (get state 'index) 1)

          
M testing/test_screen.tuk +33 -38
@@ 1,46 1,41 @@ 
-: w
+w
     // (get (get io 'screen-size) 0) 4
-: h
+h
     // (get (get io 'screen-size) 1) 4
-: clamp
+clamp
     fn (x mn mx)
         cond (< x mn) mn
             cond (> x mx) mx x
-: abs
+abs
     fn (x)
         cond (< x 0) (- 0 x) x
-let
-    : rgba
-        fn (r g b a)
-            tou32
+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
+                    | (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