Compare commits

...

11 Commits

Author SHA1 Message Date
a32561a07d merge: architecture → loops/tcl — R7RS, JIT, env-as-value
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
Resolved conflicts in hosts/ocaml/lib/sx_primitives.ml:
- Took architecture's make-regexp/regexp-* primitives (Tcl runtime depends on them)
- Took architecture's Integer typing for clock-seconds/milliseconds/format
- Kept Phase 4 env-lookup/env-extend additions

Tcl: 342/342 tests passing.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 21:00:51 +00:00
40f0e73386 briefing: tick Phase 4, update progress log — env-as-value complete
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 19:13:45 +00:00
83dbb5958a tcl: Phase 4 env-as-value — current-env/eval-in-env/env-lookup/env-extend (+5 tests, 342/342 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 19:13:28 +00:00
16cf4d9316 plans: sx-improvements roadmap + loop briefing (14 steps)
Phases: bug fixes (JIT combinator, letrec+resume), E38 source info
completion, native ADTs (define-type/match), plugin system, performance.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 19:01:23 +00:00
d21cde336a tcl: Phase 3 OCaml primitives — file-read/write/append/exists?/glob + clock-seconds/milliseconds/format in sx_primitives.ml + unix dep; tcl-cmd-clock/file wired up; 337/337 green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 18:10:22 +00:00
f0f339709e tcl: replace eager coroutine pre-execution with true suspension via fibers
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
Rewrote the coroutine implementation to use lib/fiber.sx (make-fiber,
fiber-resume, fiber-done?) instead of eagerly running the proc body and
collecting all yields into a list. Each coroutine is now a live fiber —
calls to the coro command invoke fiber-resume, yield suspends via call/cc.

- make-tcl-interp: remove :coroutines/:in-coro/:coro-yields, add :coro-yield-fn nil
- tcl-cmd-yield: calls :coro-yield-fn (fiber's yield fn) to truly suspend
- tcl-cmd-yieldto: same pattern, yields "" to resumer
- make-coro-cmd: takes fiber (not coro-name), calls fiber-resume on each invoke
- tcl-cmd-coroutine: creates a fiber whose body runs the proc with :coro-yield-fn set
- tcl-call-proc result merge: drop :coro-yields/:coroutines propagation
- test.sh: load lib/fiber.sx before lib/tcl/runtime.sx in epoch 4

All 337/337 tests pass including all 20 coro tests.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 17:30:47 +00:00
0596376199 tcl: Phase 2 fiber.sx — make-fiber/fiber-resume/fiber-done? via call/cc
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 16:58:18 +00:00
35511db15b tcl: array get/set/names/size/exists/unset commands (+8 tests, 337 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 16:29:28 +00:00
40ce4df6b1 tcl: apply command — anonymous proc call reusing tcl-call-proc frame machinery
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
2026-05-06 15:37:26 +00:00
0cc36450c4 tcl: regexp + regsub commands wrapping SX regex primitives
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s
regexp: -nocase/-all/-inline flags, optional matchVar + subgroup var args.
regsub: -all/-nocase flags, optional varName (stores result + returns count)
or inline use (returns result string). Both wrap make-regexp/regexp-match/
regexp-match-all/regexp-replace/regexp-replace-all. 329/329 tests green.
2026-05-06 15:31:36 +00:00
21e8e51174 tcl: float expr — tcl-parse-num + float-aware binop/unary/pow/funcs
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 16s
parse-int "2.0" returns nil in SX (strict integer parse); fixed by adding
tcl-num-float? (char scan for ./e/E) and tcl-parse-num (routes to
parse-float when float-shaped). Applied in tcl-apply-binop (all arith +
comparisons), tcl-apply-func (parse-float for all math args), unary minus,
and tcl-expr-parse-power (**). Real sqrt/floor/ceil/round/pow/sin/cos/tan/
exp/log now used instead of integer stubs. Integer division still truncates
when both operands are integer-shaped. 329/329 tests green.
2026-05-06 15:20:10 +00:00
12 changed files with 1599 additions and 1097 deletions

View File

@@ -703,6 +703,11 @@ let setup_evaluator_bridge env =
| [expr; e] -> Sx_ref.eval_expr expr (Env (Sx_runtime.unwrap_env e)) | [expr; e] -> Sx_ref.eval_expr expr (Env (Sx_runtime.unwrap_env e))
| [expr] -> Sx_ref.eval_expr expr (Env env) | [expr] -> Sx_ref.eval_expr expr (Env env)
| _ -> raise (Eval_error "eval-expr: expected (expr env?)")); | _ -> raise (Eval_error "eval-expr: expected (expr env?)"));
(* eval-in-env: (env expr) → result. Evaluates expr in the given env. *)
Sx_primitives.register "eval-in-env" (fun args ->
match args with
| [e; expr] -> Sx_ref.eval_expr expr e
| _ -> raise (Eval_error "eval-in-env: (env expr)"));
bind "trampoline" (fun args -> bind "trampoline" (fun args ->
match args with match args with
| [v] -> | [v] ->
@@ -764,7 +769,13 @@ let setup_evaluator_bridge env =
| _ -> raise (Eval_error "register-special-form!: expected (name handler)")); | _ -> raise (Eval_error "register-special-form!: expected (name handler)"));
ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms); ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms);
ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args -> ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args ->
List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args)))) List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))));
(* current-env: special form — returns current lexical env as a first-class value *)
ignore (Sx_ref.register_special_form (String "current-env")
(NativeFn ("current-env", fun args ->
match args with
| [_arg_list; env_val] -> env_val
| _ -> Nil)))
(* ---- Type predicates and introspection ---- *) (* ---- Type predicates and introspection ---- *)
let setup_introspection env = let setup_introspection env =
@@ -950,7 +961,24 @@ let setup_env_operations env =
bind "env-has?" (fun args -> match args with [e; String k] -> Bool (Sx_types.env_has (uw e) k) | [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k) | _ -> raise (Eval_error "env-has?: expected env and string")); bind "env-has?" (fun args -> match args with [e; String k] -> Bool (Sx_types.env_has (uw e) k) | [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k) | _ -> raise (Eval_error "env-has?: expected env and string"));
bind "env-bind!" (fun args -> match args with [e; String k; v] -> Sx_types.env_bind (uw e) k v | [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v | _ -> raise (Eval_error "env-bind!: expected env, key, value")); bind "env-bind!" (fun args -> match args with [e; String k; v] -> Sx_types.env_bind (uw e) k v | [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v | _ -> raise (Eval_error "env-bind!: expected env, key, value"));
bind "env-set!" (fun args -> match args with [e; String k; v] -> Sx_types.env_set (uw e) k v | [e; Keyword k; v] -> Sx_types.env_set (uw e) k v | _ -> raise (Eval_error "env-set!: expected env, key, value")); bind "env-set!" (fun args -> match args with [e; String k; v] -> Sx_types.env_set (uw e) k v | [e; Keyword k; v] -> Sx_types.env_set (uw e) k v | _ -> raise (Eval_error "env-set!: expected env, key, value"));
bind "env-extend" (fun args -> match args with [e] -> Env (Sx_types.env_extend (uw e)) | _ -> raise (Eval_error "env-extend: expected env")); bind "env-extend" (fun args ->
match args with
| e :: pairs ->
let child = Sx_types.env_extend (uw e) in
let rec go = function
| [] -> ()
| k :: v :: rest ->
ignore (Sx_types.env_bind child (Sx_runtime.value_to_str k) v); go rest
| [_] -> raise (Eval_error "env-extend: odd number of key-val pairs") in
go pairs; Env child
| _ -> raise (Eval_error "env-extend: expected env"));
bind "env-lookup" (fun args ->
match args with
| [e; key] ->
let k = Sx_runtime.value_to_str key in
let raw = uw e in
if Sx_types.env_has raw k then Sx_types.env_get raw k else Nil
| _ -> raise (Eval_error "env-lookup: (env key)"));
bind "env-merge" (fun args -> match args with [a; b] -> Sx_runtime.env_merge a b | _ -> raise (Eval_error "env-merge: expected 2 envs")) bind "env-merge" (fun args -> match args with [a; b] -> Sx_runtime.env_merge a b | _ -> raise (Eval_error "env-merge: expected 2 envs"))
(* ---- Strict mode (gradual type system support) ---- *) (* ---- Strict mode (gradual type system support) ---- *)

View File

@@ -3138,4 +3138,36 @@ let () =
end end
done; done;
String (Buffer.contents buf) String (Buffer.contents buf)
| _ -> raise (Eval_error "clock-format: (seconds [format])")) | _ -> raise (Eval_error "clock-format: (seconds [format])"));
(* === Env-as-value (Phase 4) === *)
(* env-lookup: (env key) → value or nil. Works on Env, Dict, or Nil. *)
register "env-lookup" (fun args ->
let unwrap = function
| Env e -> e
| Nil -> make_env ()
| _ -> raise (Eval_error "env-lookup: first arg must be an environment") in
match args with
| [env_val; key] ->
let e = unwrap env_val in
let k = value_to_string key in
if env_has e k then env_get e k else Nil
| _ -> raise (Eval_error "env-lookup: (env key)"));
(* env-extend: (env [key val ...]) → new child env with optional bindings. *)
register "env-extend" (fun args ->
match args with
| [] -> raise (Eval_error "env-extend: requires at least one arg")
| env_val :: pairs ->
let parent_env = match env_val with
| Env e -> e
| Nil -> make_env ()
| _ -> raise (Eval_error "env-extend: first arg must be an environment") in
let child = env_extend parent_env in
let rec add_bindings = function
| [] -> ()
| k :: v :: rest -> ignore (env_bind child (value_to_string k) v); add_bindings rest
| [_] -> raise (Eval_error "env-extend: odd number of key-val pairs") in
add_bindings pairs;
Env child)

