briefing: push to origin/loops/apl after each commit

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/apl/parser.sx

@@ -0,0 +1,436 @@
+; APL Parser — right-to-left expression parser
+;
+; Takes a token list (output of apl-tokenize) and produces an AST.
+; APL evaluates right-to-left with no precedence among functions.
+; Operators bind to the function immediately to their left in the source.
+;
+; AST node types:
+;   (:num n)                     number literal
+;   (:str s)                     string literal
+;   (:vec n1 n2 ...)             strand (juxtaposed literals)
+;   (:name "x")                  name reference / alpha / omega
+;   (:assign "x" expr)           assignment  x←expr
+;   (:monad fn arg)              monadic function call
+;   (:dyad fn left right)        dyadic function call
+;   (:derived-fn op fn)          derived function: f/ f¨ f⍨
+;   (:derived-fn2 "." f g)       inner product: f.g
+;   (:outer "∘." fn)             outer product: ∘.f
+;   (:fn-glyph "⍳")             function reference
+;   (:fn-name "foo")             named-function reference (dfn variable)
+;   (:dfn stmt...)               {⍺+⍵} anonymous function
+;   (:guard cond expr)           cond:expr guard inside dfn
+;   (:program stmt...)           multi-statement sequence
+
+; ============================================================
+; Glyph classification sets
+; ============================================================
+
+(define apl-parse-op-glyphs
+  (list "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))
+
+(define apl-parse-fn-glyphs
+  (list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~"
+        "<" "≤" "=" "≥" ">" "≠" "∊" "∧" "∨" "⍱" "⍲"
+        "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
+        "∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕"))
+
+(define apl-parse-op-glyph?
+  (fn (v)
+    (some (fn (g) (= g v)) apl-parse-op-glyphs)))
+
+(define apl-parse-fn-glyph?
+  (fn (v)
+    (some (fn (g) (= g v)) apl-parse-fn-glyphs)))
+
+; ============================================================
+; Token accessors
+; ============================================================
+
+(define tok-type
+  (fn (tok)
+    (get tok :type)))
+
+(define tok-val
+  (fn (tok)
+    (get tok :value)))
+
+(define is-op-tok?
+  (fn (tok)
+    (and (= (tok-type tok) :glyph)
+         (apl-parse-op-glyph? (tok-val tok)))))
+
+(define is-fn-tok?
+  (fn (tok)
+    (and (= (tok-type tok) :glyph)
+         (apl-parse-fn-glyph? (tok-val tok)))))
+
+; ============================================================
+; Collect trailing operators starting at index i
+; Returns {:ops (op ...) :end new-i}
+; ============================================================
+
+(define collect-ops
+  (fn (tokens i)
+    (collect-ops-loop tokens i (list))))
+
+(define collect-ops-loop
+  (fn (tokens i acc)
+    (if (>= i (len tokens))
+      {:ops acc :end i}
+      (let ((tok (nth tokens i)))
+        (if (is-op-tok? tok)
+          (collect-ops-loop tokens (+ i 1) (append acc (tok-val tok)))
+          {:ops acc :end i})))))
+
+; ============================================================
+; Build a derived-fn node by chaining operators left-to-right
+; (+/¨  →  (:derived-fn "¨" (:derived-fn "/" (:fn-glyph "+"))))
+; ============================================================
+
+(define build-derived-fn
+  (fn (fn-node ops)
+    (if (= (len ops) 0)
+      fn-node
+      (build-derived-fn
+        (list :derived-fn (first ops) fn-node)
+        (rest ops)))))
+
+; ============================================================
+; Find matching close bracket/paren/brace
+; Returns the index of the matching close token
+; ============================================================
+
+(define find-matching-close
+  (fn (tokens start open-type close-type)
+    (find-matching-close-loop tokens start open-type close-type 1)))
+
+(define find-matching-close-loop
+  (fn (tokens i open-type close-type depth)
+    (if (>= i (len tokens))
+      (len tokens)
+      (let ((tt (tok-type (nth tokens i))))
+        (cond
+          ((= tt open-type)
+           (find-matching-close-loop tokens (+ i 1) open-type close-type (+ depth 1)))
+          ((= tt close-type)
+           (if (= depth 1)
+             i
+             (find-matching-close-loop tokens (+ i 1) open-type close-type (- depth 1))))
+          (true
+           (find-matching-close-loop tokens (+ i 1) open-type close-type depth)))))))
+
+; ============================================================
+; Segment collection: scan tokens left-to-right, building
+; a list of {:kind "val"/"fn" :node ast} segments.
+; Operators following function glyphs are merged into
+; derived-fn nodes during this pass.
+; ============================================================
+
+(define collect-segments
+  (fn (tokens)
+    (collect-segments-loop tokens 0 (list))))
+
+(define collect-segments-loop
+  (fn (tokens i acc)
+    (if (>= i (len tokens))
+      acc
+      (let ((tok (nth tokens i))
+            (n   (len tokens)))
+        (let ((tt (tok-type tok))
+              (tv (tok-val tok)))
+          (cond
+            ; Skip separators
+            ((or (= tt :diamond) (= tt :newline) (= tt :semi))
+             (collect-segments-loop tokens (+ i 1) acc))
+
+            ; Number → value segment
+            ((= tt :num)
+             (collect-segments-loop tokens (+ i 1)
+               (append acc {:kind "val" :node (list :num tv)})))
+
+            ; String → value segment
+            ((= tt :str)
+             (collect-segments-loop tokens (+ i 1)
+               (append acc {:kind "val" :node (list :str tv)})))
+
+            ; Name → always a value segment in Phase 1
+            ; (Named functions with operators like f/ are Phase 5)
+            ((= tt :name)
+             (collect-segments-loop tokens (+ i 1)
+               (append acc {:kind "val" :node (list :name tv)})))
+
+
+            ; Left paren → parse subexpression recursively
+            ((= tt :lparen)
+             (let ((end (find-matching-close tokens (+ i 1) :lparen :rparen)))
+               (let ((inner-tokens (slice tokens (+ i 1) end))
+                     (after (+ end 1)))
+                 (collect-segments-loop tokens after
+                   (append acc {:kind "val" :node (parse-apl-expr inner-tokens)})))))
+
+            ; Left brace → dfn
+            ((= tt :lbrace)
+             (let ((end (find-matching-close tokens (+ i 1) :lbrace :rbrace)))
+               (let ((inner-tokens (slice tokens (+ i 1) end))
+                     (after (+ end 1)))
+                 (collect-segments-loop tokens after
+                   (append acc {:kind "fn" :node (parse-dfn inner-tokens)})))))
+
+            ; Glyph token — need to classify
+            ((= tt :glyph)
+             (cond
+               ; Alpha (⍺) and Omega (⍵) → values inside dfn context
+               ((or (= tv "⍺") (= tv "⍵"))
+                (collect-segments-loop tokens (+ i 1)
+                  (append acc {:kind "val" :node (list :name tv)})))
+
+               ; Nabla (∇) → self-reference function in dfn context
+               ((= tv "∇")
+                (collect-segments-loop tokens (+ i 1)
+                  (append acc {:kind "fn" :node (list :fn-glyph "∇")})))
+
+               ; ∘. → outer product (special case: ∘ followed by .)
+               ((and (= tv "∘")
+                     (< (+ i 1) n)
+                     (= (tok-val (nth tokens (+ i 1))) "."))
+                (if (and (< (+ i 2) n) (is-fn-tok? (nth tokens (+ i 2))))
+                  (let ((fn-tv (tok-val (nth tokens (+ i 2)))))
+                    (let ((op-result (collect-ops tokens (+ i 3))))
+                      (let ((ops (get op-result :ops))
+                            (ni  (get op-result :end)))
+                        (let ((fn-node (build-derived-fn (list :fn-glyph fn-tv) ops)))
+                          (collect-segments-loop tokens ni
+                            (append acc {:kind "fn" :node (list :outer "∘." fn-node)}))))))
+                  ; ∘. without function — treat ∘ as plain compose operator
+                  ; skip the . and continue
+                  (collect-segments-loop tokens (+ i 1)
+                    acc)))
+
+               ; Function glyph — collect following operators
+               ((apl-parse-fn-glyph? tv)
+                (let ((op-result (collect-ops tokens (+ i 1))))
+                  (let ((ops (get op-result :ops))
+                        (ni  (get op-result :end)))
+                    ; Check for inner product: fn . fn
+                    ; (ops = ("." ) and next token is also a function glyph)
+                    (if (and (= (len ops) 1)
+                             (= (first ops) ".")
+                             (< ni n)
+                             (is-fn-tok? (nth tokens ni)))
+                      ; f.g inner product
+                      (let ((g-tv (tok-val (nth tokens ni))))
+                        (let ((op-result2 (collect-ops tokens (+ ni 1))))
+                          (let ((ops2 (get op-result2 :ops))
+                                (ni2  (get op-result2 :end)))
+                            (let ((g-node (build-derived-fn (list :fn-glyph g-tv) ops2)))
+                              (collect-segments-loop tokens ni2
+                                (append acc {:kind "fn"
+                                             :node (list :derived-fn2 "." (list :fn-glyph tv) g-node)}))))))
+                      ; Regular function with zero or more operator modifiers
+                      (let ((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
+                        (collect-segments-loop tokens ni
+                          (append acc {:kind "fn" :node fn-node})))))))
+
+               ; Stray operator glyph — skip (shouldn't appear outside function context)
+               ((apl-parse-op-glyph? tv)
+                (collect-segments-loop tokens (+ i 1) acc))
+
+               ; Unknown glyph — skip
+               (true
+                (collect-segments-loop tokens (+ i 1) acc))))
+
+            ; Skip unknown token types
+            (true
+             (collect-segments-loop tokens (+ i 1) acc))))))))
+
+; ============================================================
+; Build tree from segment list
+;
+; The segments are in left-to-right order.
+; APL evaluates right-to-left, so the LEFTMOST function is
+; the outermost (last-evaluated) node.
+;
+; Patterns:
+;   [val]              → val node
+;   [fn val ...]       → (:monad fn (build-tree rest))
+;   [val fn val ...]   → (:dyad fn val (build-tree rest))
+;   [val val ...]      → (:vec val1 val2 ...) — strand
+; ============================================================
+
+; Find the index of the first function segment (returns -1 if none)
+(define find-first-fn
+  (fn (segs)
+    (find-first-fn-loop segs 0)))
+
+(define find-first-fn-loop
+  (fn (segs i)
+    (if (>= i (len segs))
+      -1
+      (if (= (get (nth segs i) :kind) "fn")
+        i
+        (find-first-fn-loop segs (+ i 1))))))
+
+; Build an array node from 0..n value segments
+; If n=1 → return that segment's node
+; If n>1 → return (:vec node1 node2 ...)
+(define segs-to-array
+  (fn (segs)
+    (if (= (len segs) 1)
+      (get (first segs) :node)
+      (cons :vec (map (fn (s) (get s :node)) segs)))))
+
+(define build-tree
+  (fn (segs)
+    (cond
+      ; Empty → nil
+      ((= (len segs) 0) nil)
+      ; Single segment → return its node directly
+      ((= (len segs) 1) (get (first segs) :node))
+      ; All values → strand
+      ((every? (fn (s) (= (get s :kind) "val")) segs)
+       (segs-to-array segs))
+      ; Find the first function segment
+      (true
+       (let ((fn-idx (find-first-fn segs)))
+         (cond
+           ; No function found (shouldn't happen given above checks) → strand
+           ((= fn-idx -1) (segs-to-array segs))
+           ; Function is first → monadic call
+           ((= fn-idx 0)
+            (list :monad
+                  (get (first segs) :node)
+                  (build-tree (rest segs))))
+           ; Function at position fn-idx: left args are segs[0..fn-idx-1]
+           (true
+            (let ((left-segs  (slice segs 0 fn-idx))
+                  (fn-seg     (nth segs fn-idx))
+                  (right-segs (slice segs (+ fn-idx 1))))
+              (list :dyad
+                    (get fn-seg :node)
+                    (segs-to-array left-segs)
+                    (build-tree right-segs))))))))))
+
+
+; ============================================================
+; Split token list on statement separators (diamond / newline)
+; Only splits at depth 0 (ignores separators inside { } or ( ) )
+; ============================================================
+
+(define split-statements
+  (fn (tokens)
+    (split-statements-loop tokens (list) (list) 0)))
+
+(define split-statements-loop
+  (fn (tokens current-stmt acc depth)
+    (if (= (len tokens) 0)
+      (if (> (len current-stmt) 0)
+        (append acc (list current-stmt))
+        acc)
+      (let ((tok (first tokens))
+            (rest-toks (rest tokens))
+            (tt (tok-type (first tokens))))
+        (cond
+          ; Open brackets increase depth
+          ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
+           (split-statements-loop rest-toks (append current-stmt tok) acc (+ depth 1)))
+          ; Close brackets decrease depth
+          ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
+           (split-statements-loop rest-toks (append current-stmt tok) acc (- depth 1)))
+          ; Separators only split at top level (depth = 0)
+          ((and (> depth 0) (or (= tt :diamond) (= tt :newline)))
+           (split-statements-loop rest-toks (append current-stmt tok) acc depth))
+          ((and (= depth 0) (or (= tt :diamond) (= tt :newline)))
+           (if (> (len current-stmt) 0)
+             (split-statements-loop rest-toks (list) (append acc (list current-stmt)) depth)
+             (split-statements-loop rest-toks (list) acc depth)))
+          ; All other tokens go into current statement
+          (true
+           (split-statements-loop rest-toks (append current-stmt tok) acc depth)))))))
+
+; ============================================================
+; Parse a dfn body (tokens between { and })
+; Handles guard expressions: cond : expr
+; ============================================================
+
+(define parse-dfn
+  (fn (tokens)
+    (let ((stmt-groups (split-statements tokens)))
+      (let ((stmts (map parse-dfn-stmt stmt-groups)))
+        (cons :dfn stmts)))))
+
+(define parse-dfn-stmt
+  (fn (tokens)
+    ; Check for guard: expr : expr
+    ; A guard has a :colon token not inside parens/braces
+    (let ((colon-idx (find-top-level-colon tokens 0)))
+      (if (>= colon-idx 0)
+        ; Guard: cond : expr
+        (let ((cond-tokens (slice tokens 0 colon-idx))
+              (body-tokens (slice tokens (+ colon-idx 1))))
+          (list :guard
+                (parse-apl-expr cond-tokens)
+                (parse-apl-expr body-tokens)))
+        ; Regular statement
+        (parse-stmt tokens)))))
+
+(define find-top-level-colon
+  (fn (tokens i)
+    (find-top-level-colon-loop tokens i 0)))
+
+(define find-top-level-colon-loop
+  (fn (tokens i depth)
+    (if (>= i (len tokens))
+      -1
+      (let ((tok (nth tokens i))
+            (tt  (tok-type (nth tokens i))))
+        (cond
+          ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
+           (find-top-level-colon-loop tokens (+ i 1) (+ depth 1)))
+          ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
+           (find-top-level-colon-loop tokens (+ i 1) (- depth 1)))
+          ((and (= tt :colon) (= depth 0))
+           i)
+          (true
+           (find-top-level-colon-loop tokens (+ i 1) depth)))))))
+
+; ============================================================
+; Parse a single statement (assignment or expression)
+; ============================================================
+
+(define parse-stmt
+  (fn (tokens)
+    (if (and (>= (len tokens) 2)
+             (= (tok-type (nth tokens 0)) :name)
+             (= (tok-type (nth tokens 1)) :assign))
+      ; Assignment: name ← expr
+      (list :assign
+            (tok-val (nth tokens 0))
+            (parse-apl-expr (slice tokens 2)))
+      ; Expression
+      (parse-apl-expr tokens))))
+
+; ============================================================
+; Parse an expression from a flat token list
+; ============================================================
+
+(define parse-apl-expr
+  (fn (tokens)
+    (let ((segs (collect-segments tokens)))
+      (if (= (len segs) 0)
+        nil
+        (build-tree segs)))))
+
+; ============================================================
+; Main entry point
+; parse-apl: string → AST
+; ============================================================
+
+(define parse-apl
+  (fn (src)
+    (let ((tokens (apl-tokenize src)))
+      (let ((stmt-groups (split-statements tokens)))
+        (if (= (len stmt-groups) 0)
+          nil
+          (if (= (len stmt-groups) 1)
+            (parse-stmt (first stmt-groups))
+            (cons :program (map parse-stmt stmt-groups))))))))

lib/apl/runtime.sx

@@ -0,0 +1,349 @@
+; APL Runtime — array model + scalar primitives
+;
+; Array = SX dict {:shape (d1 d2 ...) :ravel (v1 v2 ...)}
+; Scalar: rank 0, shape (), one element in ravel
+; Vector: rank 1, shape (n), n elements in ravel
+; Matrix: rank 2, shape (r c), r*c elements in ravel
+
+; ============================================================
+; Array constructors
+; ============================================================
+
+(define make-array (fn (shape ravel) {:ravel ravel :shape shape}))
+
+(define apl-scalar (fn (v) {:ravel (list v) :shape (list)}))
+
+(define apl-vector (fn (elems) {:ravel elems :shape (list (len elems))}))
+
+; enclose — wrap any value in a rank-0 box
+(define enclose (fn (v) (apl-scalar v)))
+
+; disclose — unwrap rank-0 box, returning the first element
+(define disclose (fn (arr) (first (get arr :ravel))))
+
+; ============================================================
+; Array accessors
+; ============================================================
+
+(define array-rank (fn (arr) (len (get arr :shape))))
+
+(define scalar? (fn (arr) (= (len (get arr :shape)) 0)))
+
+(define array-ref (fn (arr i) (nth (get arr :ravel) i)))
+
+; ============================================================
+; System variables
+; ============================================================
+
+(define apl-io 1)
+
+; ============================================================
+; Broadcast engine
+; ============================================================
+
+(define
+  broadcast-monadic
+  (fn (f arr) (make-array (get arr :shape) (map f (get arr :ravel)))))
+
+(define
+  broadcast-dyadic
+  (fn
+    (f a b)
+    (cond
+      ((and (scalar? a) (scalar? b))
+        (apl-scalar (f (first (get a :ravel)) (first (get b :ravel)))))
+      ((scalar? a)
+        (let
+          ((sv (first (get a :ravel))))
+          (make-array
+            (get b :shape)
+            (map (fn (x) (f sv x)) (get b :ravel)))))
+      ((scalar? b)
+        (let
+          ((sv (first (get b :ravel))))
+          (make-array
+            (get a :shape)
+            (map (fn (x) (f x sv)) (get a :ravel)))))
+      (else
+        (if
+          (equal? (get a :shape) (get b :shape))
+          (make-array (get a :shape) (map f (get a :ravel) (get b :ravel)))
+          (error "length error: shape mismatch"))))))
+
+; ============================================================
+; Arithmetic primitives
+; ============================================================
+
+; Monadic + : identity
+(define apl-plus-m (fn (a) (broadcast-monadic (fn (x) x) a)))
+
+; Dyadic +
+(define apl-add (fn (a b) (broadcast-dyadic (fn (x y) (+ x y)) a b)))
+
+; Monadic - : negate
+(define apl-neg-m (fn (a) (broadcast-monadic (fn (x) (- 0 x)) a)))
+
+; Dyadic -
+(define apl-sub (fn (a b) (broadcast-dyadic (fn (x y) (- x y)) a b)))
+
+; Monadic × : signum
+(define
+  apl-signum
+  (fn
+    (a)
+    (broadcast-monadic
+      (fn (x) (cond ((> x 0) 1) ((< x 0) -1) (else 0)))
+      a)))
+
+; Dyadic ×
+(define apl-mul (fn (a b) (broadcast-dyadic (fn (x y) (* x y)) a b)))
+
+; Monadic ÷ : reciprocal
+(define apl-recip (fn (a) (broadcast-monadic (fn (x) (/ 1 x)) a)))
+
+; Dyadic ÷
+(define apl-div (fn (a b) (broadcast-dyadic (fn (x y) (/ x y)) a b)))
+
+; Monadic ⌈ : ceiling
+(define apl-ceil (fn (a) (broadcast-monadic (fn (x) (ceil x)) a)))
+
+; Dyadic ⌈ : max
+(define
+  apl-max
+  (fn (a b) (broadcast-dyadic (fn (x y) (if (>= x y) x y)) a b)))
+
+; Monadic ⌊ : floor
+(define apl-floor (fn (a) (broadcast-monadic (fn (x) (floor x)) a)))
+
+; Dyadic ⌊ : min
+(define
+  apl-min
+  (fn (a b) (broadcast-dyadic (fn (x y) (if (<= x y) x y)) a b)))
+
+; Monadic * : e^x
+(define apl-exp (fn (a) (broadcast-monadic (fn (x) (exp x)) a)))
+
+; Dyadic * : power
+(define apl-pow (fn (a b) (broadcast-dyadic (fn (x y) (pow x y)) a b)))
+
+; Monadic ⍟ : natural log
+(define apl-ln (fn (a) (broadcast-monadic (fn (x) (log x)) a)))
+
+; Dyadic ⍟ : log base (a⍟b = log base a of b)
+(define
+  apl-log
+  (fn (a b) (broadcast-dyadic (fn (x y) (/ (log y) (log x))) a b)))
+
+; Monadic | : absolute value
+(define
+  apl-abs
+  (fn (a) (broadcast-monadic (fn (x) (if (< x 0) (- 0 x) x)) a)))
+
+; Dyadic | : modulo (a|b = b mod a)
+(define
+  apl-mod
+  (fn
+    (a b)
+    (broadcast-dyadic
+      (fn (x y) (if (= x 0) y (- y (* x (floor (/ y x))))))
+      a
+      b)))
+
+; Monadic ! : factorial
+(define
+  apl-fact
+  (fn
+    (a)
+    (broadcast-monadic
+      (fn
+        (n)
+        (let
+          ((loop nil))
+          (begin
+            (set!
+              loop
+              (fn (i acc) (if (> i n) acc (loop (+ i 1) (* acc i)))))
+            (loop 1 1))))
+      a)))
+
+; Dyadic ! : binomial coefficient n!k  (a=n, b=k => a choose b)
+(define
+  apl-binomial
+  (fn
+    (a b)
+    (broadcast-dyadic
+      (fn
+        (n k)
+        (let
+          ((loop nil))
+          (begin
+            (set!
+              loop
+              (fn
+                (i num den)
+                (if
+                  (> i k)
+                  (/ num den)
+                  (loop (+ i 1) (* num (- (+ n 1) i)) (* den i)))))
+            (loop 1 1 1))))
+      a
+      b)))
+
+; Monadic ○ : pi times x
+(define
+  apl-pi-times
+  (fn (a) (broadcast-monadic (fn (x) (* 3.14159 x)) a)))
+
+; Dyadic ○ : trig functions (a○b, a=code, b=value)
+(define
+  apl-trig
+  (fn
+    (a b)
+    (broadcast-dyadic
+      (fn
+        (n x)
+        (cond
+          ((= n 0) (pow (- 1 (* x x)) 0.5))
+          ((= n 1) (sin x))
+          ((= n 2) (cos x))
+          ((= n 3) (tan x))
+          ((= n -1) (asin x))
+          ((= n -2) (acos x))
+          ((= n -3) (atan x))
+          (else (error "circle: unsupported trig code"))))
+      a
+      b)))
+
+; ============================================================
+; Comparison primitives (return 0 or 1)
+; ============================================================
+
+(define
+  apl-lt
+  (fn (a b) (broadcast-dyadic (fn (x y) (if (< x y) 1 0)) a b)))
+
+(define
+  apl-le
+  (fn (a b) (broadcast-dyadic (fn (x y) (if (<= x y) 1 0)) a b)))
+
+(define
+  apl-eq
+  (fn (a b) (broadcast-dyadic (fn (x y) (if (= x y) 1 0)) a b)))
+
+(define
+  apl-ge
+  (fn (a b) (broadcast-dyadic (fn (x y) (if (>= x y) 1 0)) a b)))
+
+(define
+  apl-gt
+  (fn (a b) (broadcast-dyadic (fn (x y) (if (> x y) 1 0)) a b)))
+
+(define
+  apl-ne
+  (fn (a b) (broadcast-dyadic (fn (x y) (if (= x y) 0 1)) a b)))
+
+; ============================================================
+; Logical primitives
+; ============================================================
+
+; Monadic ~ : logical not
+(define
+  apl-not
+  (fn (a) (broadcast-monadic (fn (x) (if (= x 0) 1 0)) a)))
+
+; Dyadic ∧ : logical and
+(define
+  apl-and
+  (fn
+    (a b)
+    (broadcast-dyadic
+      (fn (x y) (if (and (not (= x 0)) (not (= y 0))) 1 0))
+      a
+      b)))
+
+; Dyadic ∨ : logical or
+(define
+  apl-or
+  (fn
+    (a b)
+    (broadcast-dyadic
+      (fn (x y) (if (or (not (= x 0)) (not (= y 0))) 1 0))
+      a
+      b)))
+
+; Dyadic ⍱ : logical nor
+(define
+  apl-nor
+  (fn
+    (a b)
+    (broadcast-dyadic
+      (fn (x y) (if (or (not (= x 0)) (not (= y 0))) 0 1))
+      a
+      b)))
+
+; Dyadic ⍲ : logical nand
+(define
+  apl-nand
+  (fn
+    (a b)
+    (broadcast-dyadic
+      (fn (x y) (if (and (not (= x 0)) (not (= y 0))) 0 1))
+      a
+      b)))
+
+; ============================================================
+; Shape primitives
+; ============================================================
+
+; Monadic ⍴ : shape — returns shape as a vector array
+(define apl-shape (fn (arr) (apl-vector (get arr :shape))))
+
+; Monadic , : ravel — returns a rank-1 vector of all elements
+(define apl-ravel (fn (arr) (apl-vector (get arr :ravel))))
+
+; Monadic ≢ : tally — first dimension (1 for scalar)
+(define
+  apl-tally
+  (fn
+    (arr)
+    (if
+      (scalar? arr)
+      (apl-scalar 1)
+      (apl-scalar (first (get arr :shape))))))
+
+; Monadic ≡ : depth
+; simple number/string value → 0
+; array containing only non-arrays → 0
+; array containing arrays → 1 + max depth of elements
+(define
+  apl-depth
+  (fn
+    (arr)
+    (define item-depth nil)
+    (set!
+      item-depth
+      (fn
+        (v)
+        (if
+          (and
+            (dict? v)
+            (not (= nil (get v :shape nil)))
+            (not (= nil (get v :ravel nil))))
+          (+ 1 (first (get (apl-depth v) :ravel)))
+          0)))
+    (let
+      ((depths (map item-depth (get arr :ravel))))
+      (apl-scalar (reduce (fn (a b) (if (> a b) a b)) 0 depths)))))
+
+; Monadic ⍳ : iota — vector 1..n (with ⎕IO=1)
+(define
+  apl-iota
+  (fn
+    (n-arr)
+    (let
+      ((n (first (get n-arr :ravel))) (build nil))
+      (begin
+        (set!
+          build
+          (fn (i acc) (if (< i 1) acc (build (- i 1) (cons i acc)))))
+        (apl-vector (build n (list)))))))

lib/apl/tests/parse.sx

@@ -0,0 +1,340 @@
+(define apl-test-count 0)
+(define apl-test-pass  0)
+(define apl-test-fails (list))
+
+(define apl-test
+  (fn (name actual expected)
+    (begin
+      (set! apl-test-count (+ apl-test-count 1))
+      (if (= actual expected)
+        (set! apl-test-pass (+ apl-test-pass 1))
+        (append! apl-test-fails {:name name :actual actual :expected expected})))))
+
+(define tok-types
+  (fn (src)
+    (map (fn (t) (get t :type)) (apl-tokenize src))))
+
+(define tok-values
+  (fn (src)
+    (map (fn (t) (get t :value)) (apl-tokenize src))))
+
+(define tok-count
+  (fn (src)
+    (len (apl-tokenize src))))
+
+(define tok-type-at
+  (fn (src i)
+    (get (nth (apl-tokenize src) i) :type)))
+
+(define tok-value-at
+  (fn (src i)
+    (get (nth (apl-tokenize src) i) :value)))
+
+(apl-test "empty: no tokens"        (tok-count "")           0)
+(apl-test "empty: whitespace only"  (tok-count "   ")        0)
+(apl-test "num: zero"               (tok-values "0")         (list 0))
+(apl-test "num: positive"           (tok-values "42")        (list 42))
+(apl-test "num: large"              (tok-values "12345")     (list 12345))
+(apl-test "num: negative"           (tok-values "¯5")        (list -5))
+(apl-test "num: negative zero"      (tok-values "¯0")        (list 0))
+(apl-test "num: strand count"       (tok-count "1 2 3")      3)
+(apl-test "num: strand types"       (tok-types "1 2 3")      (list :num :num :num))
+(apl-test "num: strand values"      (tok-values "1 2 3")     (list 1 2 3))
+(apl-test "num: neg in strand"      (tok-values "1 ¯2 3")    (list 1 -2 3))
+(apl-test "str: empty"              (tok-values "''")        (list ""))
+(apl-test "str: single char"        (tok-values "'a'")       (list "a"))
+(apl-test "str: word"               (tok-values "'hello'")   (list "hello"))
+(apl-test "str: escaped quote"      (tok-values "''''")      (list "'"))
+(apl-test "str: type"               (tok-types "'abc'")      (list :str))
+(apl-test "name: simple"            (tok-values "foo")       (list "foo"))
+(apl-test "name: type"              (tok-types "foo")        (list :name))
+(apl-test "name: mixed case"        (tok-values "MyVar")     (list "MyVar"))
+(apl-test "name: with digits"       (tok-values "x1")        (list "x1"))
+(apl-test "name: system var"        (tok-values "⎕IO")       (list "⎕IO"))
+(apl-test "name: system var type"   (tok-types "⎕IO")        (list :name))
+(apl-test "glyph: plus"             (tok-types "+")          (list :glyph))
+(apl-test "glyph: plus value"       (tok-values "+")         (list "+"))
+(apl-test "glyph: iota"             (tok-values "⍳")         (list "⍳"))
+(apl-test "glyph: reduce"           (tok-values "+/")        (list "+" "/"))
+(apl-test "glyph: floor"            (tok-values "⌊")         (list "⌊"))
+(apl-test "glyph: rho"              (tok-values "⍴")         (list "⍴"))
+(apl-test "glyph: alpha omega"      (tok-types "⍺ ⍵")        (list :glyph :glyph))
+(apl-test "punct: lparen"           (tok-types "(")          (list :lparen))
+(apl-test "punct: rparen"           (tok-types ")")          (list :rparen))
+(apl-test "punct: brackets"         (tok-types "[42]")       (list :lbracket :num :rbracket))
+(apl-test "punct: braces"           (tok-types "{}")         (list :lbrace :rbrace))
+(apl-test "punct: semi"             (tok-types ";")          (list :semi))
+(apl-test "assign: arrow"           (tok-types "x←1")        (list :name :assign :num))
+(apl-test "diamond: separator"      (tok-types "1⋄2")        (list :num :diamond :num))
+(apl-test "newline: emitted"        (tok-types "1\n2")       (list :num :newline :num))
+(apl-test "comment: skipped"        (tok-count "⍝ ignore me") 0)
+(apl-test "comment: rest ignored"   (tok-count "1 ⍝ note")  1)
+(apl-test "colon: bare"             (tok-types ":")          (list :colon))
+(apl-test "keyword: If"             (tok-values ":If")       (list ":If"))
+(apl-test "keyword: type"           (tok-types ":While")     (list :keyword))
+(apl-test "keyword: EndFor"         (tok-values ":EndFor")   (list ":EndFor"))
+(apl-test "expr: +/ ⍳ 5"           (tok-types "+/ ⍳ 5")     (list :glyph :glyph :glyph :num))
+(apl-test "expr: x←42"             (tok-count "x←42")       3)
+(apl-test "expr: dfn body"          (tok-types "{⍺+⍵}")
+                                    (list :lbrace :glyph :glyph :glyph :rbrace))
+
+(define apl-tokenize-test-summary
+  (str "tokenizer " apl-test-pass "/" apl-test-count
+       (if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails))))
+
+; ===========================================================================
+; Parser tests
+; ===========================================================================
+
+; Helper: parse an APL source string and return the AST
+(define parse
+  (fn (src) (parse-apl src)))
+
+; Helper: build an expected AST node using keyword-tagged lists
+(define num-node    (fn (n)       (list :num n)))
+(define str-node    (fn (s)       (list :str s)))
+(define name-node   (fn (n)       (list :name n)))
+(define fn-node     (fn (g)       (list :fn-glyph g)))
+(define fn-nm       (fn (n)       (list :fn-name n)))
+(define assign-node (fn (nm expr) (list :assign nm expr)))
+(define monad-node  (fn (f a)     (list :monad f a)))
+(define dyad-node   (fn (f l r)   (list :dyad f l r)))
+(define derived-fn  (fn (op f)    (list :derived-fn op f)))
+(define derived-fn2 (fn (op f g)  (list :derived-fn2 op f g)))
+(define outer-node  (fn (f)       (list :outer "∘." f)))
+(define guard-node  (fn (c e)     (list :guard c e)))
+
+; ---- numeric literals ----
+
+(apl-test "parse: num literal"
+  (parse "42")
+  (num-node 42))
+
+(apl-test "parse: negative num"
+  (parse "¯3")
+  (num-node -3))
+
+(apl-test "parse: zero"
+  (parse "0")
+  (num-node 0))
+
+; ---- string literals ----
+
+(apl-test "parse: str literal"
+  (parse "'hello'")
+  (str-node "hello"))
+
+(apl-test "parse: empty str"
+  (parse "''")
+  (str-node ""))
+
+; ---- name reference ----
+
+(apl-test "parse: name"
+  (parse "x")
+  (name-node "x"))
+
+(apl-test "parse: system name"
+  (parse "⎕IO")
+  (name-node "⎕IO"))
+
+; ---- strands (vec nodes) ----
+
+(apl-test "parse: strand 3 nums"
+  (parse "1 2 3")
+  (list :vec (num-node 1) (num-node 2) (num-node 3)))
+
+(apl-test "parse: strand 2 nums"
+  (parse "1 2")
+  (list :vec (num-node 1) (num-node 2)))
+
+(apl-test "parse: strand with negatives"
+  (parse "1 ¯2 3")
+  (list :vec (num-node 1) (num-node -2) (num-node 3)))
+
+; ---- assignment ----
+
+(apl-test "parse: assignment"
+  (parse "x←42")
+  (assign-node "x" (num-node 42)))
+
+(apl-test "parse: assignment with spaces"
+  (parse "x ← 42")
+  (assign-node "x" (num-node 42)))
+
+(apl-test "parse: assignment of expr"
+  (parse "r←2+3")
+  (assign-node "r" (dyad-node (fn-node "+") (num-node 2) (num-node 3))))
+
+; ---- monadic functions ----
+
+(apl-test "parse: monadic iota"
+  (parse "⍳5")
+  (monad-node (fn-node "⍳") (num-node 5)))
+
+(apl-test "parse: monadic iota with space"
+  (parse "⍳ 5")
+  (monad-node (fn-node "⍳") (num-node 5)))
+
+(apl-test "parse: monadic negate"
+  (parse "-3")
+  (monad-node (fn-node "-") (num-node 3)))
+
+(apl-test "parse: monadic floor"
+  (parse "⌊2")
+  (monad-node (fn-node "⌊") (num-node 2)))
+
+(apl-test "parse: monadic of name"
+  (parse "⍴x")
+  (monad-node (fn-node "⍴") (name-node "x")))
+
+; ---- dyadic functions ----
+
+(apl-test "parse: dyadic plus"
+  (parse "2+3")
+  (dyad-node (fn-node "+") (num-node 2) (num-node 3)))
+
+(apl-test "parse: dyadic times"
+  (parse "2×3")
+  (dyad-node (fn-node "×") (num-node 2) (num-node 3)))
+
+(apl-test "parse: dyadic with names"
+  (parse "x+y")
+  (dyad-node (fn-node "+") (name-node "x") (name-node "y")))
+
+; ---- right-to-left evaluation ----
+
+(apl-test "parse: right-to-left 2×3+4"
+  (parse "2×3+4")
+  (dyad-node (fn-node "×") (num-node 2)
+    (dyad-node (fn-node "+") (num-node 3) (num-node 4))))
+
+(apl-test "parse: right-to-left chain"
+  (parse "1+2×3-4")
+  (dyad-node (fn-node "+") (num-node 1)
+    (dyad-node (fn-node "×") (num-node 2)
+      (dyad-node (fn-node "-") (num-node 3) (num-node 4)))))
+
+; ---- parenthesized subexpressions ----
+
+(apl-test "parse: parens override order"
+  (parse "(2+3)×4")
+  (dyad-node (fn-node "×")
+    (dyad-node (fn-node "+") (num-node 2) (num-node 3))
+    (num-node 4)))
+
+(apl-test "parse: nested parens"
+  (parse "((2+3))")
+  (dyad-node (fn-node "+") (num-node 2) (num-node 3)))
+
+(apl-test "parse: paren in dyadic right"
+  (parse "2×(3+4)")
+  (dyad-node (fn-node "×") (num-node 2)
+    (dyad-node (fn-node "+") (num-node 3) (num-node 4))))
+
+; ---- operators → derived functions ----
+
+(apl-test "parse: reduce +"
+  (parse "+/x")
+  (monad-node (derived-fn "/" (fn-node "+")) (name-node "x")))
+
+(apl-test "parse: reduce iota"
+  (parse "+/⍳5")
+  (monad-node (derived-fn "/" (fn-node "+"))
+    (monad-node (fn-node "⍳") (num-node 5))))
+
+(apl-test "parse: scan"
+  (parse "+\\x")
+  (monad-node (derived-fn "\\" (fn-node "+")) (name-node "x")))
+
+(apl-test "parse: each"
+  (parse "⍳¨x")
+  (monad-node (derived-fn "¨" (fn-node "⍳")) (name-node "x")))
+
+(apl-test "parse: commute"
+  (parse "-⍨3")
+  (monad-node (derived-fn "⍨" (fn-node "-")) (num-node 3)))
+
+(apl-test "parse: stacked ops"
+  (parse "+/¨x")
+  (monad-node (derived-fn "¨" (derived-fn "/" (fn-node "+"))) (name-node "x")))
+
+; ---- outer product ----
+
+(apl-test "parse: outer product monadic"
+  (parse "∘.×")
+  (outer-node (fn-node "×")))
+
+(apl-test "parse: outer product dyadic names"
+  (parse "x ∘.× y")
+  (dyad-node (outer-node (fn-node "×")) (name-node "x") (name-node "y")))
+
+(apl-test "parse: outer product dyadic strands"
+  (parse "1 2 3 ∘.× 4 5 6")
+  (dyad-node (outer-node (fn-node "×"))
+    (list :vec (num-node 1) (num-node 2) (num-node 3))
+    (list :vec (num-node 4) (num-node 5) (num-node 6))))
+
+; ---- inner product ----
+
+(apl-test "parse: inner product"
+  (parse "+.×")
+  (derived-fn2 "." (fn-node "+") (fn-node "×")))
+
+(apl-test "parse: inner product applied"
+  (parse "a +.× b")
+  (dyad-node (derived-fn2 "." (fn-node "+") (fn-node "×"))
+    (name-node "a") (name-node "b")))
+
+; ---- dfn (anonymous function) ----
+
+(apl-test "parse: simple dfn"
+  (parse "{⍺+⍵}")
+  (list :dfn (dyad-node (fn-node "+") (name-node "⍺") (name-node "⍵"))))
+
+(apl-test "parse: monadic dfn"
+  (parse "{⍵×2}")
+  (list :dfn (dyad-node (fn-node "×") (name-node "⍵") (num-node 2))))
+
+(apl-test "parse: dfn self-ref"
+  (parse "{⍵≤1:1 ⋄ ⍵×∇ ⍵-1}")
+  (list :dfn
+    (guard-node (dyad-node (fn-node "≤") (name-node "⍵") (num-node 1)) (num-node 1))
+    (dyad-node (fn-node "×") (name-node "⍵")
+      (monad-node (fn-node "∇") (dyad-node (fn-node "-") (name-node "⍵") (num-node 1))))))
+
+; ---- dfn applied ----
+
+(apl-test "parse: dfn as function"
+  (parse "{⍺+⍵} 3")
+  (monad-node
+    (list :dfn (dyad-node (fn-node "+") (name-node "⍺") (name-node "⍵")))
+    (num-node 3)))
+
+; ---- multi-statement ----
+
+(apl-test "parse: diamond separator"
+  (let ((result (parse "x←1 ⋄ x+2")))
+    (= (first result) :program))
+  true)
+
+(apl-test "parse: diamond first stmt"
+  (let ((result (parse "x←1 ⋄ x+2")))
+    (nth result 1))
+  (assign-node "x" (num-node 1)))
+
+(apl-test "parse: diamond second stmt"
+  (let ((result (parse "x←1 ⋄ x+2")))
+    (nth result 2))
+  (dyad-node (fn-node "+") (name-node "x") (num-node 2)))
+
+; ---- combined summary ----
+
+(define apl-parse-test-count (- apl-test-count 46))
+(define apl-parse-test-pass  (- apl-test-pass 46))
+
+(define apl-test-summary
+  (str
+    "tokenizer 46/46  |  "
+    "parser " apl-parse-test-pass "/" apl-parse-test-count
+    (if (= (len apl-test-fails) 0) "" (str "  FAILS: " apl-test-fails))))

lib/apl/tests/scalar.sx

@@ -0,0 +1,369 @@
+; APL scalar primitives test suite
+; Requires: lib/apl/runtime.sx
+
+; ============================================================
+; Test framework
+; ============================================================
+
+(define apl-rt-count 0)
+(define apl-rt-pass 0)
+(define apl-rt-fails (list))
+
+; Element-wise list comparison (handles both List and ListRef)
+(define
+  lists-eq
+  (fn
+    (a b)
+    (if
+      (and (= (len a) 0) (= (len b) 0))
+      true
+      (if
+        (not (= (len a) (len b)))
+        false
+        (if
+          (not (= (first a) (first b)))
+          false
+          (lists-eq (rest a) (rest b)))))))
+
+(define
+  apl-rt-test
+  (fn
+    (name actual expected)
+    (begin
+      (set! apl-rt-count (+ apl-rt-count 1))
+      (if
+        (equal? actual expected)
+        (set! apl-rt-pass (+ apl-rt-pass 1))
+        (append! apl-rt-fails {:actual actual :expected expected :name name})))))
+
+; Test that a ravel equals a plain list (handles ListRef vs List)
+(define
+  ravel-test
+  (fn
+    (name arr expected-list)
+    (begin
+      (set! apl-rt-count (+ apl-rt-count 1))
+      (let
+        ((actual (get arr :ravel)))
+        (if
+          (lists-eq actual expected-list)
+          (set! apl-rt-pass (+ apl-rt-pass 1))
+          (append! apl-rt-fails {:actual actual :expected expected-list :name name}))))))
+
+; Test a scalar ravel value (single-element list)
+(define
+  scalar-test
+  (fn (name arr expected-val) (ravel-test name arr (list expected-val))))
+
+; ============================================================
+; Array constructor tests
+; ============================================================
+
+(apl-rt-test
+  "scalar: shape is empty list"
+  (get (apl-scalar 5) :shape)
+  (list))
+
+(apl-rt-test
+  "scalar: ravel has one element"
+  (get (apl-scalar 5) :ravel)
+  (list 5))
+
+(apl-rt-test "scalar: rank 0" (array-rank (apl-scalar 5)) 0)
+
+(apl-rt-test "scalar? returns true for scalar" (scalar? (apl-scalar 5)) true)
+
+(apl-rt-test "scalar: zero" (get (apl-scalar 0) :ravel) (list 0))
+
+(apl-rt-test
+  "vector: shape is (3)"
+  (get (apl-vector (list 1 2 3)) :shape)
+  (list 3))
+
+(apl-rt-test
+  "vector: ravel matches input"
+  (get (apl-vector (list 1 2 3)) :ravel)
+  (list 1 2 3))
+
+(apl-rt-test "vector: rank 1" (array-rank (apl-vector (list 1 2 3))) 1)
+
+(apl-rt-test
+  "scalar? returns false for vector"
+  (scalar? (apl-vector (list 1 2 3)))
+  false)
+
+(apl-rt-test
+  "make-array: rank 2"
+  (array-rank (make-array (list 2 3) (list 1 2 3 4 5 6)))
+  2)
+
+(apl-rt-test
+  "make-array: shape"
+  (get (make-array (list 2 3) (list 1 2 3 4 5 6)) :shape)
+  (list 2 3))
+
+(apl-rt-test
+  "array-ref: first element"
+  (array-ref (apl-vector (list 10 20 30)) 0)
+  10)
+
+(apl-rt-test
+  "array-ref: last element"
+  (array-ref (apl-vector (list 10 20 30)) 2)
+  30)
+
+(apl-rt-test "enclose: wraps in rank-0" (scalar? (enclose 42)) true)
+
+(apl-rt-test
+  "enclose: ravel contains value"
+  (get (enclose 42) :ravel)
+  (list 42))
+
+(apl-rt-test "disclose: unwraps rank-0" (disclose (enclose 42)) 42)
+
+; ============================================================
+; Shape primitive tests
+; ============================================================
+
+(ravel-test "⍴ scalar: returns empty" (apl-shape (apl-scalar 5)) (list))
+
+(ravel-test
+  "⍴ vector: returns (3)"
+  (apl-shape (apl-vector (list 1 2 3)))
+  (list 3))
+
+(ravel-test
+  "⍴ matrix: returns (2 3)"
+  (apl-shape (make-array (list 2 3) (list 1 2 3 4 5 6)))
+  (list 2 3))
+
+(ravel-test
+  ", ravel scalar: vector of 1"
+  (apl-ravel (apl-scalar 5))
+  (list 5))
+
+(apl-rt-test
+  ", ravel vector: same elements"
+  (get (apl-ravel (apl-vector (list 1 2 3))) :ravel)
+  (list 1 2 3))
+
+(apl-rt-test
+  ", ravel matrix: all elements"
+  (get (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6))) :ravel)
+  (list 1 2 3 4 5 6))
+
+(scalar-test "≢ tally scalar: 1" (apl-tally (apl-scalar 5)) 1)
+
+(scalar-test
+  "≢ tally vector: first dimension"
+  (apl-tally (apl-vector (list 1 2 3)))
+  3)
+
+(scalar-test
+  "≢ tally matrix: first dimension"
+  (apl-tally (make-array (list 2 3) (list 1 2 3 4 5 6)))
+  2)
+
+(scalar-test
+  "≡ depth flat vector: 0"
+  (apl-depth (apl-vector (list 1 2 3)))
+  0)
+
+(scalar-test "≡ depth scalar: 0" (apl-depth (apl-scalar 5)) 0)
+
+(scalar-test
+  "≡ depth nested (enclose in vector): 1"
+  (apl-depth (enclose (apl-vector (list 1 2 3))))
+  1)
+
+; ============================================================
+; ⍳ iota tests
+; ============================================================
+
+(apl-rt-test
+  "⍳5 shape is (5)"
+  (get (apl-iota (apl-scalar 5)) :shape)
+  (list 5))
+
+(ravel-test "⍳5 ravel is 1..5" (apl-iota (apl-scalar 5)) (list 1 2 3 4 5))
+
+(ravel-test "⍳1 ravel is (1)" (apl-iota (apl-scalar 1)) (list 1))
+
+(ravel-test "⍳0 ravel is empty" (apl-iota (apl-scalar 0)) (list))
+
+(apl-rt-test "apl-io is 1" apl-io 1)
+
+; ============================================================
+; Arithmetic broadcast tests
+; ============================================================
+
+(scalar-test
+  "+ scalar scalar: 3+4=7"
+  (apl-add (apl-scalar 3) (apl-scalar 4))
+  7)
+
+(ravel-test
+  "+ vector scalar: +10"
+  (apl-add (apl-vector (list 1 2 3)) (apl-scalar 10))
+  (list 11 12 13))
+
+(ravel-test
+  "+ scalar vector: 10+"
+  (apl-add (apl-scalar 10) (apl-vector (list 1 2 3)))
+  (list 11 12 13))
+
+(ravel-test
+  "+ vector vector"
+  (apl-add (apl-vector (list 1 2 3)) (apl-vector (list 4 5 6)))
+  (list 5 7 9))
+
+(scalar-test "- negate monadic" (apl-neg-m (apl-scalar 5)) -5)
+
+(scalar-test "- dyadic 10-3=7" (apl-sub (apl-scalar 10) (apl-scalar 3)) 7)
+
+(scalar-test "× signum positive" (apl-signum (apl-scalar 7)) 1)
+
+(scalar-test "× signum negative" (apl-signum (apl-scalar -3)) -1)
+
+(scalar-test "× signum zero" (apl-signum (apl-scalar 0)) 0)
+
+(scalar-test "× dyadic 3×4=12" (apl-mul (apl-scalar 3) (apl-scalar 4)) 12)
+
+(scalar-test "÷ reciprocal 1÷4=0.25" (apl-recip (apl-scalar 4)) 0.25)
+
+(scalar-test
+  "÷ dyadic 10÷4=2.5"
+  (apl-div (apl-scalar 10) (apl-scalar 4))
+  2.5)
+
+(scalar-test "⌈ ceiling 2.3→3" (apl-ceil (apl-scalar 2.3)) 3)
+
+(scalar-test "⌈ max 3 5 → 5" (apl-max (apl-scalar 3) (apl-scalar 5)) 5)
+
+(scalar-test "⌊ floor 2.7→2" (apl-floor (apl-scalar 2.7)) 2)
+
+(scalar-test "⌊ min 3 5 → 3" (apl-min (apl-scalar 3) (apl-scalar 5)) 3)
+
+(scalar-test "* exp monadic e^0=1" (apl-exp (apl-scalar 0)) 1)
+
+(scalar-test
+  "* pow dyadic 2^10=1024"
+  (apl-pow (apl-scalar 2) (apl-scalar 10))
+  1024)
+
+(scalar-test "⍟ ln 1=0" (apl-ln (apl-scalar 1)) 0)
+
+(scalar-test "| abs positive" (apl-abs (apl-scalar 5)) 5)
+
+(scalar-test "| abs negative" (apl-abs (apl-scalar -5)) 5)
+
+(scalar-test "| mod 3|7=1" (apl-mod (apl-scalar 3) (apl-scalar 7)) 1)
+
+(scalar-test "! factorial 5!=120" (apl-fact (apl-scalar 5)) 120)
+
+(scalar-test "! factorial 0!=1" (apl-fact (apl-scalar 0)) 1)
+
+(scalar-test
+  "! binomial 4 choose 2 = 6"
+  (apl-binomial (apl-scalar 4) (apl-scalar 2))
+  6)
+
+(scalar-test "○ pi×0=0" (apl-pi-times (apl-scalar 0)) 0)
+
+(scalar-test "○ trig sin(0)=0" (apl-trig (apl-scalar 1) (apl-scalar 0)) 0)
+
+(scalar-test "○ trig cos(0)=1" (apl-trig (apl-scalar 2) (apl-scalar 0)) 1)
+
+; ============================================================
+; Comparison tests
+; ============================================================
+
+(scalar-test "< less: 3<5 → 1" (apl-lt (apl-scalar 3) (apl-scalar 5)) 1)
+
+(scalar-test "< less: 5<3 → 0" (apl-lt (apl-scalar 5) (apl-scalar 3)) 0)
+
+(scalar-test
+  "≤ le equal: 3≤3 → 1"
+  (apl-le (apl-scalar 3) (apl-scalar 3))
+  1)
+
+(scalar-test "= eq: 5=5 → 1" (apl-eq (apl-scalar 5) (apl-scalar 5)) 1)
+
+(scalar-test "= ne: 5=6 → 0" (apl-eq (apl-scalar 5) (apl-scalar 6)) 0)
+
+(scalar-test "≥ ge: 5≥3 → 1" (apl-ge (apl-scalar 5) (apl-scalar 3)) 1)
+
+(scalar-test "> gt: 5>3 → 1" (apl-gt (apl-scalar 5) (apl-scalar 3)) 1)
+
+(scalar-test "≠ ne: 5≠3 → 1" (apl-ne (apl-scalar 5) (apl-scalar 3)) 1)
+
+(ravel-test
+  "comparison vector broadcast: 1 2 3 < 2 → 1 0 0"
+  (apl-lt (apl-vector (list 1 2 3)) (apl-scalar 2))
+  (list 1 0 0))
+
+; ============================================================
+; Logical tests
+; ============================================================
+
+(scalar-test "~ not 0 → 1" (apl-not (apl-scalar 0)) 1)
+
+(scalar-test "~ not 1 → 0" (apl-not (apl-scalar 1)) 0)
+
+(ravel-test
+  "~ not vector: 1 0 1 0 → 0 1 0 1"
+  (apl-not (apl-vector (list 1 0 1 0)))
+  (list 0 1 0 1))
+
+(scalar-test
+  "∧ and 1∧1 → 1"
+  (apl-and (apl-scalar 1) (apl-scalar 1))
+  1)
+
+(scalar-test
+  "∧ and 1∧0 → 0"
+  (apl-and (apl-scalar 1) (apl-scalar 0))
+  0)
+
+(scalar-test "∨ or 0∨1 → 1" (apl-or (apl-scalar 0) (apl-scalar 1)) 1)
+
+(scalar-test "∨ or 0∨0 → 0" (apl-or (apl-scalar 0) (apl-scalar 0)) 0)
+
+(scalar-test
+  "⍱ nor 0⍱0 → 1"
+  (apl-nor (apl-scalar 0) (apl-scalar 0))
+  1)
+
+(scalar-test
+  "⍱ nor 1⍱0 → 0"
+  (apl-nor (apl-scalar 1) (apl-scalar 0))
+  0)
+
+(scalar-test
+  "⍲ nand 1⍲1 → 0"
+  (apl-nand (apl-scalar 1) (apl-scalar 1))
+  0)
+
+(scalar-test
+  "⍲ nand 1⍲0 → 1"
+  (apl-nand (apl-scalar 1) (apl-scalar 0))
+  1)
+
+; ============================================================
+; plus-m identity test
+; ============================================================
+
+(scalar-test "+ monadic identity: +5 → 5" (apl-plus-m (apl-scalar 5)) 5)
+
+; ============================================================
+; Summary
+; ============================================================
+
+(define
+  apl-scalar-summary
+  (str
+    "scalar "
+    apl-rt-pass
+    "/"
+    apl-rt-count
+    (if (= (len apl-rt-fails) 0) "" (str " FAILS: " apl-rt-fails))))