View File

@@ -539,3 +539,4 @@ let jit_try_call f args =
(match hook f arg_list with Some result -> incr _jit_hit; result | None -> incr _jit_miss; _jit_skip_sentinel) (match hook f arg_list with Some result -> incr _jit_hit; result | None -> incr _jit_miss; _jit_skip_sentinel)
| _ -> incr _jit_skip; _jit_skip_sentinel | _ -> incr _jit_skip; _jit_skip_sentinel

44
lib/fiber.sx Normal file
View File

@@ -0,0 +1,44 @@
; lib/fiber.sx — pure SX fiber library using call/cc
;
; A fiber is a cooperative coroutine with true suspension (no eager
; pre-execution). Each fiber is a dict {:resume fn :done? fn}.
;
; make-fiber body → fiber dict
; body = (fn (yield init-val) ...) — body receives yield + first resume val
; yield = (fn (val) ...) — suspends fiber, returns val to resumer
;
; fiber-resume f v → next yielded value, or nil when body returns
; fiber-done? f → true after body has returned
(define make-fiber
(fn (body)
(let
((resume-k nil)
(caller-k nil)
(done false))
(let
((yield
(fn (val)
(call/cc
(fn (k)
(set! resume-k k)
(caller-k val))))))
{:resume
(fn (val)
(if
done
nil
(call/cc
(fn (k)
(set! caller-k k)
(if
(nil? resume-k)
(begin
(body yield val)
(set! done true)
(k nil))
(resume-k val))))))
:done? (fn () done)}))))
(define fiber-resume (fn (f v) ((get f :resume) v)))
(define fiber-done? (fn (f) ((get f :done?))))

File diff suppressed because it is too large Load Diff

View File

@@ -39,6 +39,7 @@ cat > "$TMPFILE" << EPOCHS
(epoch 3) (epoch 3)
(load "lib/tcl/tests/parse.sx") (load "lib/tcl/tests/parse.sx")
(epoch 4) (epoch 4)
(load "lib/fiber.sx")
(load "lib/tcl/runtime.sx") (load "lib/tcl/runtime.sx")
(epoch 5) (epoch 5)
(load "lib/tcl/tests/eval.sx") (load "lib/tcl/tests/eval.sx")

View File

@@ -95,15 +95,15 @@
(get (run "proc g {} { yield }\ncoroutine cg g\ncg") :result) (get (run "proc g {} { yield }\ncoroutine cg g\ncg") :result)
"") "")
; --- clock seconds stub --- ; --- clock seconds ---
(ok "clock-seconds" (ok "clock-seconds"
(get (run "clock seconds") :result) (> (parse-int (get (run "clock seconds") :result)) 0)
"0") true)
; --- clock milliseconds stub --- ; --- clock milliseconds ---
(ok "clock-milliseconds" (ok "clock-milliseconds"
(get (run "clock milliseconds") :result) (> (parse-int (get (run "clock milliseconds") :result)) 0)
"0") true)
; --- clock format stub --- ; --- clock format stub ---
(ok "clock-format" (ok "clock-format"

View File

@@ -329,6 +329,54 @@
(run "proc with-temp-var {varname tempval body} {\n upvar 1 $varname v\n set saved $v\n set v $tempval\n uplevel 1 $body\n set v $saved\n}\nset x 100\nwith-temp-var x 999 {\n set captured $x\n}\nlist $x $captured") (run "proc with-temp-var {varname tempval body} {\n upvar 1 $varname v\n set saved $v\n set v $tempval\n uplevel 1 $body\n set v $saved\n}\nset x 100\nwith-temp-var x 999 {\n set captured $x\n}\nlist $x $captured")
:result) :result)
"100 999") "100 999")
(ok
"array-set-get"
(get
(run "array set a {x 1 y 2 z 3}; array get a x")
:result)
"x 1")
(ok
"array-names"
(get
(run "array set a {p 10 q 20}; lsort [array names a]")
:result)
"p q")
(ok
"array-size"
(get
(run "array set a {x 1 y 2 z 3}; array size a")
:result)
"3")
(ok
"array-exists-true"
(get
(run "array set a {x 1}; array exists a")
:result)
"1")
(ok
"array-exists-false"
(get
(run "array exists nosucharray")
:result)
"0")
(ok
"array-unset-key"
(get
(run "array set a {x 1 y 2 z 3}; array unset a y; lsort [array names a]")
:result)
"x z")
(ok
"array-scalar-access"
(get
(run "set a(foo) hello; set a(bar) world; set a(foo)")
:result)
"hello")
(ok
"array-get-all"
(get
(run "set a(k) v; set pairs [array get a]; llength $pairs")
:result)
"2")
(dict (dict
"passed" "passed"
tcl-eval-pass tcl-eval-pass

View File

@@ -29,161 +29,164 @@
(define (define
ok ok
(fn (label actual expected) (tcl-idiom-assert label expected actual))) (fn (label actual expected) (tcl-idiom-assert label expected actual)))
(ok
; 1. lmap idiom: accumulate mapped values with foreach+lappend "idiom-lmap"
(ok "idiom-lmap"
(get (get
(run "set result {}\nforeach x {1 2 3} { lappend result [expr {$x * $x}] }\nset result") (run
"set result {}\nforeach x {1 2 3} { lappend result [expr {$x * $x}] }\nset result")
:result) :result)
"1 4 9") "1 4 9")
(ok
; 2. Recursive list flatten "idiom-flatten"
(ok "idiom-flatten"
(get (get
(run (run
"proc flatten {lst} { set out {}\n foreach item $lst {\n if {[llength $item] > 1} {\n foreach sub [flatten $item] { lappend out $sub }\n } else {\n lappend out $item\n }\n }\n return $out\n}\nflatten {1 {2 3} {4 {5 6}}}") "proc flatten {lst} { set out {}\n foreach item $lst {\n if {[llength $item] > 1} {\n foreach sub [flatten $item] { lappend out $sub }\n } else {\n lappend out $item\n }\n }\n return $out\n}\nflatten {1 {2 3} {4 {5 6}}}")
:result) :result)
"1 2 3 4 5 6") "1 2 3 4 5 6")
(ok
; 3. String builder accumulator "idiom-string-builder"
(ok "idiom-string-builder"
(get (get
(run "set buf \"\"\nforeach w {Hello World Tcl} { append buf $w \" \" }\nstring trimright $buf") (run
"set buf \"\"\nforeach w {Hello World Tcl} { append buf $w \" \" }\nstring trimright $buf")
:result) :result)
"Hello World Tcl") "Hello World Tcl")
(ok
; 4. Default parameter via info exists "idiom-default-param"
(ok "idiom-default-param" (get (run "if {![info exists x]} { set x 42 }\nset x") :result)
(get
(run "if {![info exists x]} { set x 42 }\nset x")
:result)
"42") "42")
(ok
; 5. Association list lookup (parallel key/value lists) "idiom-alist-lookup"
(ok "idiom-alist-lookup"
(get (get
(run (run
"set keys {a b c}\nset vals {10 20 30}\nset idx [lsearch $keys b]\nlindex $vals $idx") "set keys {a b c}\nset vals {10 20 30}\nset idx [lsearch $keys b]\nlindex $vals $idx")
:result) :result)
"20") "20")
(ok
; 6. Proc with optional args via args "idiom-optional-args"
(ok "idiom-optional-args"
(get (get
(run (run
"proc greet {name args} {\n set greeting \"Hello\"\n if {[llength $args] > 0} { set greeting [lindex $args 0] }\n return \"$greeting $name\"\n}\ngreet World Hi") "proc greet {name args} {\n set greeting \"Hello\"\n if {[llength $args] > 0} { set greeting [lindex $args 0] }\n return \"$greeting $name\"\n}\ngreet World Hi")
:result) :result)
"Hi World") "Hi World")
(ok
; 7. Builder pattern: dict create from args "idiom-dict-builder"
(ok "idiom-dict-builder"
(get (get
(run (run
"proc build-dict {args} { dict create {*}$args }\ndict get [build-dict name Alice age 30] name") "proc build-dict {args} { dict create {*}$args }\ndict get [build-dict name Alice age 30] name")
:result) :result)
"Alice") "Alice")
(ok
; 8. Loop with index using array "idiom-loop-with-index"
(ok "idiom-loop-with-index"
(get (get
(run (run "set i 0\nforeach x {a b c} { set arr($i) $x; incr i }\nset arr(1)")
"set i 0\nforeach x {a b c} { set arr($i) $x; incr i }\nset arr(1)")
:result) :result)
"b") "b")
(ok
; 9. String reverse via split+lreverse+join "idiom-string-reverse"
(ok "idiom-string-reverse"
(get (get
(run (run
"set s hello\nset chars [split $s \"\"]\nset rev [lreverse $chars]\njoin $rev \"\"") "set s hello\nset chars [split $s \"\"]\nset rev [lreverse $chars]\njoin $rev \"\"")
:result) :result)
"olleh") "olleh")
(ok "idiom-number-format" (get (run "format \"%05d\" 42") :result) "00042")
; 10. Number to padded string (ok
(ok "idiom-number-format" "idiom-dict-comprehension"
(get (run "format \"%05d\" 42") :result)
"00042")
; 11. Dict comprehension pattern
(ok "idiom-dict-comprehension"
(get (get
(run (run
"set squares {}\nforeach n {1 2 3 4} { dict set squares $n [expr {$n * $n}] }\ndict get $squares 3") "set squares {}\nforeach n {1 2 3 4} { dict set squares $n [expr {$n * $n}] }\ndict get $squares 3")
:result) :result)
"9") "9")
(ok
; 12. Stack ADT using list: push/pop "idiom-stack"
(ok "idiom-stack"
(get (get
(run (run
"proc stack-push {stackvar val} { upvar $stackvar s; lappend s $val }\nproc stack-pop {stackvar} { upvar $stackvar s; set val [lindex $s end]; set s [lrange $s 0 end-1]; return $val }\nset stk {}\nstack-push stk 10\nstack-push stk 20\nstack-push stk 30\nstack-pop stk") "proc stack-push {stackvar val} { upvar $stackvar s; lappend s $val }\nproc stack-pop {stackvar} { upvar $stackvar s; set val [lindex $s end]; set s [lrange $s 0 end-1]; return $val }\nset stk {}\nstack-push stk 10\nstack-push stk 20\nstack-push stk 30\nstack-pop stk")
:result) :result)
"30") "30")
(ok
; 13. Queue ADT using list: enqueue/dequeue "idiom-queue"
(ok "idiom-queue"
(get (get
(run (run
"proc q-enq {qvar val} { upvar $qvar q; lappend q $val }\nproc q-deq {qvar} { upvar $qvar q; set val [lindex $q 0]; set q [lrange $q 1 end]; return $val }\nset q {}\nq-enq q alpha\nq-enq q beta\nq-enq q gamma\nq-deq q") "proc q-enq {qvar val} { upvar $qvar q; lappend q $val }\nproc q-deq {qvar} { upvar $qvar q; set val [lindex $q 0]; set q [lrange $q 1 end]; return $val }\nset q {}\nq-enq q alpha\nq-enq q beta\nq-enq q gamma\nq-deq q")
:result) :result)
"alpha") "alpha")
(ok
; 14. Pipeline via proc chaining "idiom-pipeline"
(ok "idiom-pipeline"
(get (get
(run (run
"proc double {x} { expr {$x * 2} }\nproc add1 {x} { expr {$x + 1} }\nproc pipeline {val procs} { foreach p $procs { set val [$p $val] }; return $val }\npipeline 5 {double add1 double}") "proc double {x} { expr {$x * 2} }\nproc add1 {x} { expr {$x + 1} }\nproc pipeline {val procs} { foreach p $procs { set val [$p $val] }; return $val }\npipeline 5 {double add1 double}")
:result) :result)
"22") "22")
(ok
; 15. Memoize pattern using dict (simple cache, not recursive) "idiom-memoize"
(ok "idiom-memoize"
(get (get
(run (run
"set cache {}\nproc cached-square {n} { global cache\n if {[dict exists $cache $n]} { return [dict get $cache $n] }\n set r [expr {$n * $n}]\n dict set cache $n $r\n return $r\n}\nset a [cached-square 7]\nset b [cached-square 7]\nset c [cached-square 8]\nexpr {$a == $b && $c == 64}") "set cache {}\nproc cached-square {n} { global cache\n if {[dict exists $cache $n]} { return [dict get $cache $n] }\n set r [expr {$n * $n}]\n dict set cache $n $r\n return $r\n}\nset a [cached-square 7]\nset b [cached-square 7]\nset c [cached-square 8]\nexpr {$a == $b && $c == 64}")
:result) :result)
"1") "1")
(ok
; 16. Simple expression evaluator in Tcl (recursive descent) "idiom-recursive-eval"
(ok "idiom-recursive-eval"
(get (get
(run (run
"proc calc {expr} { return [::tcl::mathop::+ 0 [expr $expr]] }\nexpr {3 + 4 * 2}") "proc calc {expr} { return [::tcl::mathop::+ 0 [expr $expr]] }\nexpr {3 + 4 * 2}")
:result) :result)
"11") "11")
(ok
; 17. Apply proc to each pair in a dict "idiom-dict-for"
(ok "idiom-dict-for"
(get (get
(run (run
"set d [dict create a 1 b 2 c 3]\nset total 0\ndict for {k v} $d { incr total $v }\nset total") "set d [dict create a 1 b 2 c 3]\nset total 0\ndict for {k v} $d { incr total $v }\nset total")
:result) :result)
"6") "6")
(ok
; 18. Find max in list "idiom-find-max"
(ok "idiom-find-max"
(get (get
(run (run
"proc list-max {lst} {\n set m [lindex $lst 0]\n foreach x $lst { if {$x > $m} { set m $x } }\n return $m\n}\nlist-max {3 1 4 1 5 9 2 6}") "proc list-max {lst} {\n set m [lindex $lst 0]\n foreach x $lst { if {$x > $m} { set m $x } }\n return $m\n}\nlist-max {3 1 4 1 5 9 2 6}")
:result) :result)
"9") "9")
(ok
; 19. Filter list by predicate "idiom-filter-list"
(ok "idiom-filter-list"
(get (get
(run (run
"proc list-filter {lst pred} {\n set out {}\n foreach x $lst { if {[$pred $x]} { lappend out $x } }\n return $out\n}\nproc is-even {n} { expr {$n % 2 == 0} }\nlist-filter {1 2 3 4 5 6} is-even") "proc list-filter {lst pred} {\n set out {}\n foreach x $lst { if {[$pred $x]} { lappend out $x } }\n return $out\n}\nproc is-even {n} { expr {$n % 2 == 0} }\nlist-filter {1 2 3 4 5 6} is-even")
:result) :result)
"2 4 6") "2 4 6")
(ok
; 20. Zip two lists "idiom-zip"
(ok "idiom-zip"
(get (get
(run (run
"proc zip {a b} {\n set out {}\n set n [llength $a]\n for {set i 0} {$i < $n} {incr i} {\n lappend out [lindex $a $i]\n lappend out [lindex $b $i]\n }\n return $out\n}\nzip {1 2 3} {a b c}") "proc zip {a b} {\n set out {}\n set n [llength $a]\n for {set i 0} {$i < $n} {incr i} {\n lappend out [lindex $a $i]\n lappend out [lindex $b $i]\n }\n return $out\n}\nzip {1 2 3} {a b c}")
:result) :result)
"1 a 2 b 3 c") "1 a 2 b 3 c")
(ok
"env-lookup-basic"
(env-lookup (let ((x 42)) (current-env)) "x")
42)
(ok
"env-lookup-missing"
(env-lookup (let ((x 42)) (current-env)) "z")
nil)
(ok
"env-extend-lookup"
(let
((e (let ((x 5)) (current-env))))
(env-lookup (env-extend e "y" 10) "y"))
10)
(ok
"eval-in-env-parent"
(let
((x 5))
(eval-in-env (env-extend (current-env) "y" 10) (quote (+ x y))))
15)
(ok
"eval-in-env-multi"
(let
((base (current-env)))
(eval-in-env
(env-extend (env-extend base "a" 3) "b" 7)
(quote (* a b))))
21)
(dict (dict
"passed" "passed"
tcl-idiom-pass tcl-idiom-pass

View File

@@ -0,0 +1,86 @@
# sx-improvements loop agent
Iterates `plans/sx-improvements.md` forever. One step per commit.
```
description: sx-improvements loop
subagent_type: general-purpose
run_in_background: true
isolation: worktree
```
## Prompt
You are the sole background agent iterating `plans/sx-improvements.md` on the `architecture` branch of `/root/rose-ash`. One step per commit, forever. Never push.
## Restart baseline — check before each iteration
1. Read `plans/sx-improvements.md` — find the first unchecked `[ ]` step in the progress log.
2. Read the step's section in the plan for exact implementation details.
3. Run the verification command for that step to confirm it currently fails.
4. Implement. Verify. Commit. Tick the `[ ]``[x]` in the progress log. Next.
## Test commands
- **OCaml spec:** `sx_build target="ocaml"` then check `bin/run_tests.exe` output.
- **JS spec (no DOM):** `node hosts/javascript/run_tests.js 2>&1 | tail -3`
- **HyperScript kernel:** `node tests/hs-kernel-eval.js 2>&1 | tail -3`
- **Baseline SX tests (non-HS):** `node hosts/javascript/run_tests.js 2>&1 | grep -v "hs-upstream\|hs-compat\|hs-dev" | grep "Results:"`
Do NOT regress the pre-merge passing tests. After each step, confirm the count did not drop.
## Ground rules (hard)
- **Branch:** `architecture`. Never push. Never touch `main`.
- **SX files:** `sx-tree` MCP tools ONLY (`sx_summarise`, `sx_read_subtree`, `sx_replace_node`, `sx_insert_child`, `sx_validate`). Read before edit. Validate after edit.
- **Generated files:** NEVER edit `shared/static/wasm/sx/` or `shared/static/scripts/sx-*.js` directly. Rebuild via `sx_build`.
- **HS mirror rule:** after editing any `lib/hyperscript/<f>.sx`, copy to `shared/static/wasm/sx/hs-<f>.sx` using `sx_write_file` with the same content.
- **OCaml build:** `sx_build target="ocaml"` — never raw `dune exec`.
- **JS build:** `sx_build target="js"`.
- **One step per commit.** Tick the plan. Factual commit message.
- **No new planning docs.** No comments in SX unless non-obvious.
- **Unicode in SX:** raw UTF-8 only, never `\uXXXX` escapes.
## Step-specific notes
### Step 1 (JIT combinator bug)
The bug is in `hosts/ocaml/lib/sx_vm.ml``call_closure_reuse` path strips locals when
callee returns a closure. Look for the path where `call_closure_reuse` is invoked for a
`VmClosure` return value. The fix is to not reuse frames when the call might return a
closure, or to properly snapshot/restore `sp`. Check `spec/tests/test-parser-combinators.sx`
for existing combinator tests; run `node tests/hs-kernel-eval.js` for the 11 failing HS tests.
### Step 2 (letrec+resume)
The bug is browser-only (`hosts/ocaml/browser/sx_browser.ml`). Write a minimal
`spec/tests/test-letrec-resume.sx` that exercises `letrec` + `perform` + resume and
verify it passes under `run_tests.exe` (OCaml server mode). Then check what
`sx_browser.ml` does differently in the VmSuspension resume path.
### Steps 3-4 (E38 source info)
The API is already in `lib/hyperscript/runtime.sx`. The gap is in the tokenizer (no `:end`/`:line`)
and some parser span completeness. Run the 4 sourceInfo tests to see exact failures:
`node tests/hs-kernel-eval.js --suite sourceInfo` or grep results for `sourceInfo`.
### Steps 5-8 (ADTs)
Full spec in `plans/designs/sx-adt.md`. Implement in OCaml first (Step 5), then mirror
to JS (Step 6). Steps 7-8 build on top. Write `spec/tests/test-adt.sx` from scratch —
start with a `(define-type Maybe (Just value) (Nothing))` suite covering constructor,
predicate, accessor, basic match, else clause.
### Steps 9-11 (plugin system)
Full spec in `plans/designs/hs-plugin-system.md`. The prolog hook migration (Step 11) is
the most important for language-building — it's the pattern for all future embeds.
### Steps 12-14 (performance)
Profile first. Use `sx_harness_eval` to measure throughput on a tight loop before and
after each change. Only commit if there's a measurable win (>10%).
## General gotchas (all loops)
- SX `do` is R7RS iteration. Use `begin` for multi-expr sequences.
- `cond`/`when`/`let` bodies evaluate only the last expression.
- `type-of` on a user-defined function returns `"lambda"`.
- Shell heredoc `||` gets eaten — escape or use `case`.
- `env-bind!` creates new bindings; `env-set!` mutates existing (walks scope chain).
- After OCaml edits: the build takes ~2 min. Run `sx_build target="ocaml"` and wait.
- After JS edits: retranspile with `sx_build target="js"` then re-run tests.

210
plans/sx-improvements.md Normal file
View File

@@ -0,0 +1,210 @@
# SX Language Improvements — roadmap
Language-building improvements to the SX evaluator, compiler, and standard library.
Ordered by impact and prerequisite chain. Each step is one loop commit.
Branch: `architecture`. SX files via `sx-tree` MCP only. Never edit generated files.
## Current baseline (2026-05-06)
- SX core spec: 2571 passing (595 non-HS pre-existing failures — bytecode-serialize, defcomp-render, etc.)
- HyperScript behavioral: 1478/1496 (run via `node tests/hs-kernel-eval.js`)
- Active bugs: JIT combinator bug (11 HS failures), letrec+resume (browser-only)
- E38 sourceInfo: 2/4 tests passing (tokenizer missing `:end`/`:line`, some spans incomplete)
---
## Phase 1 — Bug fixes
### Step 1: Fix JIT closures-returning-closures
**What:** `parse-bind`, `many`, `seq`, and other parser combinators that return closures
miscompile under JIT. The compiled closure drops intermediate stack values when the
callee itself returns a closure. 11 HyperScript tests fail under JIT, pass under CEK.
**Root cause in `hosts/ocaml/lib/sx_vm.ml`:** When a JIT-compiled closure returns
another closure (i.e. the callee is `VmClosure`), the frame restoration after the
call incorrectly reuses the parent frame's locals slot, overwriting saved intermediate
values. The `call_closure_reuse` path must snapshot `sp` before the inner call and
restore it after, or bail to the non-reuse path for closures-returning-closures.
**Verify:** `node tests/hs-kernel-eval.js 2>&1 | tail -3` — should go from 3116/3127 to 3127/3127.
### Step 2: Fix letrec + perform resume (browser)
**What:** In browser JIT mode, `letrec` sibling bindings are nil after a `perform`/resume
cycle. `call_closure_reuse` in `sx_browser.ml` intentionally ignores `_saved_sp`, which
strips the frame locals that `sf_letrec` was waiting on.
**Fix:** In `sx_browser.ml`, the `VmSuspension` resume path must restore frame locals
from the suspension snapshot before calling the continuation. Mirror what `sx_vm.ml`
does in the non-browser case.
**Verify:** Write a test in `spec/tests/` that does `(letrec ((f (fn () (perform :io nil)))) (f))` with a resume, check bindings survive. Runs under OCaml: `dune exec -- bin/run_tests.exe`.
---
## Phase 2 — Source info (E38 completion)
Design: `plans/designs/e38-sourceinfo.md`. Target: 4/4 sourceInfo tests.
The API (`hs-parse-ast`, `hs-source-for`, `hs-line-for`, `hs-node-get`, `hs-src`,
`hs-src-at`, `hs-line-at`) and parser span wrapping (`hs-ast-wrap`, `hs-span-mode`)
are already in the codebase. Two tests are passing; two fail because:
- Tokenizer tokens lack `:end` and `:line` (only `:pos` today).
- Some statement-level spans and `:next` field navigation are incomplete.
### Step 3: Tokenizer — add `:end` and `:line` to tokens
`lib/hyperscript/tokenizer.sx`: extend `hs-make-token` to `{:pos :end :value :type :line}`.
Track a `current-line` counter (1-based, increments after `\n`). Update all ~20 emission
sites. Mirror to `shared/static/wasm/sx/hs-tokenizer.sx` after edits.
**Verify:** `(hs-make-token "NUMBER" "1" 0)` returns a dict with `:end` and `:line` keys.
### Step 4: Complete parser spans + :next field
`lib/hyperscript/parser.sx`: ensure `hs-ast-wrap` populates `:next` on every command
in a `CommandList` (i.e. the following sibling command). Check that statement-level
productions (if, for) correctly populate `:true-branch`. Trace through the two failing
tests (`get source works for expressions`, `get line works for statements`) to find the
exact missing fields or off-by-one positions.
Mirror to `shared/static/wasm/sx/hs-parser.sx`.
**Verify:** All 4 `hs-upstream-core/sourceInfo` tests pass.
---
## Phase 3 — Native ADTs (`define-type` / `match`)
Design: `plans/designs/sx-adt.md`. No existing implementation.
Impact: every language implementation (Haskell, Prolog, Lua, Common Lisp, Erlang)
currently fakes sum types with `{:tag "..." :field ...}` dicts. Native ADTs remove
that everywhere.
### Step 5: OCaml — AdtValue type + `define-type` + basic `match`
`hosts/ocaml/lib/sx_types.ml`:
```ocaml
type adt_value = { av_type: string; av_ctor: string; av_fields: value array }
| AdtValue of adt_value
```
`hosts/ocaml/lib/sx_runtime.ml` (or evaluator):
- `step-sf-define-type`: parse `(Name (Ctor1 f1 f2) (Ctor2) ...)`, register constructor
NativeFns, predicates (`Ctor1?`, `Name?`), field accessors (`Ctor1-f1`) via `env-bind!`.
- `step-sf-match` + `MatchFrame`: linear scan of clauses; flat patterns only for 6a;
bind pattern variables in child env; `else` clause; raise on no match.
- `type-of` returns the type name (e.g. `"Maybe"`).
Write tests in `spec/tests/test-adt.sx`: basic constructor, predicate, accessor, match,
else, no-match raise.
**Verify:** `dune exec -- bin/run_tests.exe` — new test file all green.
### Step 6: JS — AdtValue + `define-type` + `match`
`hosts/javascript/platform.py`: add `AdtValue` as `{ _adt: true, _type, _ctor, _fields }`.
Mirror `define-type` and `match` special forms in the JS evaluator.
Retranspile: `python3 hosts/javascript/cli.py --output shared/static/scripts/sx-browser.js`
**Verify:** `node hosts/javascript/run_tests.js` — adt tests pass on JS too.
### Step 7: Nested patterns (Phase 6b)
Both OCaml and JS `MatchFrame`: replace linear binding with recursive
`matchPattern(pattern, value, env)` that:
- Recurses into constructor sub-patterns.
- Returns `{matched: bool, bindings: map}`.
- Handles wildcard `_`, literals (`42`, `"str"`, `true`, `nil`).
Extend `spec/tests/test-adt.sx` with nested pattern tests.
### Step 8: Exhaustiveness warnings (Phase 6c)
`_adt_registry: type_name → [ctor_names]` global populated by `define-type`.
On first non-exhaustive `match` evaluation: `console.warn("[sx] match: non-exhaustive …")`.
No error — warning only.
---
## Phase 4 — Plugin / extension system
Design: `plans/designs/hs-plugin-system.md`.
### Step 9: Parser feature registry
`lib/hyperscript/parser.sx`: replace `parse-feat` hardcoded `cond` with a dict lookup.
`(hs-register-feature! name parse-fn)` adds to the registry.
### Step 10: Compiler command registry + `as` converter registry
`lib/hyperscript/compiler.sx`: replace `hs-to-sx` hardcoded dispatch with dict.
`(hs-register-command! name compile-fn)` and `(hs-register-converter! name convert-fn)`.
### Step 11: Migrate hs-prolog-hook + Worker plugin
`lib/hyperscript/runtime.sx`: remove `hs-prolog-hook`/`hs-set-prolog-hook!` ad-hoc
slots. Create `lib/hyperscript/plugins/prolog.sx` that calls `hs-register-feature!`
and `hs-register-command!`. Create `lib/hyperscript/plugins/worker.sx` replacing the
E39 stub.
---
## Phase 5 — Performance
These are incremental and can interleave with other phases.
### Step 12: Frame records (CEK)
`hosts/ocaml/lib/sx_runtime.ml`: represent CEK frames as OCaml records instead of
tagged variant lists. Eliminates allocation pressure from list construction per frame.
Profile before/after on a tight-loop benchmark.
### Step 13: Buffer primitive for string building
Add `make-buffer`, `buffer-append!`, `buffer->string` primitives. Eliminates the
`(str a b c d ...)` quadratic allocation pattern in serializers and renderers.
Wire into `sx_primitives.ml` and the JS platform.
### Step 14: Inline common primitives in JIT
`hosts/ocaml/lib/sx_vm.ml`: add `OP_ADD`, `OP_SUB`, `OP_EQ`, `OP_APPEND` specialised
opcodes that skip the primitive table lookup for the most common calls. Compiler emits
these when operands are known numbers/lists.
---
## Progress log
| Step | Status | Commit |
|------|--------|--------|
| 1 — JIT combinator bug | [ ] | — |
| 2 — letrec+resume | [ ] | — |
| 3 — tokenizer :end/:line | [ ] | — |
| 4 — parser spans complete | [ ] | — |
| 5 — OCaml AdtValue + define-type + match | [ ] | — |
| 6 — JS AdtValue + define-type + match | [ ] | — |
| 7 — nested patterns | [ ] | — |
| 8 — exhaustiveness warnings | [ ] | — |
| 9 — parser feature registry | [ ] | — |
| 10 — compiler + as converter registry | [ ] | — |
| 11 — plugin migration + worker | [ ] | — |
| 12 — frame records | [ ] | — |
| 13 — buffer primitive | [ ] | — |
| 14 — inline primitives JIT | [ ] | — |
---
## Rules
- Branch: `architecture`. Never push to `main`.
- SX files: `sx-tree` MCP tools only. `sx_validate` after every edit.
- After every `.sx` edit to `lib/hyperscript/`, mirror to `shared/static/wasm/sx/hs-<file>.sx`.
- OCaml build: `sx_build target="ocaml"` MCP tool (never raw `dune`).
- JS build: `sx_build target="js"` MCP tool.
- One step per commit. Update progress log in this file.
- No new planning docs. No comments in SX unless non-obvious.
- Unicode in SX: raw UTF-8 only, never `\uXXXX`.

View File

@@ -105,7 +105,9 @@ just Tcl.
--- ---
## Phase 4 — Optional: env-as-value (architectural) ## Phase 4 — env-as-value (architectural)
`uplevel`/`upvar` required an explicit frame stack because SX environments `uplevel`/`upvar` required an explicit frame stack because SX environments
aren't inspectable from user code. Adding: aren't inspectable from user code. Adding:
@@ -146,6 +148,7 @@ becomes a lasting SX contribution used by every future hosted language.
_Newest first._ _Newest first._
- 2026-05-06: Phase 4 env-as-value — current-env (special form via Sx_ref.register_special_form), eval-in-env (primitive in setup_evaluator_bridge), env-lookup + env-extend (in setup_env_operations); 5 idiom tests; 342/342 green
- 2026-05-06: Phase 3 OCaml primitives — file-read/write/append/exists?/glob + clock-seconds/milliseconds/format in sx_primitives.ml + unix dep; tcl-cmd-clock/file wired up; 337/337 green - 2026-05-06: Phase 3 OCaml primitives — file-read/write/append/exists?/glob + clock-seconds/milliseconds/format in sx_primitives.ml + unix dep; tcl-cmd-clock/file wired up; 337/337 green
- 2026-05-06: Phase 2 coroutine rewrite — `tcl-cmd-coroutine` now creates a `make-fiber`; `tcl-cmd-yield` calls `:coro-yield-fn` (threaded through interp); true suspension; 337/337 green - 2026-05-06: Phase 2 coroutine rewrite — `tcl-cmd-coroutine` now creates a `make-fiber`; `tcl-cmd-yield` calls `:coro-yield-fn` (threaded through interp); true suspension; 337/337 green
- 2026-05-06: Phase 2 fiber.sx — `make-fiber`/`fiber-resume`/`fiber-done?` using call/cc + set!; bidirectional value passing; generator and echo tests pass - 2026-05-06: Phase 2 fiber.sx — `make-fiber`/`fiber-resume`/`fiber-done?` using call/cc + set!; bidirectional value passing; generator and echo tests pass