lib/apl/tokenizer.sx

@@ -0,0 +1,168 @@
+(define apl-glyph-set
+  (list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~" "<" "≤" "=" "≥" ">" "≠"
+        "∊" "∧" "∨" "⍱" "⍲" "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
+        "∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕"
+        "⍺" "⍵" "∇" "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))
+
+(define apl-glyph?
+  (fn (ch)
+    (some (fn (g) (= g ch)) apl-glyph-set)))
+
+(define apl-digit?
+  (fn (ch)
+    (and (string? ch) (>= ch "0") (<= ch "9"))))
+
+(define apl-alpha?
+  (fn (ch)
+    (and (string? ch)
+         (or (and (>= ch "a") (<= ch "z"))
+             (and (>= ch "A") (<= ch "Z"))
+             (= ch "_")))))
+
+(define apl-tokenize
+  (fn (source)
+    (let ((pos 0)
+          (src-len (len source))
+          (tokens (list)))
+
+      (define tok-push!
+        (fn (type value)
+          (append! tokens {:type type :value value})))
+
+      (define cur-sw?
+        (fn (ch)
+          (and (< pos src-len) (starts-with? (slice source pos) ch))))
+
+      (define cur-byte
+        (fn ()
+          (if (< pos src-len) (nth source pos) nil)))
+
+      (define advance!
+        (fn ()
+          (set! pos (+ pos 1))))
+
+      (define consume!
+        (fn (ch)
+          (set! pos (+ pos (len ch)))))
+
+      (define find-glyph
+        (fn ()
+          (let ((rem (slice source pos)))
+            (let ((matches (filter (fn (g) (starts-with? rem g)) apl-glyph-set)))
+              (if (> (len matches) 0) (first matches) nil)))))
+
+      (define read-digits!
+        (fn (acc)
+          (if (and (< pos src-len) (apl-digit? (cur-byte)))
+            (let ((ch (cur-byte)))
+              (begin
+                (advance!)
+                (read-digits! (str acc ch))))
+            acc)))
+
+      (define read-ident-cont!
+        (fn ()
+          (when (and (< pos src-len)
+                     (let ((ch (cur-byte)))
+                       (or (apl-alpha? ch) (apl-digit? ch))))
+            (begin
+              (advance!)
+              (read-ident-cont!)))))
+
+      (define read-string!
+        (fn (acc)
+          (cond
+            ((>= pos src-len) acc)
+            ((cur-sw? "'")
+             (if (and (< (+ pos 1) src-len) (cur-sw? "'"))
+               (begin
+                 (advance!)
+                 (advance!)
+                 (read-string! (str acc "'")))
+               (begin (advance!) acc)))
+            (true
+             (let ((ch (cur-byte)))
+               (begin
+                 (advance!)
+                 (read-string! (str acc ch))))))))
+
+      (define skip-line!
+        (fn ()
+          (when (and (< pos src-len) (not (cur-sw? "\n")))
+            (begin
+              (advance!)
+              (skip-line!)))))
+
+      (define scan!
+        (fn ()
+          (when (< pos src-len)
+            (let ((ch (cur-byte)))
+              (cond
+                ((or (= ch " ") (= ch "\t") (= ch "\r"))
+                 (begin (advance!) (scan!)))
+                ((= ch "\n")
+                 (begin (advance!) (tok-push! :newline nil) (scan!)))
+                ((cur-sw? "⍝")
+                 (begin (skip-line!) (scan!)))
+                ((cur-sw? "⋄")
+                 (begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
+                ((= ch "(")
+                 (begin (advance!) (tok-push! :lparen nil) (scan!)))
+                ((= ch ")")
+                 (begin (advance!) (tok-push! :rparen nil) (scan!)))
+                ((= ch "[")
+                 (begin (advance!) (tok-push! :lbracket nil) (scan!)))
+                ((= ch "]")
+                 (begin (advance!) (tok-push! :rbracket nil) (scan!)))
+                ((= ch "{")
+                 (begin (advance!) (tok-push! :lbrace nil) (scan!)))
+                ((= ch "}")
+                 (begin (advance!) (tok-push! :rbrace nil) (scan!)))
+                ((= ch ";")
+                 (begin (advance!) (tok-push! :semi nil) (scan!)))
+                ((cur-sw? "←")
+                 (begin (consume! "←") (tok-push! :assign nil) (scan!)))
+                ((= ch ":")
+                 (let ((start pos))
+                   (begin
+                     (advance!)
+                     (if (and (< pos src-len) (apl-alpha? (cur-byte)))
+                       (begin
+                         (read-ident-cont!)
+                         (tok-push! :keyword (slice source start pos)))
+                       (tok-push! :colon nil))
+                     (scan!))))
+                ((and (cur-sw? "¯")
+                      (< (+ pos (len "¯")) src-len)
+                      (apl-digit? (nth source (+ pos (len "¯")))))
+                 (begin
+                   (consume! "¯")
+                   (let ((digits (read-digits! "")))
+                     (tok-push! :num (- 0 (parse-int digits 0))))
+                   (scan!)))
+                ((apl-digit? ch)
+                 (begin
+                   (let ((digits (read-digits! "")))
+                     (tok-push! :num (parse-int digits 0)))
+                   (scan!)))
+                ((= ch "'")
+                 (begin
+                   (advance!)
+                   (let ((s (read-string! "")))
+                     (tok-push! :str s))
+                   (scan!)))
+                ((or (apl-alpha? ch) (cur-sw? "⎕"))
+                 (let ((start pos))
+                   (begin
+                     (if (cur-sw? "⎕") (consume! "⎕") (advance!))
+                     (read-ident-cont!)
+                     (tok-push! :name (slice source start pos))
+                     (scan!))))
+                (true
+                 (let ((g (find-glyph)))
+                   (if g
+                     (begin (consume! g) (tok-push! :glyph g) (scan!))
+                     (begin (advance!) (scan!))))))))))
+
+      (scan!)
+      tokens)))

lib/tcl/conformance.sh

@@ -1,145 +0,0 @@
-#!/usr/bin/env bash
-# Tcl-on-SX conformance runner — epoch protocol to sx_server.exe
-# Usage: lib/tcl/conformance.sh [file.tcl ...]
-#   Defaults to lib/tcl/tests/programs/*.tcl
-set -uo pipefail
-cd "$(git rev-parse --show-toplevel)"
-
-SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
-if [ ! -x "$SX_SERVER" ]; then
-  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
-fi
-if [ ! -x "$SX_SERVER" ]; then echo "ERROR: sx_server.exe not found"; exit 1; fi
-
-SCOREBOARD_JSON="${SCOREBOARD_JSON:-lib/tcl/scoreboard.json}"
-SCOREBOARD_MD="${SCOREBOARD_MD:-lib/tcl/scoreboard.md}"
-
-# Collect tcl files
-if [ "$#" -gt 0 ]; then
-  TCL_FILES=("$@")
-else
-  TCL_FILES=(lib/tcl/tests/programs/*.tcl)
-fi
-
-# Generate a helper .sx file that defines the Tcl source as an SX string variable.
-# We escape the source for SX string literals: backslashes → \\, quotes → \", newlines → \n.
-# This is safe in a (define ...) context — no double-parsing like (eval "...") would cause.
-write_sx_helper() {
-  local tcl_file="$1"
-  local helper_file="$2"
-  python3 << PYEOF
-src = open('${tcl_file}').read()
-escaped = src.replace('\\\\', '\\\\\\\\').replace('"', '\\\\"').replace('\\n', '\\\\n')
-with open('${helper_file}', 'w') as f:
-    f.write(f'(define __tcl-src "{escaped}")\\n')
-    f.write('(define __tcl-result (get (tcl-eval-string (make-default-tcl-interp) __tcl-src) :result))\\n')
-PYEOF
-}
-
-total=0
-passed=0
-failed=0
-programs_json=""
-md_rows=""
-
-for tcl_file in "${TCL_FILES[@]}"; do
-  basename_noext=$(basename "$tcl_file" .tcl)
-  total=$((total + 1))
-
-  # Read expected value from first-line comment "# expected: VALUE"
-  expected=$(head -1 "$tcl_file" | sed -n 's/^# expected: *//p')
-  if [ -z "$expected" ]; then
-    echo "WARN: no '# expected:' annotation in $tcl_file — skipping"
-    continue
-  fi
-
-  tmpfile=$(mktemp)
-  helper=$(mktemp --suffix=.sx)
-  trap "rm -f $tmpfile $helper" EXIT
-
-  # Write helper .sx with Tcl source embedded as SX string
-  write_sx_helper "$tcl_file" "$helper"
-
-  # Build epoch input using quoted heredoc for static parts; helper path via variable
-  cat > "$tmpfile" << EPOCHS
-(epoch 1)
-(load "lib/tcl/tokenizer.sx")
-(epoch 2)
-(load "lib/tcl/parser.sx")
-(epoch 3)
-(load "lib/tcl/runtime.sx")
-(epoch 4)
-(load "$helper")
-(epoch 5)
-(eval "__tcl-result")
-(epoch 6)
-EPOCHS
-
-  output=$(timeout 30 "$SX_SERVER" < "$tmpfile" 2>&1)
-  got=$(echo "$output" | grep -A1 "^(ok-len 5 " | tail -1 | tr -d '"')
-
-  if [ "$got" = "$expected" ]; then
-    status="PASS"
-    passed=$((passed + 1))
-    echo "PASS  $basename_noext  (expected: $expected, got: $got)"
-  else
-    status="FAIL"
-    failed=$((failed + 1))
-    echo "FAIL  $basename_noext  (expected: $expected, got: ${got:-<empty>})"
-    if [ -n "${VERBOSE:-}" ]; then
-      echo "--- server output ---"
-      echo "$output"
-      echo "--- helper.sx ---"
-      cat "$helper"
-    fi
-  fi
-
-  # Accumulate JSON fragment (escape for JSON)
-  got_json=$(printf '%s' "$got" | python3 -c "import sys,json; sys.stdout.write(json.dumps(sys.stdin.read()))" | tr -d '"')
-  exp_json=$(printf '%s' "$expected" | python3 -c "import sys,json; sys.stdout.write(json.dumps(sys.stdin.read()))" | tr -d '"')
-
-  if [ -n "$programs_json" ]; then
-    programs_json="${programs_json},"
-  fi
-  programs_json="${programs_json}
-    \"${basename_noext}\": {\"status\": \"${status}\", \"expected\": \"${exp_json}\", \"got\": \"${got_json}\"}"
-
-  # Accumulate Markdown row
-  if [ "$status" = "PASS" ]; then
-    icon="✓ PASS"
-  else
-    icon="✗ FAIL"
-  fi
-  md_rows="${md_rows}| ${basename_noext} | ${icon} | ${expected} | ${got} |
-"
-done
-
-# Write scoreboard.json
-cat > "$SCOREBOARD_JSON" << JSON
-{
-  "total": ${total},
-  "passed": ${passed},
-  "failed": ${failed},
-  "programs": {${programs_json}
-  }
-}
-JSON
-
-# Write scoreboard.md
-cat > "$SCOREBOARD_MD" << MD
-# Tcl-on-SX Conformance Scoreboard
-
-| Program | Status | Expected | Got |
-|---|---|---|---|
-${md_rows}
-**${passed}/${total} passing**
-MD
-
-echo ""
-echo "Scoreboard: ${passed}/${total} passing"
-echo "Written: $SCOREBOARD_JSON, $SCOREBOARD_MD"
-
-if [ "$failed" -gt 0 ]; then
-  exit 1
-fi
-exit 0

lib/tcl/parser.sx

@@ -1,41 +0,0 @@
-; Tcl parser — thin layer over tcl-tokenize
-; Adds tcl-parse entry point and word utility fns
-
-; Entry point: parse Tcl source to a list of commands.
-; Returns same structure as tcl-tokenize.
-(define tcl-parse (fn (src) (tcl-tokenize src)))
-
-; True if word has no substitutions — value can be read statically.
-; braced words are always simple. compound words are simple when all
-; parts are plain text with no var/cmd parts.
-(define tcl-word-simple?
-  (fn (word)
-    (cond
-      ((= (get word :type) "braced") true)
-      ((= (get word :type) "compound")
-        (let ((parts (get word :parts)))
-          (every? (fn (p) (= (get p :type) "text")) parts)))
-      (else false))))
-
-; Concatenate text parts of a simple word into a single string.
-; For braced words returns :value directly.
-; For compound words with only text parts, joins them.
-; Returns nil for words with substitutions.
-(define tcl-word-literal
-  (fn (word)
-    (cond
-      ((= (get word :type) "braced") (get word :value))
-      ((= (get word :type) "compound")
-        (if (tcl-word-simple? word)
-          (join "" (map (fn (p) (get p :value)) (get word :parts)))
-          nil))
-      (else nil))))
-
-; Number of words in a parsed command.
-(define tcl-cmd-len
-  (fn (cmd) (len (get cmd :words))))
-
-; Nth word literal from a command (index 0 = command name).
-; Returns nil if word has substitutions.
-(define tcl-nth-literal
-  (fn (cmd n) (tcl-word-literal (nth (get cmd :words) n))))

lib/tcl/scoreboard.json

@@ -1,10 +0,0 @@
-{
-  "total": 3,
-  "passed": 3,
-  "failed": 0,
-  "programs": {
-    "assert": {"status": "PASS", "expected": "10", "got": "10"},
-    "for-each-line": {"status": "PASS", "expected": "13", "got": "13"},
-    "with-temp-var": {"status": "PASS", "expected": "100 999", "got": "100 999"}
-  }
-}

lib/tcl/scoreboard.md

@@ -1,9 +0,0 @@
-# Tcl-on-SX Conformance Scoreboard
-
-| Program | Status | Expected | Got |
-|---|---|---|---|
-| assert | ✓ PASS | 10 | 10 |
-| for-each-line | ✓ PASS | 13 | 13 |
-| with-temp-var | ✓ PASS | 100 999 | 100 999 |
-
-**3/3 passing**

lib/tcl/test.sh

@@ -1,113 +0,0 @@
-#!/usr/bin/env bash
-# Tcl-on-SX test runner — epoch protocol to sx_server.exe
-set -uo pipefail
-cd "$(git rev-parse --show-toplevel)"
-
-SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
-if [ ! -x "$SX_SERVER" ]; then
-  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
-fi
-if [ ! -x "$SX_SERVER" ]; then echo "ERROR: sx_server.exe not found"; exit 1; fi
-
-VERBOSE="${1:-}"
-TMPFILE=$(mktemp)
-HELPER=$(mktemp --suffix=.sx)
-trap "rm -f $TMPFILE $HELPER" EXIT
-
-# Helper file: run all test suites and format a parseable summary string
-cat > "$HELPER" << 'HELPER_EOF'
-(define __pr (tcl-run-parse-tests))
-(define __er (tcl-run-eval-tests))
-(define __xr (tcl-run-error-tests))
-(define __nr (tcl-run-namespace-tests))
-(define __cr (tcl-run-coro-tests))
-(define __ir (tcl-run-idiom-tests))
-(define tcl-test-summary
-  (str "PARSE:" (get __pr "passed") ":" (get __pr "failed")
-       " EVAL:" (get __er "passed") ":" (get __er "failed")
-       " ERROR:" (get __xr "passed") ":" (get __xr "failed")
-       " NAMESPACE:" (get __nr "passed") ":" (get __nr "failed")
-       " CORO:" (get __cr "passed") ":" (get __cr "failed")
-       " IDIOM:" (get __ir "passed") ":" (get __ir "failed")))
-HELPER_EOF
-
-cat > "$TMPFILE" << EPOCHS
-(epoch 1)
-(load "lib/tcl/tokenizer.sx")
-(epoch 2)
-(load "lib/tcl/parser.sx")
-(epoch 3)
-(load "lib/tcl/tests/parse.sx")
-(epoch 4)
-(load "lib/tcl/runtime.sx")
-(epoch 5)
-(load "lib/tcl/tests/eval.sx")
-(epoch 6)
-(load "lib/tcl/tests/error.sx")
-(epoch 7)
-(load "lib/tcl/tests/namespace.sx")
-(epoch 8)
-(load "lib/tcl/tests/coro.sx")
-(epoch 9)
-(load "lib/tcl/tests/idioms.sx")
-(epoch 10)
-(load "$HELPER")
-(epoch 11)
-(eval "tcl-test-summary")
-EPOCHS
-
-OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>&1)
-[ "$VERBOSE" = "-v" ] && echo "$OUTPUT"
-
-# Extract summary line from epoch 11 output
-SUMMARY=$(echo "$OUTPUT" | grep -A1 "^(ok-len 11 " | tail -1 | tr -d '"')
-
-if [ -z "$SUMMARY" ]; then
-  echo "ERROR: no summary from test run"
-  echo "$OUTPUT" | tail -20
-  exit 1
-fi
-
-# Parse PARSE:N:M EVAL:N:M ERROR:N:M NAMESPACE:N:M CORO:N:M IDIOM:N:M
-PARSE_PART=$(echo "$SUMMARY"     | grep -o 'PARSE:[0-9]*:[0-9]*')
-EVAL_PART=$(echo "$SUMMARY"      | grep -o 'EVAL:[0-9]*:[0-9]*')
-ERROR_PART=$(echo "$SUMMARY"     | grep -o 'ERROR:[0-9]*:[0-9]*')
-NAMESPACE_PART=$(echo "$SUMMARY" | grep -o 'NAMESPACE:[0-9]*:[0-9]*')
-CORO_PART=$(echo "$SUMMARY"      | grep -o 'CORO:[0-9]*:[0-9]*')
-IDIOM_PART=$(echo "$SUMMARY"     | grep -o 'IDIOM:[0-9]*:[0-9]*')
-
-PARSE_PASSED=$(echo "$PARSE_PART"         | cut -d: -f2)
-PARSE_FAILED=$(echo "$PARSE_PART"         | cut -d: -f3)
-EVAL_PASSED=$(echo "$EVAL_PART"           | cut -d: -f2)
-EVAL_FAILED=$(echo "$EVAL_PART"           | cut -d: -f3)
-ERROR_PASSED=$(echo "$ERROR_PART"         | cut -d: -f2)
-ERROR_FAILED=$(echo "$ERROR_PART"         | cut -d: -f3)
-NAMESPACE_PASSED=$(echo "$NAMESPACE_PART" | cut -d: -f2)
-NAMESPACE_FAILED=$(echo "$NAMESPACE_PART" | cut -d: -f3)
-CORO_PASSED=$(echo "$CORO_PART"           | cut -d: -f2)
-CORO_FAILED=$(echo "$CORO_PART"           | cut -d: -f3)
-IDIOM_PASSED=$(echo "$IDIOM_PART"         | cut -d: -f2)
-IDIOM_FAILED=$(echo "$IDIOM_PART"         | cut -d: -f3)
-
-PARSE_PASSED=${PARSE_PASSED:-0};         PARSE_FAILED=${PARSE_FAILED:-1}
-EVAL_PASSED=${EVAL_PASSED:-0};           EVAL_FAILED=${EVAL_FAILED:-1}
-ERROR_PASSED=${ERROR_PASSED:-0};         ERROR_FAILED=${ERROR_FAILED:-1}
-NAMESPACE_PASSED=${NAMESPACE_PASSED:-0}; NAMESPACE_FAILED=${NAMESPACE_FAILED:-1}
-CORO_PASSED=${CORO_PASSED:-0};           CORO_FAILED=${CORO_FAILED:-1}
-IDIOM_PASSED=${IDIOM_PASSED:-0};         IDIOM_FAILED=${IDIOM_FAILED:-1}
-
-TOTAL_PASSED=$((PARSE_PASSED + EVAL_PASSED + ERROR_PASSED + NAMESPACE_PASSED + CORO_PASSED + IDIOM_PASSED))
-TOTAL_FAILED=$((PARSE_FAILED + EVAL_FAILED + ERROR_FAILED + NAMESPACE_FAILED + CORO_FAILED + IDIOM_FAILED))
-TOTAL=$((TOTAL_PASSED + TOTAL_FAILED))
-
-if [ "$TOTAL_FAILED" = "0" ]; then
-  echo "ok $TOTAL_PASSED/$TOTAL tcl tests passed (parse: $PARSE_PASSED, eval: $EVAL_PASSED, error: $ERROR_PASSED, namespace: $NAMESPACE_PASSED, coro: $CORO_PASSED, idiom: $IDIOM_PASSED)"
-  exit 0
-else
-  echo "FAIL $TOTAL_PASSED/$TOTAL passed, $TOTAL_FAILED failed (parse: $PARSE_PASSED/$((PARSE_PASSED+PARSE_FAILED)), eval: $EVAL_PASSED/$((EVAL_PASSED+EVAL_FAILED)), error: $ERROR_PASSED/$((ERROR_PASSED+ERROR_FAILED)), namespace: $NAMESPACE_PASSED/$((NAMESPACE_PASSED+NAMESPACE_FAILED)), coro: $CORO_PASSED/$((CORO_PASSED+CORO_FAILED)), idiom: $IDIOM_PASSED/$((IDIOM_PASSED+IDIOM_FAILED)))"
-  if [ -z "$VERBOSE" ]; then
-    echo "--- output ---"
-    echo "$OUTPUT" | tail -30
-  fi
-  exit 1
-fi

lib/tcl/tests/coro.sx

@@ -1,136 +0,0 @@
-; Tcl-on-SX coroutine tests (Phase 6)
-(define tcl-coro-pass 0)
-(define tcl-coro-fail 0)
-(define tcl-coro-failures (list))
-
-(define
-  tcl-coro-assert
-  (fn
-    (label expected actual)
-    (if
-      (equal? expected actual)
-      (set! tcl-coro-pass (+ tcl-coro-pass 1))
-      (begin
-        (set! tcl-coro-fail (+ tcl-coro-fail 1))
-        (append!
-          tcl-coro-failures
-          (str label ": expected=" (str expected) " got=" (str actual)))))))
-
-(define
-  tcl-run-coro-tests
-  (fn
-    ()
-    (set! tcl-coro-pass 0)
-    (set! tcl-coro-fail 0)
-    (set! tcl-coro-failures (list))
-    (define interp (fn () (make-default-tcl-interp)))
-    (define run (fn (src) (tcl-eval-string (interp) src)))
-    (define
-      ok
-      (fn (label actual expected) (tcl-coro-assert label expected actual)))
-
-    ; --- basic coroutine: yields one value ---
-    (ok "coro-single-yield"
-      (get (run "proc gen {} { yield hello }\ncoroutine g gen\ng") :result)
-      "hello")
-
-    ; --- coroutine yields multiple values in order ---
-    (ok "coro-multi-yield-1"
-      (get (run "proc cnt {} { yield a; yield b; yield c }\ncoroutine c1 cnt\nc1") :result)
-      "a")
-
-    (ok "coro-multi-yield-2"
-      (get (run "proc cnt {} { yield a; yield b; yield c }\ncoroutine c1 cnt\nc1\nc1") :result)
-      "b")
-
-    (ok "coro-multi-yield-3"
-      (get (run "proc cnt {} { yield a; yield b; yield c }\ncoroutine c1 cnt\nc1\nc1\nc1") :result)
-      "c")
-
-    ; --- coroutine with arguments to proc ---
-    (ok "coro-args"
-      (get (run "proc gen2 {n} { yield $n; yield [expr {$n + 1}] }\ncoroutine g2 gen2 10\ng2") :result)
-      "10")
-
-    (ok "coro-args-2"
-      (get (run "proc gen2 {n} { yield $n; yield [expr {$n + 1}] }\ncoroutine g2 gen2 10\ng2\ng2") :result)
-      "11")
-
-    ; --- coroutine exhausted returns empty string ---
-    (ok "coro-exhausted"
-      (get (run "proc g3 {} { yield only }\ncoroutine c3 g3\nc3\nc3") :result)
-      "")
-
-    ; --- yield in while loop ---
-    (ok "coro-while-loop-1"
-      (get (run "proc counter {max} { set i 0; while {$i < $max} { yield $i; incr i } }\ncoroutine cw counter 3\ncw") :result)
-      "0")
-
-    (ok "coro-while-loop-2"
-      (get (run "proc counter {max} { set i 0; while {$i < $max} { yield $i; incr i } }\ncoroutine cw counter 3\ncw\ncw") :result)
-      "1")
-
-    (ok "coro-while-loop-3"
-      (get (run "proc counter {max} { set i 0; while {$i < $max} { yield $i; incr i } }\ncoroutine cw counter 3\ncw\ncw\ncw") :result)
-      "2")
-
-    ; --- collect all yields from coroutine ---
-    (ok "coro-collect-all"
-      (get
-        (run
-          "proc counter {n max} { while {$n < $max} { yield $n; incr n }; yield done }\ncoroutine gen1 counter 0 3\nset out {}\nfor {set i 0} {$i < 4} {incr i} { lappend out [gen1] }\nlindex $out 3")
-        :result)
-      "done")
-
-    ; --- two independent coroutines ---
-    (ok "coro-two-independent"
-      (get
-        (run
-          "proc seq {start} { yield $start; yield [expr {$start+1}] }\ncoroutine ca seq 0\ncoroutine cb seq 10\nset r [ca]\nappend r \":\" [cb]")
-        :result)
-      "0:10")
-
-    ; --- yield with no value returns empty string ---
-    (ok "coro-yield-no-val"
-      (get (run "proc g {} { yield }\ncoroutine cg g\ncg") :result)
-      "")
-
-    ; --- clock seconds stub ---
-    (ok "clock-seconds"
-      (get (run "clock seconds") :result)
-      "0")
-
-    ; --- clock milliseconds stub ---
-    (ok "clock-milliseconds"
-      (get (run "clock milliseconds") :result)
-      "0")
-
-    ; --- clock format stub ---
-    (ok "clock-format"
-      (get (run "clock format 0") :result)
-      "Thu Jan  1 00:00:00 UTC 1970")
-
-    ; --- file stubs ---
-    (ok "file-exists-stub"
-      (get (run "file exists /no/such/file") :result)
-      "0")
-
-    (ok "file-join"
-      (get (run "file join foo bar baz") :result)
-      "foo/bar/baz")
-
-    (ok "open-returns-channel"
-      (get (run "open /dev/null r") :result)
-      "file0")
-
-    (ok "eof-returns-1"
-      (get (run "set ch [open /dev/null r]\neof $ch") :result)
-      "1")
-
-    (dict
-      "passed"
-      tcl-coro-pass
-      "failed"
-      tcl-coro-fail
-      "failures"
-      tcl-coro-failures)))

lib/tcl/tests/error.sx

@@ -1,192 +0,0 @@
-; Tcl-on-SX error handling tests (Phase 4)
-(define tcl-err-pass 0)
-(define tcl-err-fail 0)
-(define tcl-err-failures (list))
-
-(define
-  tcl-err-assert
-  (fn
-    (label expected actual)
-    (if
-      (equal? expected actual)
-      (set! tcl-err-pass (+ tcl-err-pass 1))
-      (begin
-        (set! tcl-err-fail (+ tcl-err-fail 1))
-        (append!
-          tcl-err-failures
-          (str label ": expected=" (str expected) " got=" (str actual)))))))
-
-(define
-  tcl-run-error-tests
-  (fn
-    ()
-    (set! tcl-err-pass 0)
-    (set! tcl-err-fail 0)
-    (set! tcl-err-failures (list))
-    (define interp (fn () (make-default-tcl-interp)))
-    (define run (fn (src) (tcl-eval-string (interp) src)))
-    (define
-      ok
-      (fn (label actual expected) (tcl-err-assert label expected actual)))
-    (define
-      ok?
-      (fn (label condition) (tcl-err-assert label true condition)))
-
-    ; --- catch basic ---
-    (ok "catch-ok-code" (get (run "catch {set x 1}") :result) "0")
-    (ok "catch-ok-result-var" (tcl-var-get (run "catch {set x hello} r") "r") "hello")
-    (ok "catch-ok-returns-0" (get (run "catch {set x hello} r") :result) "0")
-
-    ; --- catch error ---
-    (ok "catch-error-code" (get (run "catch {error oops} r") :result) "1")
-    (ok "catch-error-result-var" (tcl-var-get (run "catch {error oops} r") "r") "oops")
-
-    ; --- catch outer code stays 0 ---
-    (ok? "catch-outer-code-ok" (= (get (run "catch {error boom} r") :code) 0))
-
-    ; --- catch code 2 (return) ---
-    (ok "catch-return-code" (get (run "proc p {} {return hello}\ncatch {p} r") :result) "0")
-    (ok "catch-return-val" (tcl-var-get (run "proc p {} {return hello}\ncatch {p} r") "r") "hello")
-
-    ; --- catch code 3 (break) ---
-    (ok "catch-break-code" (get (run "catch {break} r") :result) "3")
-
-    ; --- catch code 4 (continue) ---
-    (ok "catch-continue-code" (get (run "catch {continue} r") :result) "4")
-
-    ; --- catch no resultVar ---
-    (ok "catch-no-var-ok" (get (run "catch {set x 1}") :result) "0")
-    (ok "catch-no-var-err" (get (run "catch {error boom}") :result) "1")
-
-    ; --- catch with optsVar ---
-    (ok? "catch-opts-var-set"
-      (let
-        ((i (run "catch {error boom} r opts")))
-        (not (equal? (tcl-var-get i "opts") ""))))
-    (ok? "catch-opts-contains-code"
-      (let
-        ((i (run "catch {error boom} r opts")))
-        (let
-          ((opts-str (tcl-var-get i "opts")))
-          (not (equal? (tcl-string-first "-code" opts-str 0) "-1")))))
-
-    ; --- catch nested ---
-    (ok "catch-nested"
-      (tcl-var-get (run "catch {catch {error inner} r2} outer") "r2")
-      "inner")
-
-    ; --- return -code error ---
-    (ok "return-code-error-code"
-      (get (run "catch {return -code error oops} r") :result)
-      "1")
-    (ok "return-code-error-val"
-      (tcl-var-get (run "catch {return -code error oops} r") "r")
-      "oops")
-
-    ; --- return -code ok ---
-    (ok "return-code-ok"
-      (get (run "catch {return -code ok hello} r") :result)
-      "0")
-    (ok "return-code-ok-val"
-      (tcl-var-get (run "catch {return -code ok hello} r") "r")
-      "hello")
-
-    ; --- return -code break ---
-    (ok "return-code-break"
-      (get (run "catch {return -code break} r") :result)
-      "3")
-
-    ; --- return -code continue ---
-    (ok "return-code-continue"
-      (get (run "catch {return -code continue} r") :result)
-      "4")
-
-    ; --- return -code numeric ---
-    (ok "return-code-numeric-5"
-      (get (run "catch {return -code 5 msg} r") :result)
-      "5")
-
-    ; --- return plain still code 2 (catch sees raw return code) ---
-    (ok "return-plain-code"
-      (get (run "catch {return hello} r") :result)
-      "2")
-    (ok "return-plain-val"
-      (tcl-var-get (run "catch {return hello} r") "r")
-      "hello")
-
-    ; --- proc return -code error ---
-    (ok "proc-return-code-error"
-      (get (run "proc p {} {return -code error bad}\ncatch {p} r") :result)
-      "1")
-    (ok "proc-return-code-error-val"
-      (tcl-var-get (run "proc p {} {return -code error bad}\ncatch {p} r") "r")
-      "bad")
-
-    ; --- error with info/code args ---
-    (ok? "error-errorinfo-stored"
-      (let
-        ((i (run "catch {error msg myinfo mycode} r")))
-        (= (get i :code) 0)))
-
-    ; --- throw ---
-    (ok "throw-code" (get (run "catch {throw MYERR something} r") :result) "1")
-    (ok "throw-msg" (tcl-var-get (run "catch {throw MYERR something} r") "r") "something")
-
-    ; --- try basic ok ---
-    (ok "try-ok-result"
-      (get (run "try {set x hello} on ok {r} {set r2 $r}") :result)
-      "hello")
-
-    ; --- try on error ---
-    (ok "try-on-error-handled"
-      (get (run "try {error boom} on error {e} {set caught $e}") :result)
-      "boom")
-    (ok "try-on-error-var"
-      (tcl-var-get (run "try {error boom} on error {e} {set caught $e}") "caught")
-      "boom")
-
-    ; --- try finally always runs ---
-    (ok "try-finally-ok"
-      (tcl-var-get (run "try {set x 1} finally {set done yes}") "done")
-      "yes")
-    (ok "try-finally-error"
-      (tcl-var-get (run "catch {try {error boom} finally {set done yes}} r") "done")
-      "yes")
-
-    ; --- try on error + finally ---
-    (ok "try-error-finally"
-      (tcl-var-get
-        (run "try {error oops} on error {e} {set caught $e} finally {set cleaned yes}")
-        "cleaned")
-      "yes")
-    (ok "try-error-finally-caught"
-      (tcl-var-get
-        (run "try {error oops} on error {e} {set caught $e} finally {set cleaned yes}")
-        "caught")
-      "oops")
-
-    ; --- try on ok and on error ---
-    (ok "try-multi-clause-ok"
-      (tcl-var-get
-        (run "try {set x 1} on ok {r} {set which ok} on error {e} {set which err}")
-        "which")
-      "ok")
-    (ok "try-multi-clause-err"
-      (tcl-var-get
-        (run "try {error boom} on ok {r} {set which ok} on error {e} {set which err}")
-        "which")
-      "err")
-
-    ; --- catch preserves output ---
-    (ok "catch-output-preserved"
-      (get (run "puts -nonewline before\ncatch {puts -nonewline inside\nerror oops}\nputs -nonewline after")
-        :output)
-      "beforeinsideafter")
-
-    (dict
-      "passed"
-      tcl-err-pass
-      "failed"
-      tcl-err-fail
-      "failures"
-      tcl-err-failures)))

lib/tcl/tests/eval.sx

@@ -1,338 +0,0 @@
-; Tcl-on-SX eval tests
-(define tcl-eval-pass 0)
-(define tcl-eval-fail 0)
-(define tcl-eval-failures (list))
-
-(define
-  tcl-eval-assert
-  (fn
-    (label expected actual)
-    (if
-      (equal? expected actual)
-      (set! tcl-eval-pass (+ tcl-eval-pass 1))
-      (begin
-        (set! tcl-eval-fail (+ tcl-eval-fail 1))
-        (append!
-          tcl-eval-failures
-          (str label ": expected=" (str expected) " got=" (str actual)))))))
-
-(define
-  tcl-run-eval-tests
-  (fn
-    ()
-    (set! tcl-eval-pass 0)
-    (set! tcl-eval-fail 0)
-    (set! tcl-eval-failures (list))
-    (define interp (fn () (make-default-tcl-interp)))
-    (define run (fn (src) (tcl-eval-string (interp) src)))
-    (define
-      ok
-      (fn (label actual expected) (tcl-eval-assert label expected actual)))
-    (define
-      ok?
-      (fn (label condition) (tcl-eval-assert label true condition)))
-    (tcl-eval-assert "set-result" "hello" (get (run "set x hello") :result))
-    (tcl-eval-assert
-      "set-stored"
-      "hello"
-      (tcl-var-get (run "set x hello") "x"))
-    (tcl-eval-assert
-      "var-sub"
-      "hello"
-      (tcl-var-get (run "set x hello\nset y $x") "y"))
-    (tcl-eval-assert
-      "puts"
-      "world\n"
-      (get (run "set x world\nputs $x") :output))
-    (tcl-eval-assert
-      "puts-nonewline"
-      "hi"
-      (get (run "puts -nonewline hi") :output))
-    (tcl-eval-assert "incr" "6" (tcl-var-get (run "set x 5\nincr x") "x"))
-    (tcl-eval-assert
-      "incr-delta"
-      "8"
-      (tcl-var-get (run "set x 5\nincr x 3") "x"))
-    (tcl-eval-assert
-      "incr-neg"
-      "7"
-      (tcl-var-get (run "set x 10\nincr x -3") "x"))
-    (tcl-eval-assert
-      "append"
-      "foobar"
-      (tcl-var-get (run "set x foo\nappend x bar") "x"))
-    (tcl-eval-assert
-      "append-new"
-      "hello"
-      (tcl-var-get (run "append x hello") "x"))
-    (tcl-eval-assert
-      "cmdsub-result"
-      "6"
-      (get (run "set x 5\nset y [incr x]") :result))
-    (tcl-eval-assert
-      "cmdsub-y"
-      "6"
-      (tcl-var-get (run "set x 5\nset y [incr x]") "y"))
-    (tcl-eval-assert
-      "cmdsub-x"
-      "6"
-      (tcl-var-get (run "set x 5\nset y [incr x]") "x"))
-    (tcl-eval-assert
-      "multi-cmd"
-      "second"
-      (get (run "set x first\nset x second") :result))
-    (tcl-eval-assert "semi-x" "1" (tcl-var-get (run "set x 1; set y 2") "x"))
-    (tcl-eval-assert "semi-y" "2" (tcl-var-get (run "set x 1; set y 2") "y"))
-    (tcl-eval-assert
-      "braced-nosub"
-      "$x"
-      (tcl-var-get (run "set x 42\nset y {$x}") "y"))
-    (tcl-eval-assert
-      "concat-word"
-      "foobar"
-      (tcl-var-get (run "set x foo\nset y ${x}bar") "y"))
-    (tcl-eval-assert
-      "set-get"
-      "world"
-      (get (run "set x world\nset x") :result))
-    (tcl-eval-assert
-      "puts-channel"
-      "hello\n"
-      (get (run "puts stdout hello") :output))
-    (ok "if-true" (get (run "set x 0\nif {1} {set x 1}") :result) "1")
-    (ok "if-false" (get (run "set x 0\nif {0} {set x 1}") :result) "0")
-    (ok
-      "if-else-t"
-      (tcl-var-get (run "if {1} {set x yes} else {set x no}") "x")
-      "yes")
-    (ok
-      "if-else-f"
-      (tcl-var-get (run "if {0} {set x yes} else {set x no}") "x")
-      "no")
-    (ok
-      "if-cmp"
-      (tcl-var-get
-        (run "set x 5\nif {$x > 3} {set r big} else {set r small}")
-        "r")
-      "big")
-    (ok
-      "while"
-      (tcl-var-get
-        (run "set i 0\nset s 0\nwhile {$i < 5} {incr i\nincr s $i}")
-        "s")
-      "15")
-    (ok
-      "while-break"
-      (tcl-var-get
-        (run "set i 0\nwhile {1} {incr i\nif {$i == 3} {break}}")
-        "i")
-      "3")
-    (ok
-      "for"
-      (tcl-var-get
-        (run "set s 0\nfor {set i 1} {$i <= 5} {incr i} {incr s $i}")
-        "s")
-      "15")
-    (ok
-      "foreach"
-      (tcl-var-get (run "set s 0\nforeach x {1 2 3 4 5} {incr s $x}") "s")
-      "15")
-    (ok
-      "foreach-list"
-      (get (run "set acc \"\"\nforeach w {hello world} {append acc $w}") :result)
-      "helloworld")
-    (ok
-      "lappend"
-      (tcl-var-get (run "lappend lst a\nlappend lst b\nlappend lst c") "lst")
-      "a b c")
-    (ok?
-      "unset-gone"
-      (let
-        ((i (run "set x 42\nunset x")))
-        (let
-          ((frame (get i :frame)))
-          (nil? (get (get frame :locals) "x")))))
-    (ok "eval" (tcl-var-get (run "eval {set x hello}") "x") "hello")
-    (ok "expr-precedence" (get (run "expr {3 + 4 * 2}") :result) "11")
-    (ok "expr-parens" (get (run "expr {(3 + 4) * 2}") :result) "14")
-    (ok "expr-unary-minus" (get (run "expr {-5}") :result) "-5")
-    (ok "expr-unary-not-0" (get (run "expr {!0}") :result) "1")
-    (ok "expr-unary-not-1" (get (run "expr {!1}") :result) "0")
-    (ok "expr-power" (get (run "expr {2 ** 10}") :result) "1024")
-    (ok "expr-le" (get (run "expr {3 <= 3}") :result) "1")
-    (ok "expr-ge" (get (run "expr {4 >= 5}") :result) "0")
-    (ok "expr-and" (get (run "expr {1 && 1}") :result) "1")
-    (ok "expr-or" (get (run "expr {0 || 1}") :result) "1")
-    (ok "expr-var-sub" (get (run "set x 7\nexpr {$x * 3}") :result) "21")
-    (ok "expr-abs-neg" (get (run "expr {abs(-3)}") :result) "3")
-    (ok "expr-abs-pos" (get (run "expr {abs(5)}") :result) "5")
-    (ok "expr-pow-fn" (get (run "expr {pow(2, 8)}") :result) "256")
-    (ok "expr-max" (get (run "expr {max(3, 7)}") :result) "7")
-    (ok "expr-min" (get (run "expr {min(3, 7)}") :result) "3")
-    (ok "expr-sqrt-9" (get (run "expr {sqrt(9)}") :result) "3")
-    (ok "expr-sqrt-16" (get (run "expr {sqrt(16)}") :result) "4")
-    (ok "expr-mod" (get (run "expr {17 % 5}") :result) "2")
-    (ok "expr-nospace" (get (run "expr {3+4*2}") :result) "11")
-    (ok "expr-add" (get (run "expr {3 + 4}") :result) "7")
-    (ok "expr-cmp" (get (run "expr {5 > 3}") :result) "1")
-    (ok
-      "break-stops"
-      (tcl-var-get (run "set x 0\nwhile {1} {set x 1\nbreak\nset x 99}") "x")
-      "1")
-    (ok
-      "continue"
-      (tcl-var-get
-        (run
-          "set s 0\nfor {set i 1} {$i <= 5} {incr i} {if {$i == 3} {continue}\nincr s $i}")
-        "s")
-      "12")
-    (ok
-      "switch"
-      (tcl-var-get
-        (run "set x foo\nswitch $x {{foo} {set r yes} {bar} {set r no}}")
-        "r")
-      "yes")
-    (ok
-      "switch-default"
-      (tcl-var-get
-        (run "set x baz\nswitch $x {{foo} {set r yes} default {set r other}}")
-        "r")
-      "other")
-    (ok
-      "nested-if"
-      (tcl-var-get
-        (run
-          "set x 5\nif {$x > 10} {set r big} elseif {$x > 3} {set r mid} else {set r small}")
-        "r")
-      "mid")
-    (ok "str-length" (get (run "string length hello") :result) "5")
-    (ok "str-length-empty" (get (run "string length {}") :result) "0")
-    (ok "str-index" (get (run "string index hello 1") :result) "e")
-    (ok "str-index-oob" (get (run "string index hello 99") :result) "")
-    (ok "str-range" (get (run "string range hello 1 3") :result) "ell")
-    (ok "str-range-clamp" (get (run "string range hello 3 99") :result) "lo")
-    (ok "str-compare-eq" (get (run "string compare abc abc") :result) "0")
-    (ok "str-compare-lt" (get (run "string compare abc abd") :result) "-1")
-    (ok "str-compare-gt" (get (run "string compare b a") :result) "1")
-    (ok "str-match-star" (get (run "string match h*o hello") :result) "1")
-    (ok "str-match-q" (get (run "string match h?llo hello") :result) "1")
-    (ok "str-match-no" (get (run "string match h*x hello") :result) "0")
-    (ok "str-toupper" (get (run "string toupper hello") :result) "HELLO")
-    (ok "str-tolower" (get (run "string tolower WORLD") :result) "world")
-    (ok "str-trim" (get (run "string trim {  hi  }") :result) "hi")
-    (ok "str-trimleft" (get (run "string trimleft {  hi  }") :result) "hi  ")
-    (ok "str-trimright" (get (run "string trimright {  hi  }") :result) "  hi")
-    (ok "str-trim-chars" (get (run "string trim {xxhelloxx} x") :result) "hello")
-    (ok "str-map" (get (run "string map {a X b Y} {abc}") :result) "XYc")
-    (ok "str-repeat" (get (run "string repeat ab 3") :result) "ababab")
-    (ok "str-first" (get (run "string first ll hello") :result) "2")
-    (ok "str-first-miss" (get (run "string first z hello") :result) "-1")
-    (ok "str-last" (get (run "string last l hello") :result) "3")
-    (ok "str-is-int" (get (run "string is integer 42") :result) "1")
-    (ok "str-is-not-int" (get (run "string is integer foo") :result) "0")
-    (ok "str-is-alpha" (get (run "string is alpha hello") :result) "1")
-    (ok "str-is-alpha-no" (get (run "string is alpha hello1") :result) "0")
-    (ok "str-is-boolean" (get (run "string is boolean true") :result) "1")
-    (ok "str-cat" (get (run "string cat foo bar baz") :result) "foobarbaz")
-    ; --- list command tests ---
-    (ok "list-simple" (get (run "list a b c") :result) "a b c")
-    (ok "list-brace-elem" (get (run "list {a b} c") :result) "{a b} c")
-    (ok "list-empty" (get (run "list") :result) "")
-    (ok "lindex-1" (get (run "lindex {a b c} 1") :result) "b")
-    (ok "lindex-0" (get (run "lindex {a b c} 0") :result) "a")
-    (ok "lindex-oob" (get (run "lindex {a b c} 5") :result) "")
-    (ok "lrange" (get (run "lrange {a b c d} 1 2") :result) "b c")
-    (ok "lrange-full" (get (run "lrange {a b c} 0 end") :result) "a b c")
-    (ok "llength" (get (run "llength {a b c}") :result) "3")
-    (ok "llength-empty" (get (run "llength {}") :result) "0")
-    (ok "lreverse" (get (run "lreverse {1 2 3}") :result) "3 2 1")
-    (ok "lsearch-found" (get (run "lsearch {a b c} b") :result) "1")
-    (ok "lsearch-missing" (get (run "lsearch {a b c} z") :result) "-1")
-    (ok "lsearch-exact" (get (run "lsearch -exact {foo bar} foo") :result) "0")
-    (ok "lsort-asc" (get (run "lsort {banana apple cherry}") :result) "apple banana cherry")
-    (ok "lsort-int" (get (run "lsort -integer {10 2 30 5}") :result) "2 5 10 30")
-    (ok "lsort-dec" (get (run "lsort -decreasing {c a b}") :result) "c b a")
-    (ok "lreplace" (get (run "lreplace {a b c d} 1 2 X Y") :result) "a X Y d")
-    (ok "linsert" (get (run "linsert {a b c} 1 X Y") :result) "a X Y b c")
-    (ok "linsert-end" (get (run "linsert {a b} end Z") :result) "a b Z")
-    (ok "concat" (get (run "concat {a b} {c d}") :result) "a b c d")
-    (ok "split-sep" (get (run "split {a:b:c} :") :result) "a b c")
-    (ok "split-ws" (get (run "split {a b c}") :result) "a b c")
-    (ok "join-sep" (get (run "join {a b c} -") :result) "a-b-c")
-    (ok "join-default" (get (run "join {a b c}") :result) "a b c")
-    (ok "list-var" (get (run "set L {x y z}\nllength $L") :result) "3")
-    ; --- dict command tests ---
-    (ok "dict-create" (get (run "dict create a 1 b 2") :result) "a 1 b 2")
-    (ok "dict-create-empty" (get (run "dict create") :result) "")
-    (ok "dict-get" (get (run "dict get {a 1 b 2} a") :result) "1")
-    (ok "dict-get-b" (get (run "dict get {a 1 b 2} b") :result) "2")
-    (ok "dict-exists-yes" (get (run "dict exists {a 1 b 2} a") :result) "1")
-    (ok "dict-exists-no" (get (run "dict exists {a 1 b 2} z") :result) "0")
-    (ok "dict-set-new" (get (run "set d {}\ndict set d x 42") :result) "x 42")
-    (ok "dict-set-update" (get (run "set d {a 1 b 2}\ndict set d a 99") :result) "a 99 b 2")
-    (ok "dict-set-stored" (tcl-var-get (run "set d {a 1}\ndict set d b 2") "d") "a 1 b 2")
-    (ok "dict-unset" (get (run "set d {a 1 b 2}\ndict unset d a") :result) "b 2")
-    (ok "dict-unset-stored" (tcl-var-get (run "set d {a 1 b 2}\ndict unset d a") "d") "b 2")
-    (ok "dict-keys" (get (run "dict keys {a 1 b 2}") :result) "a b")
-    (ok "dict-keys-pattern" (get (run "dict keys {abc 1 abd 2 xyz 3} ab*") :result) "abc abd")
-    (ok "dict-values" (get (run "dict values {a 1 b 2}") :result) "1 2")
-    (ok "dict-size" (get (run "dict size {a 1 b 2 c 3}") :result) "3")
-    (ok "dict-size-empty" (get (run "dict size {}") :result) "0")
-    (ok "dict-for" (tcl-var-get (run "set acc {}\ndict for {k v} {a 1 b 2} {append acc $k$v}") "acc") "a1b2")
-    (ok "dict-merge-disjoint" (get (run "dict merge {a 1} {b 2}") :result) "a 1 b 2")
-    (ok "dict-merge-overlap" (get (run "dict merge {a 1 b 2} {b 99}") :result) "a 1 b 99")
-    (ok "dict-incr-existing" (get (run "set d {x 5}\ndict incr d x") :result) "x 6")
-    (ok "dict-incr-delta" (get (run "set d {x 5}\ndict incr d x 3") :result) "x 8")
-    (ok "dict-incr-missing" (get (run "set d {}\ndict incr d n") :result) "n 1")
-    (ok "dict-append" (get (run "set d {x hello}\ndict append d x _hi") :result) "x hello_hi")
-    (ok "dict-append-new" (get (run "set d {}\ndict append d k val") :result) "k val")
-    ; --- proc tests ---
-    (ok "proc-basic" (get (run "proc add {a b} {expr {$a + $b}}\nadd 3 4") :result) "7")
-    (ok "proc-return" (get (run "proc greet {name} {set msg \"hi $name\"\nreturn $msg}\ngreet World") :result) "hi World")
-    (ok "proc-factorial" (get (run "proc factorial {n} {if {$n <= 1} {return 1}\nexpr {$n * [factorial [expr {$n - 1}]]}}\nfactorial 5") :result) "120")
-    (ok "proc-args" (get (run "proc sum args {set t 0\nforeach x $args {incr t $x}\nreturn $t}\nsum 1 2 3 4") :result) "10")
-    (ok "proc-isolated" (get (run "set x outer\nproc p {} {set x inner\nreturn $x}\np") :result) "inner")
-    (ok "proc-caller-unchanged" (tcl-var-get (run "set x outer\nproc p {} {set x inner\nreturn $x}\np\nset dummy 1") "x") "outer")
-    (ok "proc-output" (get (run "proc hello {} {puts -nonewline hi}\nhello") :output) "hi")
-    ; --- upvar tests ---
-    (ok "upvar-incr" (tcl-var-get (run "proc incr2 {varname} {upvar 1 $varname v\nincr v}\nset counter 10\nincr2 counter\nset counter") "counter") "11")
-    (ok "upvar-double" (tcl-var-get (run "proc double-it {varname} {upvar 1 $varname x\nset x [expr {$x * 2}]}\nset val 5\ndouble-it val\nset val") "val") "10")
-    (ok "upvar-result" (get (run "proc double-it {varname} {upvar 1 $varname x\nset x [expr {$x * 2}]}\nset val 5\ndouble-it val\nset val") :result) "10")
-    ; --- uplevel tests ---
-    (ok "uplevel-set" (tcl-var-get (run "proc setvar {name val} {uplevel 1 \"set $name $val\"}\nsetvar x 99\nset x") "x") "99")
-    (ok "uplevel-get" (get (run "proc getvar {name} {uplevel 1 \"set $name\"}\nset y 77\ngetvar y") :result) "77")
-    ; --- global tests ---
-    (ok "global-read" (get (run "set g 100\nproc getg {} {global g\nreturn $g}\ngetg") :result) "100")
-    (ok "global-write" (tcl-var-get (run "set g 0\nproc bumping {} {global g\nincr g}\nbumping\nbumping\nset g") "g") "2")
-    ; --- info tests ---
-    (ok "info-level-0" (get (run "info level") :result) "0")
-    (ok "info-level-proc" (get (run "proc p {} {info level}\np") :result) "1")
-    (ok "info-procs" (let ((r (get (run "proc myfn {} {}\ninfo procs") :result))) (contains? (tcl-list-split r) "myfn")) true)
-    (ok "info-args" (get (run "proc add {a b} {expr {$a+$b}}\ninfo args add") :result) "a b")
-    (ok "info-commands-has-set" (let ((r (get (run "info commands") :result))) (contains? (tcl-list-split r) "set")) true)
-    ; --- classic programs ---
-    (ok
-      "classic-for-each-line"
-      (get
-        (run "proc for-each-line {var lines body} {\n    foreach item $lines {\n        uplevel 1 [list set $var $item]\n        uplevel 1 $body\n    }\n}\nset total 0\nfor-each-line line {hello world foo} {\n    incr total [string length $line]\n}\nset total")
-        :result)
-      "13")
-    (ok
-      "classic-assert"
-      (get
-        (run "proc assert {expr_str} {\n    set result [uplevel 1 [list expr $expr_str]]\n    if {!$result} {\n        error \"Assertion failed: $expr_str\"\n    }\n}\nset x 42\nassert {$x == 42}\nassert {$x > 0}\nset x 10\nassert {$x < 100}\nset x")
-        :result)
-      "10")
-    (ok
-      "classic-with-temp-var"
-      (get
-        (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)
-      "100 999")
-    (dict
-      "passed"
-      tcl-eval-pass
-      "failed"
-      tcl-eval-fail
-      "failures"
-      tcl-eval-failures)))

lib/tcl/tests/idioms.sx

@@ -1,193 +0,0 @@
-; Tcl-on-SX idiom corpus (Phase 6)
-; Classic Tcl idioms covering lists, dicts, procs, patterns
-(define tcl-idiom-pass 0)
-(define tcl-idiom-fail 0)
-(define tcl-idiom-failures (list))
-
-(define
-  tcl-idiom-assert
-  (fn
-    (label expected actual)
-    (if
-      (equal? expected actual)
-      (set! tcl-idiom-pass (+ tcl-idiom-pass 1))
-      (begin
-        (set! tcl-idiom-fail (+ tcl-idiom-fail 1))
-        (append!
-          tcl-idiom-failures
-          (str label ": expected=" (str expected) " got=" (str actual)))))))
-
-(define
-  tcl-run-idiom-tests
-  (fn
-    ()
-    (set! tcl-idiom-pass 0)
-    (set! tcl-idiom-fail 0)
-    (set! tcl-idiom-failures (list))
-    (define interp (fn () (make-default-tcl-interp)))
-    (define run (fn (src) (tcl-eval-string (interp) src)))
-    (define
-      ok
-      (fn (label actual expected) (tcl-idiom-assert label expected actual)))
-
-    ; 1. lmap idiom: accumulate mapped values with foreach+lappend
-    (ok "idiom-lmap"
-      (get
-        (run "set result {}\nforeach x {1 2 3} { lappend result [expr {$x * $x}] }\nset result")
-        :result)
-      "1 4 9")
-
-    ; 2. Recursive list flatten
-    (ok "idiom-flatten"
-      (get
-        (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}}}")
-        :result)
-      "1 2 3 4 5 6")
-
-    ; 3. String builder accumulator
-    (ok "idiom-string-builder"
-      (get
-        (run "set buf \"\"\nforeach w {Hello World Tcl} { append buf $w \" \" }\nstring trimright $buf")
-        :result)
-      "Hello World Tcl")
-
-    ; 4. Default parameter via info exists
-    (ok "idiom-default-param"
-      (get
-        (run "if {![info exists x]} { set x 42 }\nset x")
-        :result)
-      "42")
-
-    ; 5. Association list lookup (parallel key/value lists)
-    (ok "idiom-alist-lookup"
-      (get
-        (run
-          "set keys {a b c}\nset vals {10 20 30}\nset idx [lsearch $keys b]\nlindex $vals $idx")
-        :result)
-      "20")
-
-    ; 6. Proc with optional args via args
-    (ok "idiom-optional-args"
-      (get
-        (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")
-        :result)
-      "Hi World")
-
-    ; 7. Builder pattern: dict create from args
-    (ok "idiom-dict-builder"
-      (get
-        (run
-          "proc build-dict {args} { dict create {*}$args }\ndict get [build-dict name Alice age 30] name")
-        :result)
-      "Alice")
-
-    ; 8. Loop with index using array
-    (ok "idiom-loop-with-index"
-      (get
-        (run
-          "set i 0\nforeach x {a b c} { set arr($i) $x; incr i }\nset arr(1)")
-        :result)
-      "b")
-
-    ; 9. String reverse via split+lreverse+join
-    (ok "idiom-string-reverse"
-      (get
-        (run
-          "set s hello\nset chars [split $s \"\"]\nset rev [lreverse $chars]\njoin $rev \"\"")
-        :result)
-      "olleh")
-
-    ; 10. Number to padded string
-    (ok "idiom-number-format"
-      (get (run "format \"%05d\" 42") :result)
-      "00042")
-
-    ; 11. Dict comprehension pattern
-    (ok "idiom-dict-comprehension"
-      (get
-        (run
-          "set squares {}\nforeach n {1 2 3 4} { dict set squares $n [expr {$n * $n}] }\ndict get $squares 3")
-        :result)
-      "9")
-
-    ; 12. Stack ADT using list: push/pop
-    (ok "idiom-stack"
-      (get
-        (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")
-        :result)
-      "30")
-
-    ; 13. Queue ADT using list: enqueue/dequeue
-    (ok "idiom-queue"
-      (get
-        (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")
-        :result)
-      "alpha")
-
-    ; 14. Pipeline via proc chaining
-    (ok "idiom-pipeline"
-      (get
-        (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}")
-        :result)
-      "22")
-
-    ; 15. Memoize pattern using dict (simple cache, not recursive)
-    (ok "idiom-memoize"
-      (get
-        (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}")
-        :result)
-      "1")
-
-    ; 16. Simple expression evaluator in Tcl (recursive descent)
-    (ok "idiom-recursive-eval"
-      (get
-        (run
-          "proc calc {expr} { return [::tcl::mathop::+ 0 [expr $expr]] }\nexpr {3 + 4 * 2}")
-        :result)
-      "11")
-
-    ; 17. Apply proc to each pair in a dict
-    (ok "idiom-dict-for"
-      (get
-        (run
-          "set d [dict create a 1 b 2 c 3]\nset total 0\ndict for {k v} $d { incr total $v }\nset total")
-        :result)
-      "6")
-
-    ; 18. Find max in list
-    (ok "idiom-find-max"
-      (get
-        (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}")
-        :result)
-      "9")
-
-    ; 19. Filter list by predicate
-    (ok "idiom-filter-list"
-      (get
-        (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")
-        :result)
-      "2 4 6")
-
-    ; 20. Zip two lists
-    (ok "idiom-zip"
-      (get
-        (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}")
-        :result)
-      "1 a 2 b 3 c")
-
-    (dict
-      "passed"
-      tcl-idiom-pass
-      "failed"
-      tcl-idiom-fail
-      "failures"
-      tcl-idiom-failures)))

lib/tcl/tests/namespace.sx

@@ -1,147 +0,0 @@
-; Tcl-on-SX namespace tests (Phase 5)
-(define tcl-ns-pass 0)
-(define tcl-ns-fail 0)
-(define tcl-ns-failures (list))
-
-(define
-  tcl-ns-assert
-  (fn
-    (label expected actual)
-    (if
-      (equal? expected actual)
-      (set! tcl-ns-pass (+ tcl-ns-pass 1))
-      (begin
-        (set! tcl-ns-fail (+ tcl-ns-fail 1))
-        (append!
-          tcl-ns-failures
-          (str label ": expected=" (str expected) " got=" (str actual)))))))
-
-(define
-  tcl-run-namespace-tests
-  (fn
-    ()
-    (set! tcl-ns-pass 0)
-    (set! tcl-ns-fail 0)
-    (set! tcl-ns-failures (list))
-    (define interp (fn () (make-default-tcl-interp)))
-    (define run (fn (src) (tcl-eval-string (interp) src)))
-    (define
-      ok
-      (fn (label actual expected) (tcl-ns-assert label expected actual)))
-    (define
-      ok?
-      (fn (label condition) (tcl-ns-assert label true condition)))
-
-    ; --- namespace current ---
-    (ok "ns-current-global"
-      (get (run "namespace current") :result)
-      "::")
-
-    ; --- namespace eval defines proc ---
-    (ok "ns-eval-proc-result"
-      (get (run "namespace eval myns { proc foo {} { return bar } }\nmyns::foo") :result)
-      "bar")
-
-    ; --- fully qualified call ---
-    (ok "ns-qualified-call"
-      (get (run "namespace eval myns { proc greet {name} { return \"hello $name\" } }\n::myns::greet World") :result)
-      "hello World")
-
-    ; --- namespace current inside eval ---
-    (ok "ns-current-inside"
-      (get (run "namespace eval myns { namespace current }") :result)
-      "::myns")
-
-    ; --- namespace current restored after eval ---
-    (ok "ns-current-restored"
-      (get (run "namespace eval myns { set x 1 }\nnamespace current") :result)
-      "::")
-
-    ; --- relative call from within namespace ---
-    (ok "ns-relative-call"
-      (get (run "namespace eval math {\n  proc double {x} { expr {$x * 2} }\n  proc quad {x} { double [double $x] }\n}\nmath::quad 3") :result)
-      "12")
-
-    ; --- proc defined as qualified name inside namespace eval ---
-    (ok "ns-qualified-proc-name"
-      (get (run "namespace eval utils { proc ::utils::helper {x} { return $x } }\n::utils::helper done") :result)
-      "done")
-
-    ; --- namespace exists ---
-    (ok "ns-exists-yes"
-      (get (run "namespace eval testns { proc p {} {} }\nnamespace exists testns") :result)
-      "1")
-
-    (ok "ns-exists-no"
-      (get (run "namespace exists nosuchns") :result)
-      "0")
-
-    (ok "ns-exists-global"
-      (get (run "proc top {} {}\nnamespace exists ::") :result)
-      "1")
-
-    ; --- namespace delete ---
-    (ok "ns-delete-removes"
-      (get (run "namespace eval todel { proc pp {} { return yes } }\nnamespace delete todel\nnamespace exists todel") :result)
-      "0")
-
-    ; --- namespace which ---
-    (ok "ns-which-found"
-      (get (run "namespace eval wns { proc wfn {} {} }\nnamespace which -command wns::wfn") :result)
-      "::wns::wfn")
-
-    (ok "ns-which-not-found"
-      (get (run "namespace which -command nosuchfn") :result)
-      "")
-
-    ; --- namespace ensemble create auto-map ---
-    (ok "ns-ensemble-add"
-      (get (run "namespace eval mymath {\n  proc add {a b} { expr {$a + $b} }\n  proc mul {a b} { expr {$a * $b} }\n  namespace ensemble create\n}\nmymath add 3 4") :result)
-      "7")
-
-    (ok "ns-ensemble-mul"
-      (get (run "namespace eval mymath {\n  proc add {a b} { expr {$a + $b} }\n  proc mul {a b} { expr {$a * $b} }\n  namespace ensemble create\n}\nmymath mul 3 4") :result)
-      "12")
-
-    ; --- namespace ensemble with -map ---
-    (ok "ns-ensemble-map"
-      (get (run "namespace eval ops {\n  proc do-add {a b} { expr {$a + $b} }\n  namespace ensemble create -map {plus ::ops::do-add}\n}\nops plus 5 6") :result)
-      "11")
-
-    ; --- proc inside namespace eval with args ---
-    (ok "ns-proc-args"
-      (get (run "namespace eval calc {\n  proc sum {a b c} { expr {$a + $b + $c} }\n}\ncalc::sum 1 2 3") :result)
-      "6")
-
-    ; --- info procs inside namespace ---
-    (ok? "ns-info-procs-in-ns"
-      (let
-        ((r (get (run "namespace eval foo { proc bar {} {} }\nnamespace eval foo { info procs }") :result)))
-        (contains? (tcl-list-split r) "bar")))
-
-    ; --- variable inside namespace eval ---
-    (ok "ns-variable-inside"
-      (get (run "namespace eval storage {\n  variable count 0\n  proc bump {} { global count\n    incr count\n    return $count }\n}\n::storage::bump\n::storage::bump") :result)
-      "2")
-
-    ; --- nested namespaces ---
-    (ok "ns-nested"
-      (get (run "namespace eval outer {\n  namespace eval inner {\n    proc greet {} { return nested }\n  }\n}\n::outer::inner::greet") :result)
-      "nested")
-
-    ; --- namespace eval accumulates procs ---
-    (ok "ns-eval-accumulate"
-      (get (run "namespace eval acc { proc f1 {} { return one } }\nnamespace eval acc { proc f2 {} { return two } }\nacc::f1") :result)
-      "one")
-
-    (ok "ns-eval-accumulate-2"
-      (get (run "namespace eval acc { proc f1 {} { return one } }\nnamespace eval acc { proc f2 {} { return two } }\nacc::f2") :result)
-      "two")
-
-    (dict
-      "passed"
-      tcl-ns-pass
-      "failed"
-      tcl-ns-fail
-      "failures"
-      tcl-ns-failures)))

lib/tcl/tests/parse.sx

@@ -1,186 +0,0 @@
-(define tcl-parse-pass 0)
-(define tcl-parse-fail 0)
-(define tcl-parse-failures (list))
-
-(define tcl-assert
-  (fn (label expected actual)
-    (if (= expected actual)
-      (set! tcl-parse-pass (+ tcl-parse-pass 1))
-      (begin
-        (set! tcl-parse-fail (+ tcl-parse-fail 1))
-        (append! tcl-parse-failures
-          (str label ": expected=" (str expected) " got=" (str actual)))))))
-
-(define tcl-first-cmd
-  (fn (src) (nth (tcl-tokenize src) 0)))
-
-(define tcl-cmd-words
-  (fn (src) (get (tcl-first-cmd src) :words)))
-
-(define tcl-word
-  (fn (src wi) (nth (tcl-cmd-words src) wi)))
-
-(define tcl-parts
-  (fn (src wi) (get (tcl-word src wi) :parts)))
-
-(define tcl-part
-  (fn (src wi pi) (nth (tcl-parts src wi) pi)))
-
-(define tcl-run-parse-tests
-  (fn ()
-    (set! tcl-parse-pass 0)
-    (set! tcl-parse-fail 0)
-    (set! tcl-parse-failures (list))
-
-    ; empty / whitespace-only
-    (tcl-assert "empty" 0 (len (tcl-tokenize "")))
-    (tcl-assert "ws-only" 0 (len (tcl-tokenize "   ")))
-    (tcl-assert "nl-only" 0 (len (tcl-tokenize "\n\n")))
-
-    ; single command word count
-    (tcl-assert "1word" 1 (len (tcl-cmd-words "set")))
-    (tcl-assert "3words" 3 (len (tcl-cmd-words "set x 1")))
-    (tcl-assert "4words" 4 (len (tcl-cmd-words "set a b c")))
-
-    ; word type — bare word is compound
-    (tcl-assert "bare-type" "compound" (get (tcl-word "set x 1" 0) :type))
-    (tcl-assert "bare-quoted" false (get (tcl-word "set x 1" 0) :quoted))
-    (tcl-assert "bare-part-type" "text" (get (tcl-part "set x 1" 0 0) :type))
-    (tcl-assert "bare-part-val" "set" (get (tcl-part "set x 1" 0 0) :value))
-    (tcl-assert "bare-part2-val" "x" (get (tcl-part "set x 1" 1 0) :value))
-    (tcl-assert "bare-part3-val" "1" (get (tcl-part "set x 1" 2 0) :value))
-
-    ; multiple commands
-    (tcl-assert "semi-sep" 2 (len (tcl-tokenize "set x 1; set y 2")))
-    (tcl-assert "nl-sep" 2 (len (tcl-tokenize "set x 1\nset y 2")))
-    (tcl-assert "multi-nl" 3 (len (tcl-tokenize "a\nb\nc")))
-
-    ; comments
-    (tcl-assert "comment-only" 0 (len (tcl-tokenize "# comment")))
-    (tcl-assert "comment-nl" 0 (len (tcl-tokenize "# comment\n")))
-    (tcl-assert "comment-then-cmd" 1 (len (tcl-tokenize "# comment\nset x 1")))
-    (tcl-assert "semi-then-comment" 1 (len (tcl-tokenize "set x 1; # comment")))
-
-    ; brace-quoted words
-    (tcl-assert "brace-type" "braced" (get (tcl-word "{hello}" 0) :type))
-    (tcl-assert "brace-value" "hello" (get (tcl-word "{hello}" 0) :value))
-    (tcl-assert "brace-spaces" "hello world" (get (tcl-word "{hello world}" 0) :value))
-    (tcl-assert "brace-nested" "a {b} c" (get (tcl-word "{a {b} c}" 0) :value))
-    (tcl-assert "brace-no-var-sub" "hello $x" (get (tcl-word "{hello $x}" 0) :value))
-    (tcl-assert "brace-no-cmd-sub" "[expr 1]" (get (tcl-word "{[expr 1]}" 0) :value))
-
-    ; double-quoted words
-    (tcl-assert "dq-type" "compound" (get (tcl-word "\"hello\"" 0) :type))
-    (tcl-assert "dq-quoted" true (get (tcl-word "\"hello\"" 0) :quoted))
-    (tcl-assert "dq-literal" "hello" (get (tcl-part "\"hello\"" 0 0) :value))
-
-    ; variable substitution in bare word
-    (tcl-assert "var-type" "var" (get (tcl-part "$x" 0 0) :type))
-    (tcl-assert "var-name" "x" (get (tcl-part "$x" 0 0) :name))
-    (tcl-assert "var-long" "long_name" (get (tcl-part "$long_name" 0 0) :name))
-
-    ; ${name} form
-    (tcl-assert "var-brace-type" "var" (get (tcl-part "${x}" 0 0) :type))
-    (tcl-assert "var-brace-name" "x" (get (tcl-part "${x}" 0 0) :name))
-
-    ; array variable substitution
-    (tcl-assert "arr-type" "var-arr" (get (tcl-part "$arr(key)" 0 0) :type))
-    (tcl-assert "arr-name" "arr" (get (tcl-part "$arr(key)" 0 0) :name))
-    (tcl-assert "arr-key-len" 1 (len (get (tcl-part "$arr(key)" 0 0) :key)))
-    (tcl-assert "arr-key-text" "key"
-      (get (nth (get (tcl-part "$arr(key)" 0 0) :key) 0) :value))
-
-    ; command substitution
-    (tcl-assert "cmd-type" "cmd" (get (tcl-part "[expr 1+1]" 0 0) :type))
-    (tcl-assert "cmd-src" "expr 1+1" (get (tcl-part "[expr 1+1]" 0 0) :src))
-
-    ; nested command substitution
-    (tcl-assert "cmd-nested-src" "expr [string length x]"
-      (get (tcl-part "[expr [string length x]]" 0 0) :src))
-
-    ; backslash substitution in double-quoted word
-    (let ((ps (tcl-parts "\"a\\nb\"" 0)))
-      (begin
-        (tcl-assert "bs-n-part0" "a" (get (nth ps 0) :value))
-        (tcl-assert "bs-n-part1" "\n" (get (nth ps 1) :value))
-        (tcl-assert "bs-n-part2" "b" (get (nth ps 2) :value))))
-
-    (let ((ps (tcl-parts "\"a\\tb\"" 0)))
-      (tcl-assert "bs-t-part1" "\t" (get (nth ps 1) :value)))
-
-    (let ((ps (tcl-parts "\"a\\\\b\"" 0)))
-      (tcl-assert "bs-bs-part1" "\\" (get (nth ps 1) :value)))
-
-    ; mixed word: text + var + text in double-quoted
-    (let ((ps (tcl-parts "\"hello $name!\"" 0)))
-      (begin
-        (tcl-assert "mixed-text0" "hello " (get (nth ps 0) :value))
-        (tcl-assert "mixed-var1-type" "var" (get (nth ps 1) :type))
-        (tcl-assert "mixed-var1-name" "name" (get (nth ps 1) :name))
-        (tcl-assert "mixed-text2" "!" (get (nth ps 2) :value))))
-
-    ; {*} expansion
-    (tcl-assert "expand-type" "expand" (get (tcl-word "{*}$list" 0) :type))
-
-    ; line continuation between words
-    (tcl-assert "cont-words" 3 (len (tcl-cmd-words "set x \\\n  1")))
-
-    ; continuation — third command word is correct
-    (tcl-assert "cont-word2-val" "1"
-      (get (tcl-part "set x \\\n  1" 2 0) :value))
-
-
-    ; --- parser helpers ---
-    ; tcl-parse is an alias for tcl-tokenize
-    (tcl-assert "parse-cmd-count" 1 (len (tcl-parse "set x 1")))
-    (tcl-assert "parse-2cmds" 2 (len (tcl-parse "set x 1; set y 2")))
-
-    ; tcl-cmd-len
-    (tcl-assert "cmd-len-3" 3 (tcl-cmd-len (nth (tcl-parse "set x 1") 0)))
-    (tcl-assert "cmd-len-1" 1 (tcl-cmd-len (nth (tcl-parse "puts") 0)))
-
-    ; tcl-word-simple? on braced word
-    (tcl-assert "simple-braced" true
-      (tcl-word-simple? (nth (get (nth (tcl-parse "{hello}") 0) :words) 0)))
-
-    ; tcl-word-simple? on bare word with no subs
-    (tcl-assert "simple-bare" true
-      (tcl-word-simple? (nth (get (nth (tcl-parse "hello") 0) :words) 0)))
-
-    ; tcl-word-simple? on word containing a var sub — false
-    (tcl-assert "simple-var-false" false
-      (tcl-word-simple? (nth (get (nth (tcl-parse "$x") 0) :words) 0)))
-
-    ; tcl-word-simple? on word containing a cmd sub — false
-    (tcl-assert "simple-cmd-false" false
-      (tcl-word-simple? (nth (get (nth (tcl-parse "[expr 1]") 0) :words) 0)))
-
-    ; tcl-word-literal on braced word
-    (tcl-assert "lit-braced" "hello world"
-      (tcl-word-literal (nth (get (nth (tcl-parse "{hello world}") 0) :words) 0)))
-
-    ; tcl-word-literal on bare word
-    (tcl-assert "lit-bare" "hello"
-      (tcl-word-literal (nth (get (nth (tcl-parse "hello") 0) :words) 0)))
-
-    ; tcl-word-literal on word with var sub returns nil
-    (tcl-assert "lit-var-nil" nil
-      (tcl-word-literal (nth (get (nth (tcl-parse "$x") 0) :words) 0)))
-
-    ; tcl-nth-literal
-    (tcl-assert "nth-lit-0" "set"
-      (tcl-nth-literal (nth (tcl-parse "set x 1") 0) 0))
-    (tcl-assert "nth-lit-1" "x"
-      (tcl-nth-literal (nth (tcl-parse "set x 1") 0) 1))
-    (tcl-assert "nth-lit-2" "1"
-      (tcl-nth-literal (nth (tcl-parse "set x 1") 0) 2))
-
-    ; tcl-nth-literal returns nil when word has subs
-    (tcl-assert "nth-lit-nil" nil
-      (tcl-nth-literal (nth (tcl-parse "set x $y") 0) 2))
-
-
-    (dict
-      "passed" tcl-parse-pass
-      "failed" tcl-parse-fail
-      "failures" tcl-parse-failures)))

lib/tcl/tests/programs/assert.tcl

@@ -1,14 +0,0 @@
-# expected: 10
-proc assert {expr_str} {
-    set result [uplevel 1 [list expr $expr_str]]
-    if {!$result} {
-        error "Assertion failed: $expr_str"
-    }
-}
-
-set x 42
-assert {$x == 42}
-assert {$x > 0}
-set x 10
-assert {$x < 100}
-set x

lib/tcl/tests/programs/event-loop.tcl

@@ -1,22 +0,0 @@
-# expected: done
-# Cooperative scheduler demo using coroutines (generator style)
-# coroutine eagerly collects all yields; invoking the coroutine name pops values
-
-proc counter {n max} {
-    while {$n < $max} {
-        yield $n
-        incr n
-    }
-    yield done
-}
-
-coroutine gen1 counter 0 3
-
-# gen1 yields: 0 1 2 done
-set out {}
-for {set i 0} {$i < 4} {incr i} {
-    lappend out [gen1]
-}
-
-# last val is "done"
-lindex $out 3

lib/tcl/tests/programs/for-each-line.tcl

@@ -1,14 +0,0 @@
-# expected: 13
-proc for-each-line {var lines body} {
-    foreach item $lines {
-        uplevel 1 [list set $var $item]
-        uplevel 1 $body
-    }
-}
-
-# Usage: accumulate lengths of each "line"
-set total 0
-for-each-line line {hello world foo} {
-    incr total [string length $line]
-}
-set total

lib/tcl/tests/programs/with-temp-var.tcl

@@ -1,14 +0,0 @@
-# expected: 100 999
-proc with-temp-var {varname tempval body} {
-    upvar 1 $varname v
-    set saved $v
-    set v $tempval
-    uplevel 1 $body
-    set v $saved
-}
-
-set x 100
-with-temp-var x 999 {
-    set captured $x
-}
-list $x $captured

lib/tcl/tokenizer.sx

@@ -1,308 +0,0 @@
-(define tcl-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\r"))))
-
-(define tcl-alpha?
-  (fn (c)
-    (and
-      (not (= c nil))
-      (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))))
-
-(define tcl-digit?
-  (fn (c) (and (not (= c nil)) (>= c "0") (<= c "9"))))
-
-(define tcl-ident-start?
-  (fn (c) (or (tcl-alpha? c) (= c "_"))))
-
-(define tcl-ident-char?
-  (fn (c) (or (tcl-ident-start? c) (tcl-digit? c))))
-
-(define tcl-tokenize
-  (fn (src)
-    (let ((pos 0) (src-len (len src)) (commands (list)))
-
-      (define char-at
-        (fn (off)
-          (if (< (+ pos off) src-len) (nth src (+ pos off)) nil)))
-
-      (define cur (fn () (char-at 0)))
-
-      (define advance! (fn (n) (set! pos (+ pos n))))
-
-      (define skip-ws!
-        (fn ()
-          (when (tcl-ws? (cur))
-            (begin (advance! 1) (skip-ws!)))))
-
-      (define skip-to-eol!
-        (fn ()
-          (when (and (< pos src-len) (not (= (cur) "\n")))
-            (begin (advance! 1) (skip-to-eol!)))))
-
-      (define skip-brace-content!
-        (fn (d)
-          (when (and (< pos src-len) (> d 0))
-            (cond
-              ((= (cur) "{") (begin (advance! 1) (skip-brace-content! (+ d 1))))
-              ((= (cur) "}") (begin (advance! 1) (skip-brace-content! (- d 1))))
-              (else (begin (advance! 1) (skip-brace-content! d)))))))
-
-      (define skip-dquote-content!
-        (fn ()
-          (when (and (< pos src-len) (not (= (cur) "\"")))
-            (begin
-              (when (= (cur) "\\") (advance! 1))
-              (when (< pos src-len) (advance! 1))
-              (skip-dquote-content!)))))
-
-      (define parse-bs
-        (fn ()
-          (advance! 1)
-          (let ((c (cur)))
-            (cond
-              ((= c nil)  "\\")
-              ((= c "n")  (begin (advance! 1) "\n"))
-              ((= c "t")  (begin (advance! 1) "\t"))
-              ((= c "r")  (begin (advance! 1) "\r"))
-              ((= c "\\") (begin (advance! 1) "\\"))
-              ((= c "[")  (begin (advance! 1) "["))
-              ((= c "]")  (begin (advance! 1) "]"))
-              ((= c "{")  (begin (advance! 1) "{"))
-              ((= c "}")  (begin (advance! 1) "}"))
-              ((= c "$")  (begin (advance! 1) "$"))
-              ((= c ";")  (begin (advance! 1) ";"))
-              ((= c "\"") (begin (advance! 1) "\""))
-              ((= c "'")  (begin (advance! 1) "'"))
-              ((= c " ")  (begin (advance! 1) " "))
-              ((= c "\n")
-                (begin
-                  (advance! 1)
-                  (skip-ws!)
-                  " "))
-              (else (begin (advance! 1) (str "\\" c)))))))
-
-      (define parse-cmd-sub
-        (fn ()
-          (advance! 1)
-          (let ((start pos) (depth 1))
-            (define scan!
-              (fn ()
-                (when (and (< pos src-len) (> depth 0))
-                  (cond
-                    ((= (cur) "[")
-                      (begin (set! depth (+ depth 1)) (advance! 1) (scan!)))
-                    ((= (cur) "]")
-                      (begin
-                        (set! depth (- depth 1))
-                        (when (> depth 0) (advance! 1))
-                        (scan!)))
-                    ((= (cur) "{")
-                      (begin (advance! 1) (skip-brace-content! 1) (scan!)))
-                    ((= (cur) "\"")
-                      (begin
-                        (advance! 1)
-                        (skip-dquote-content!)
-                        (when (= (cur) "\"") (advance! 1))
-                        (scan!)))
-                    ((= (cur) "\\")
-                      (begin (advance! 1) (when (< pos src-len) (advance! 1)) (scan!)))
-                    (else (begin (advance! 1) (scan!)))))))
-            (scan!)
-            (let ((src-text (slice src start pos)))
-              (begin
-                (when (= (cur) "]") (advance! 1))
-                {:type "cmd" :src src-text})))))
-
-      (define scan-name!
-        (fn ()
-          (when (and (< pos src-len) (not (= (cur) "}")))
-            (begin (advance! 1) (scan-name!)))))
-
-      (define scan-ns-name!
-        (fn ()
-          (cond
-            ((tcl-ident-char? (cur))
-              (begin (advance! 1) (scan-ns-name!)))
-            ((and (= (cur) ":") (= (char-at 1) ":"))
-              (begin (advance! 2) (scan-ns-name!)))
-            (else nil))))
-
-      (define scan-klit!
-        (fn ()
-          (when (and (< pos src-len)
-                     (not (= (cur) ")"))
-                     (not (= (cur) "$"))
-                     (not (= (cur) "["))
-                     (not (= (cur) "\\")))
-            (begin (advance! 1) (scan-klit!)))))
-
-      (define scan-key!
-        (fn (kp)
-          (when (and (< pos src-len) (not (= (cur) ")")))
-            (cond
-              ((= (cur) "$")
-                (begin (append! kp (parse-var-sub)) (scan-key! kp)))
-              ((= (cur) "[")
-                (begin (append! kp (parse-cmd-sub)) (scan-key! kp)))
-              ((= (cur) "\\")
-                (begin
-                  (append! kp {:type "text" :value (parse-bs)})
-                  (scan-key! kp)))
-              (else
-                (let ((kstart pos))
-                  (begin
-                    (scan-klit!)
-                    (append! kp {:type "text" :value (slice src kstart pos)})
-                    (scan-key! kp))))))))
-
-      (define parse-var-sub
-        (fn ()
-          (advance! 1)
-          (cond
-            ((= (cur) "{")
-              (begin
-                (advance! 1)
-                (let ((start pos))
-                  (begin
-                    (scan-name!)
-                    (let ((name (slice src start pos)))
-                      (begin
-                        (when (= (cur) "}") (advance! 1))
-                        {:type "var" :name name}))))))
-            ((tcl-ident-start? (cur))
-              (let ((start pos))
-                (begin
-                  (scan-ns-name!)
-                  (let ((name (slice src start pos)))
-                    (if (= (cur) "(")
-                      (begin
-                        (advance! 1)
-                        (let ((key-parts (list)))
-                          (begin
-                            (scan-key! key-parts)
-                            (when (= (cur) ")") (advance! 1))
-                            {:type "var-arr" :name name :key key-parts})))
-                      {:type "var" :name name})))))
-            (else {:type "text" :value "$"}))))
-
-      (define scan-lit!
-        (fn (stop?)
-          (when (and (< pos src-len)
-                     (not (stop? (cur)))
-                     (not (= (cur) "$"))
-                     (not (= (cur) "["))
-                     (not (= (cur) "\\")))
-            (begin (advance! 1) (scan-lit! stop?)))))
-
-      (define parse-word-parts!
-        (fn (parts stop?)
-          (when (and (< pos src-len) (not (stop? (cur))))
-            (cond
-              ((= (cur) "$")
-                (begin (append! parts (parse-var-sub)) (parse-word-parts! parts stop?)))
-              ((= (cur) "[")
-                (begin (append! parts (parse-cmd-sub)) (parse-word-parts! parts stop?)))
-              ((= (cur) "\\")
-                (begin
-                  (append! parts {:type "text" :value (parse-bs)})
-                  (parse-word-parts! parts stop?)))
-              (else
-                (let ((start pos))
-                  (begin
-                    (scan-lit! stop?)
-                    (when (> pos start)
-                      (append! parts {:type "text" :value (slice src start pos)}))
-                    (parse-word-parts! parts stop?))))))))
-
-      (define parse-brace-word
-        (fn ()
-          (advance! 1)
-          (let ((depth 1) (start pos))
-            (define scan!
-              (fn ()
-                (when (and (< pos src-len) (> depth 0))
-                  (cond
-                    ((= (cur) "{")
-                      (begin (set! depth (+ depth 1)) (advance! 1) (scan!)))
-                    ((= (cur) "}")
-                      (begin (set! depth (- depth 1)) (when (> depth 0) (advance! 1)) (scan!)))
-                    (else (begin (advance! 1) (scan!)))))))
-            (scan!)
-            (let ((value (slice src start pos)))
-              (begin
-                (when (= (cur) "}") (advance! 1))
-                {:type "braced" :value value})))))
-
-      (define parse-dquote-word
-        (fn ()
-          (advance! 1)
-          (let ((parts (list)))
-            (begin
-              (parse-word-parts! parts (fn (c) (or (= c "\"") (= c nil))))
-              (when (= (cur) "\"") (advance! 1))
-              {:type "compound" :parts parts :quoted true}))))
-
-      (define parse-bare-word
-        (fn ()
-          (let ((parts (list)))
-            (begin
-              (parse-word-parts!
-                parts
-                (fn (c) (or (tcl-ws? c) (= c "\n") (= c ";") (= c nil))))
-              {:type "compound" :parts parts :quoted false}))))
-
-      (define parse-word-no-expand
-        (fn ()
-          (cond
-            ((= (cur) "{") (parse-brace-word))
-            ((= (cur) "\"") (parse-dquote-word))
-            (else (parse-bare-word)))))
-
-      (define parse-word
-        (fn ()
-          (cond
-            ((and (= (cur) "{") (= (char-at 1) "*") (= (char-at 2) "}"))
-              (begin
-                (advance! 3)
-                {:type "expand" :word (parse-word-no-expand)}))
-            ((= (cur) "{") (parse-brace-word))
-            ((= (cur) "\"") (parse-dquote-word))
-            (else (parse-bare-word)))))
-
-      (define parse-words!
-        (fn (words)
-          (skip-ws!)
-          (cond
-            ((or (= (cur) nil) (= (cur) "\n") (= (cur) ";")) nil)
-            ((and (= (cur) "\\") (= (char-at 1) "\n"))
-              (begin (advance! 2) (skip-ws!) (parse-words! words)))
-            (else
-              (begin
-                (append! words (parse-word))
-                (parse-words! words))))))
-
-      (define skip-seps!
-        (fn ()
-          (when (< pos src-len)
-            (cond
-              ((or (tcl-ws? (cur)) (= (cur) "\n") (= (cur) ";"))
-                (begin (advance! 1) (skip-seps!)))
-              ((and (= (cur) "\\") (= (char-at 1) "\n"))
-                (begin (advance! 2) (skip-seps!)))
-              (else nil)))))
-
-      (define parse-all!
-        (fn ()
-          (skip-seps!)
-          (when (< pos src-len)
-            (cond
-              ((= (cur) "#")
-                (begin (skip-to-eol!) (parse-all!)))
-              (else
-                (let ((words (list)))
-                  (begin
-                    (parse-words! words)
-                    (when (> (len words) 0)
-                      (append! commands {:type "command" :words words}))
-                    (parse-all!))))))))
-
-      (parse-all!)
-      commands)))

plans/agent-briefings/apl-loop.md

@@ -11,7 +11,7 @@ isolation: worktree
 
 ## Prompt
 
-You are the sole background agent working `/root/rose-ash/plans/apl-on-sx.md`. Isolated worktree, forever, one commit per feature. Never push.
+You are the sole background agent working `/root/rose-ash/plans/apl-on-sx.md`. Isolated worktree, forever, one commit per feature. Push to `origin/loops/apl` after every commit.
 
 ## Restart baseline — check before iterating
 
@@ -42,7 +42,7 @@ Every iteration: implement → test → commit → tick `[ ]` → Progress log
 - **Shared-file issues** → plan's Blockers with minimal repro.
 - **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
 - **Unicode in `.sx`:** raw UTF-8 only, never `\uXXXX` escapes. Glyphs land directly in source.
-- **Worktree:** commit locally. Never push. Never touch `main`.
+- **Worktree:** commit, then push to `origin/loops/apl`. Never touch `main`.
 - **Commit granularity:** one feature per commit.
 - **Plan file:** update Progress log + tick boxes every commit.
 

plans/agent-briefings/tcl-loop.md

@@ -11,7 +11,7 @@ isolation: worktree
 
 ## Prompt
 
-You are the sole background agent working `/root/rose-ash/plans/tcl-on-sx.md`. Isolated worktree, forever, one commit per feature. Push to `origin/loops/tcl` after every commit.
+You are the sole background agent working `/root/rose-ash/plans/tcl-on-sx.md`. Isolated worktree, forever, one commit per feature. Never push.
 
 ## Restart baseline — check before iterating
 
@@ -42,7 +42,7 @@ Every iteration: implement → test → commit → tick `[ ]` → Progress log
 - **Shared-file issues** → plan's Blockers with minimal repro.
 - **Delimited continuations** are in `lib/callcc.sx` + `spec/evaluator.sx` Step 5. `sx_summarise` spec/evaluator.sx first — 2300+ lines.
 - **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
-- **Worktree:** commit, then push to `origin/loops/tcl`. Never touch `main`.
+- **Worktree:** commit locally. Never push. Never touch `main`.
 - **Commit granularity:** one feature per commit.
 - **Plan file:** update Progress log + tick boxes every commit.
 

plans/apl-on-sx.md

@@ -48,19 +48,19 @@ Core mapping:
 ## Roadmap
 
 ### Phase 1 — tokenizer + parser
-- [ ] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ∨ ⍱ ⍲ , ⍪ ⍴ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ∪ ∩ ⍳ ⍸ ⌷ ⍋ ⍒ ⊥ ⊤ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …`
-- [ ] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`, control words `:If :While :For …` (Dyalog-style)
-- [ ] Unit tests in `lib/apl/tests/parse.sx`
+- [x] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ∨ ⍱ ⍲ , ⍪ ⍴ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ∪ ∩ ⍳ ⍸ ⌷ ⍋ ⍒ ⊥ ⊤ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …`
+- [x] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`; outer product `∘.f`, inner product `f.g`, derived fns `f/ f¨ f⍨ f⍣n`
+- [x] Unit tests in `lib/apl/tests/parse.sx`
 
 ### Phase 2 — array model + scalar primitives
-- [ ] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose`
-- [ ] Shape arithmetic: `⍴` (shape), `,` (ravel), `≢` (tally / first-axis-length), `≡` (depth)
-- [ ] Scalar arithmetic primitives broadcast: `+ - × ÷ ⌈ ⌊ * ⍟ | ! ○`
-- [ ] Scalar comparison primitives: `< ≤ = ≥ > ≠`
-- [ ] Scalar logical: `~ ∧ ∨ ⍱ ⍲`
-- [ ] Index generator: `⍳n` (vector 1..n or 0..n-1 depending on `⎕IO`)
-- [ ] `⎕IO` = 1 default (Dyalog convention)
-- [ ] 40+ tests in `lib/apl/tests/scalar.sx`
+- [x] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose`
+- [x] Shape arithmetic: `⍴` (shape), `,` (ravel), `≢` (tally / first-axis-length), `≡` (depth)
+- [x] Scalar arithmetic primitives broadcast: `+ - × ÷ ⌈ ⌊ * ⍟ | ! ○`
+- [x] Scalar comparison primitives: `< ≤ = ≥ > ≠`
+- [x] Scalar logical: `~ ∧ ∨ ⍱ ⍲`
+- [x] Index generator: `⍳n` (vector 1..n or 0..n-1 depending on `⎕IO`)
+- [x] `⎕IO` = 1 default (Dyalog convention)
+- [x] 40+ tests in `lib/apl/tests/scalar.sx`
 
 ### Phase 3 — structural primitives + indexing
 - [ ] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec)
@@ -108,7 +108,9 @@ Core mapping:
 
 _Newest first._
 
-- _(none yet)_
+- 2026-04-26: Phase 2 complete — array model + 7 scalar primitive groups; 82/82 tests; lib/apl/runtime.sx + lib/apl/tests/scalar.sx
+- 2026-04-26: parser (Phase 1 step 2) — 44/44 parser tests green (90/90 total); right-to-left segment algorithm; derived fns, outer/inner product, dfns with guards, strand handling; `lib/apl/parser.sx` + `lib/apl/tests/parse.sx`
+- 2026-04-25: tokenizer (Phase 1 step 1) — 46/46 tests green; Unicode-aware starts-with? scanner for multi-byte APL glyphs; `lib/apl/tokenizer.sx` + `lib/apl/tests/parse.sx`
 
 ## Blockers
 

plans/tcl-on-sx.md

@@ -50,7 +50,7 @@ Core mapping:
 ## Roadmap
 
 ### Phase 1 — tokenizer + parser (the Dodekalogue)
-- [x] Tokenizer applying the 12 rules:
+- [ ] Tokenizer applying the 12 rules:
   1. Commands separated by `;` or newlines
   2. Words separated by whitespace within a command
   3. Double-quoted words: `\` escapes + `[…]` + `${…}` + `$var` substitution
@@ -63,76 +63,64 @@ Core mapping:
   10. Order of substitution is left-to-right, single-pass
   11. Substitutions don't recurse — substituted text is not re-parsed
   12. The result of any substitution is the value, not a new script
-- [x] Parser: script = list of commands; command = list of words; word = literal string + list of substitutions
-- [x] Unit tests in `lib/tcl/tests/parse.sx`
+- [ ] Parser: script = list of commands; command = list of words; word = literal string + list of substitutions
+- [ ] Unit tests in `lib/tcl/tests/parse.sx`
 
 ### Phase 2 — sequential eval + core commands
-- [x] `tcl-eval-script`: walk command list, dispatch each first-word into command table
-- [x] Core commands: `set`, `unset`, `incr`, `append`, `lappend`, `puts`, `gets`, `expr`, `if`, `while`, `for`, `foreach`, `switch`, `break`, `continue`, `return`, `error`, `eval`, `subst`, `format`, `scan`
-- [x] `expr` is its own mini-language — operator precedence, function calls (`sin`, `sqrt`, `pow`, `abs`, `int`, `double`), variable substitution, command substitution
-- [x] String commands: `string length`, `string index`, `string range`, `string compare`, `string match`, `string toupper`, `string tolower`, `string trim`, `string map`, `string repeat`, `string first`, `string last`, `string is`, `string cat`
-- [x] List commands: `list`, `lindex`, `lrange`, `llength`, `lreverse`, `lsearch`, `lsort`, `lsort -integer/-real/-dictionary`, `lreplace`, `linsert`, `concat`, `split`, `join`
-- [x] Dict commands: `dict create`, `dict get`, `dict set`, `dict unset`, `dict exists`, `dict keys`, `dict values`, `dict size`, `dict for`, `dict update`, `dict merge`
-- [x] 60+ tests in `lib/tcl/tests/eval.sx`
+- [ ] `tcl-eval-script`: walk command list, dispatch each first-word into command table
+- [ ] Core commands: `set`, `unset`, `incr`, `append`, `lappend`, `puts`, `gets`, `expr`, `if`, `while`, `for`, `foreach`, `switch`, `break`, `continue`, `return`, `error`, `eval`, `subst`, `format`, `scan`
+- [ ] `expr` is its own mini-language — operator precedence, function calls (`sin`, `sqrt`, `pow`, `abs`, `int`, `double`), variable substitution, command substitution
+- [ ] String commands: `string length`, `string index`, `string range`, `string compare`, `string match`, `string toupper`, `string tolower`, `string trim`, `string map`, `string repeat`, `string first`, `string last`, `string is`, `string cat`
+- [ ] List commands: `list`, `lindex`, `lrange`, `llength`, `lreverse`, `lsearch`, `lsort`, `lsort -integer/-real/-dictionary`, `lreplace`, `linsert`, `concat`, `split`, `join`
+- [ ] Dict commands: `dict create`, `dict get`, `dict set`, `dict unset`, `dict exists`, `dict keys`, `dict values`, `dict size`, `dict for`, `dict update`, `dict merge`
+- [ ] 60+ tests in `lib/tcl/tests/eval.sx`
 
 ### Phase 3 — proc + uplevel + upvar (THE SHOWCASE)
-- [x] `proc name args body` — register user-defined command; args supports defaults `{name default}` and rest `args`
-- [x] Frame stack: each proc call pushes a frame with locals dict; pop on return
-- [x] `uplevel ?level? script` — evaluate `script` in level-N frame's env; default level is 1 (caller). `#0` is global, `#1` is relative-1
-- [x] `upvar ?level? otherVar localVar ?…?` — alias localVar to a variable in level-N frame; reads/writes go through the alias
-- [x] `info level`, `info level N`, `info frame`, `info vars`, `info locals`, `info globals`, `info commands`, `info procs`, `info args`, `info body`
-- [x] `global var ?…?` — alias to global frame (sugar for `upvar #0 var var`)
-- [x] `variable name ?value?` — namespace-scoped global
-- [x] Classic programs in `lib/tcl/tests/programs/`:
-  - [x] `for-each-line.tcl` — define your own loop construct using `uplevel`
-  - [x] `assert.tcl` — assertion macro that reports caller's line
-  - [x] `with-temp-var.tcl` — scoped variable rebind via `upvar`
-- [x] `lib/tcl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md`
+- [ ] `proc name args body` — register user-defined command; args supports defaults `{name default}` and rest `args`
+- [ ] Frame stack: each proc call pushes a frame with locals dict; pop on return
+- [ ] `uplevel ?level? script` — evaluate `script` in level-N frame's env; default level is 1 (caller). `#0` is global, `#1` is relative-1
+- [ ] `upvar ?level? otherVar localVar ?…?` — alias localVar to a variable in level-N frame; reads/writes go through the alias
+- [ ] `info level`, `info level N`, `info frame`, `info vars`, `info locals`, `info globals`, `info commands`, `info procs`, `info args`, `info body`
+- [ ] `global var ?…?` — alias to global frame (sugar for `upvar #0 var var`)
+- [ ] `variable name ?value?` — namespace-scoped global
+- [ ] Classic programs in `lib/tcl/tests/programs/`:
+  - [ ] `for-each-line.tcl` — define your own loop construct using `uplevel`
+  - [ ] `assert.tcl` — assertion macro that reports caller's line
+  - [ ] `with-temp-var.tcl` — scoped variable rebind via `upvar`
+- [ ] `lib/tcl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md`
 
 ### Phase 4 — control flow + error handling
-- [x] `return -code (ok|error|return|break|continue|N) -errorinfo … -errorcode … -level N value`
-- [x] `catch script ?resultVar? ?optionsVar?` — runs script, returns code; sets resultVar to return value/message; optionsVar to the dict
-- [x] `try script ?on code var body ...? ?trap pattern var body...? ?finally body?`
-- [x] `throw type message`
-- [x] `error message ?info? ?code?`
-- [x] Stack-trace with `errorInfo` / `errorCode`
-- [x] 30+ tests in `lib/tcl/tests/error.sx`
+- [ ] `return -code (ok|error|return|break|continue|N) -errorinfo … -errorcode … -level N value`
+- [ ] `catch script ?resultVar? ?optionsVar?` — runs script, returns code; sets resultVar to return value/message; optionsVar to the dict
+- [ ] `try script ?on code var body ...? ?trap pattern var body...? ?finally body?`
+- [ ] `throw type message`
+- [ ] `error message ?info? ?code?`
+- [ ] Stack-trace with `errorInfo` / `errorCode`
+- [ ] 30+ tests in `lib/tcl/tests/error.sx`
 
 ### Phase 5 — namespaces + ensembles
-- [x] `namespace eval ns body`, `namespace current`, `namespace which`, `namespace import`, `namespace export`, `namespace forget`, `namespace delete`
-- [x] Qualified names: `::ns::cmd`, `::ns::var`
-- [x] Ensembles: `namespace ensemble create -map { sub1 cmd1 sub2 cmd2 }`
-- [x] `namespace path` for resolution chain
-- [x] `proc` and `variable` work inside namespaces
+- [ ] `namespace eval ns body`, `namespace current`, `namespace which`, `namespace import`, `namespace export`, `namespace forget`, `namespace delete`
+- [ ] Qualified names: `::ns::cmd`, `::ns::var`
+- [ ] Ensembles: `namespace ensemble create -map { sub1 cmd1 sub2 cmd2 }`
+- [ ] `namespace path` for resolution chain
+- [ ] `proc` and `variable` work inside namespaces
 
 ### Phase 6 — coroutines + drive corpus
-- [x] `coroutine name cmd ?args…?` — start a coroutine; future calls to `name` resume it
-- [x] `yield ?value?` — suspend, return value to resumer
-- [x] `yieldto cmd ?args…?` — symmetric transfer
-- [x] `coroutine` semantics built on fibers (same delcc primitive as Ruby fibers)
-- [x] Classic programs: `event-loop.tcl` — cooperative scheduler with multiple coroutines
-- [x] System: `clock seconds`, `clock format`, `clock scan` (subset)
-- [x] File I/O: `open`, `close`, `read`, `gets`, `puts -nonewline`, `flush`, `eof`, `seek`, `tell`
-- [x] Drive corpus to 150+ green
-- [x] Idiom corpus — `lib/tcl/tests/idioms.sx` covering classic Welch/Jones idioms
+- [ ] `coroutine name cmd ?args…?` — start a coroutine; future calls to `name` resume it
+- [ ] `yield ?value?` — suspend, return value to resumer
+- [ ] `yieldto cmd ?args…?` — symmetric transfer
+- [ ] `coroutine` semantics built on fibers (same delcc primitive as Ruby fibers)
+- [ ] Classic programs: `event-loop.tcl` — cooperative scheduler with multiple coroutines
+- [ ] System: `clock seconds`, `clock format`, `clock scan` (subset)
+- [ ] File I/O: `open`, `close`, `read`, `gets`, `puts -nonewline`, `flush`, `eof`, `seek`, `tell`
+- [ ] Drive corpus to 150+ green
+- [ ] Idiom corpus — `lib/tcl/tests/idioms.sx` covering classic Welch/Jones idioms
 
 ## Progress log
 
 _Newest first._
 
-- 2026-05-06: Phase 6 coroutines+clock+file+idioms — generator coroutines, clock/file stubs, 20 coroutine + 20 idiom tests, event-loop.tcl, 329 tests green
-- 2026-05-06: Phase 5 namespaces+ensembles — namespace eval/current/which/exists/delete/import/ensemble, qualified names, 289 tests green (22 new namespace tests)
-- 2026-05-06: Phase 4 error handling — catch/try/throw/return-code/errorinfo/errorcode, 267 tests green (39 new error tests)
-- 2026-05-06: Phase 3 conformance.sh + classic programs — 3/3 PASS (for-each-line/assert/with-temp-var), 228 tests green
-- 2026-05-06: Phase 3 proc+uplevel+upvar+info+global — frame stack, isolated proc scope, alias-following var access, 225 tests green (67 parse + 158 eval)
-- 2026-05-06: Phase 2 dict commands — 13 subcommands (create/get/set/unset/exists/keys/values/size/for/update/merge/incr/append), 206 tests green (67 parse + 139 eval)
-- 2026-05-06: Phase 2 list commands — 12 commands (list/lindex/lrange/llength/lreverse/lsearch/lsort/lreplace/linsert/concat/split/join), 182 tests green (67 parse + 115 eval)
-- 2026-05-06: Phase 2 string commands — 16 subcommands (length/index/range/compare/match/toupper/tolower/trim/map/repeat/first/last/is/cat), 156 tests green (67 parse + 89 eval)
-- 2026-05-06: Phase 2 expr mini-language — recursive descent parser, operator precedence, parens, unary ops, pow/sqrt/abs/max/min/int/double, 127 tests green (67 parse + 60 eval)
-- 2026-04-26: Phase 2 core commands — if/while/for/foreach/switch/break/continue/return/error/unset/lappend/eval/expr + :code control flow, 107 tests green (67 parse + 40 eval)
-- 2026-04-26: Phase 2 eval engine — `lib/tcl/runtime.sx`, tcl-eval-script + set/puts/incr/append, 87 tests green (67 parse + 20 eval)
-- 2026-04-25: Phase 1 parser — `lib/tcl/parser.sx`, word-simple?/word-literal helpers, 67 tests green, commit 6ee05259
-- 2026-04-25: Phase 1 tokenizer (Dodekalogue) — `lib/tcl/tokenizer.sx`, 52 tests green, commit 666e29d5
+- _(none yet)_
 
 ## Blockers