apl: het-inner-product encloses (+4); life.apl restored to as-written

apl-inner now wraps its result in (enclose result) when A's ravel
contains any dict element (a boxed array). This matches Hui's
semantics where `1 ⍵ ∨.∧ X` produces a rank-0 wrapping the
(5 5) board, then ⊃ unwraps to bare matrix.

Homogeneous inner product unaffected (+.× over numbers and
matrices still produces bare arrays — none of those ravels
contain dicts).

life.apl restored to true as-written form:
  life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵}

4 pipeline tests + 5 e2e tests verify heterogeneous case and
that ⊃ unwraps to the underlying (5 5) board.

Full suite 589/589. Phase 11 complete.

lib/apl/parser.sx

@@ -25,8 +25,9 @@
 ; Glyph classification sets
 ; ============================================================
 
-(define apl-parse-op-glyphs
+(define
-  (list "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))
+  apl-parse-op-glyphs
+  (list "/" "⌿" "\\" "⍀" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))
 
 (define
   apl-parse-fn-glyphs
@@ -82,22 +83,48 @@
     "⍎"
     "⍕"))
 
-(define apl-quad-fn-names (list "⎕FMT"))
+(define apl-quad-fn-names (list "⎕FMT" "⎕←"))
 
-(define
+(define apl-known-fn-names (list))
-  apl-parse-op-glyph?
-  (fn (v) (some (fn (g) (= g v)) apl-parse-op-glyphs)))
 
 ; ============================================================
 ; Token accessors
 ; ============================================================
 
+(define
+  apl-collect-fn-bindings
+  (fn
+    (stmt-groups)
+    (set! apl-known-fn-names (list))
+    (for-each
+      (fn
+        (toks)
+        (when
+          (and
+            (>= (len toks) 3)
+            (= (tok-type (nth toks 0)) :name)
+            (= (tok-type (nth toks 1)) :assign)
+            (= (tok-type (nth toks 2)) :lbrace))
+          (set!
+            apl-known-fn-names
+            (cons (tok-val (nth toks 0)) apl-known-fn-names))))
+      stmt-groups)))
+
+(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)))
 
 (define tok-type (fn (tok) (get tok :type)))
 
+; ============================================================
+; Collect trailing operators starting at index i
+; Returns {:ops (op ...) :end new-i}
+; ============================================================
+
 (define tok-val (fn (tok) (get tok :value)))
 
 (define
@@ -107,8 +134,8 @@
     (and (= (tok-type tok) :glyph) (apl-parse-op-glyph? (tok-val tok)))))
 
 ; ============================================================
-; Collect trailing operators starting at index i
+; Build a derived-fn node by chaining operators left-to-right
-; Returns {:ops (op ...) :end new-i}
+; (+/¨  →  (:derived-fn "¨" (:derived-fn "/" (:fn-glyph "+"))))
 ; ============================================================
 
 (define
@@ -119,15 +146,17 @@
       (and (= (tok-type tok) :glyph) (apl-parse-fn-glyph? (tok-val tok)))
       (and
         (= (tok-type tok) :name)
-        (some (fn (q) (= q (tok-val tok))) apl-quad-fn-names)))))
+        (or
+          (some (fn (q) (= q (tok-val tok))) apl-quad-fn-names)
+          (some (fn (q) (= q (tok-val tok))) apl-known-fn-names))))))
+
+; ============================================================
+; Find matching close bracket/paren/brace
+; Returns the index of the matching close token
+; ============================================================
 
 (define collect-ops (fn (tokens i) (collect-ops-loop tokens i (list))))
 
-; ============================================================
-; Build a derived-fn node by chaining operators left-to-right
-; (+/¨  →  (:derived-fn "¨" (:derived-fn "/" (:fn-glyph "+"))))
-; ============================================================
-
 (define
   collect-ops-loop
   (fn
@@ -143,8 +172,10 @@
           {:end i :ops acc})))))
 
 ; ============================================================
-; Find matching close bracket/paren/brace
+; Segment collection: scan tokens left-to-right, building
-; Returns the index of the matching close token
+; a list of {:kind "val"/"fn" :node ast} segments.
+; Operators following function glyphs are merged into
+; derived-fn nodes during this pass.
 ; ============================================================
 
 (define
@@ -163,12 +194,20 @@
     (find-matching-close-loop tokens start open-type close-type 1)))
 
 ; ============================================================
-; Segment collection: scan tokens left-to-right, building
+; Build tree from segment list
-; a list of {:kind "val"/"fn" :node ast} segments.
+;
-; Operators following function glyphs are merged into
+; The segments are in left-to-right order.
-; derived-fn nodes during this pass.
+; 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-matching-close-loop
   (fn
@@ -208,21 +247,9 @@
   collect-segments
   (fn (tokens) (collect-segments-loop tokens 0 (list))))
 
-; ============================================================
+; Build an array node from 0..n value segments
-; Build tree from segment list
+; If n=1 → return that segment's node
-;
+; If n>1 → return (:vec node1 node2 ...)
-; 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
   collect-segments-loop
   (fn
@@ -242,36 +269,71 @@
             ((= tt :str)
               (collect-segments-loop tokens (+ i 1) (append acc {:kind "val" :node (list :str tv)})))
             ((= tt :name)
-              (if
+              (cond
-                (some (fn (q) (= q tv)) apl-quad-fn-names)
+                ((and (< (+ i 1) (len tokens)) (= (tok-type (nth tokens (+ i 1))) :assign))
+                  (let
+                    ((rhs-tokens (slice tokens (+ i 2) (len tokens))))
+                    (let
+                      ((rhs-expr (parse-apl-expr rhs-tokens)))
+                      (collect-segments-loop
+                        tokens
+                        (len tokens)
+                        (append acc {:kind "val" :node (list :assign-expr tv rhs-expr)})))))
+                ((some (fn (q) (= q tv)) apl-quad-fn-names)
                   (let
                     ((op-result (collect-ops tokens (+ i 1))))
                     (let
-                    ((ops (get op-result :ops)) (ni (get op-result :end)))
+                      ((ops (get op-result :ops))
+                        (ni (get op-result :end)))
                       (let
                         ((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
                         (collect-segments-loop
                           tokens
                           ni
-                        (append acc {:kind "fn" :node fn-node})))))
+                          (append acc {:kind "fn" :node fn-node}))))))
+                ((some (fn (q) (= q tv)) apl-known-fn-names)
+                  (let
+                    ((op-result (collect-ops tokens (+ i 1))))
+                    (let
+                      ((ops (get op-result :ops))
+                        (ni (get op-result :end)))
+                      (let
+                        ((fn-node (build-derived-fn (list :fn-name tv) ops)))
+                        (collect-segments-loop
+                          tokens
+                          ni
+                          (append acc {:kind "fn" :node fn-node}))))))
+                (else
                   (let
                     ((br (maybe-bracket (list :name tv) tokens (+ i 1))))
                     (collect-segments-loop
                       tokens
                       (nth br 1)
-                    (append acc {:kind "val" :node (nth br 0)})))))
+                      (append acc {:kind "val" :node (nth br 0)}))))))
             ((= tt :lparen)
               (let
                 ((end (find-matching-close tokens (+ i 1) :lparen :rparen)))
                 (let
                   ((inner-tokens (slice tokens (+ i 1) end))
                     (after (+ end 1)))
+                  (let
+                    ((inner-segs (collect-segments inner-tokens)))
+                    (if
+                      (and
+                        (>= (len inner-segs) 2)
+                        (every? (fn (s) (= (get s :kind) "fn")) inner-segs))
+                      (let
+                        ((train-node (cons :train (map (fn (s) (get s :node)) inner-segs))))
+                        (collect-segments-loop
+                          tokens
+                          after
+                          (append acc {:kind "fn" :node train-node})))
                       (let
                         ((br (maybe-bracket (parse-apl-expr inner-tokens) tokens after)))
                         (collect-segments-loop
                           tokens
                           (nth br 1)
-                      (append acc {:kind "val" :node (nth br 0)}))))))
+                          (append acc {:kind "val" :node (nth br 0)}))))))))
             ((= tt :lbrace)
               (let
                 ((end (find-matching-close tokens (+ i 1) :lbrace :rbrace)))
@@ -282,10 +344,22 @@
             ((= tt :glyph)
               (cond
                 ((or (= tv "⍺") (= tv "⍵"))
+                  (if
+                    (and
+                      (< (+ i 1) (len tokens))
+                      (= (tok-type (nth tokens (+ i 1))) :assign))
+                    (let
+                      ((rhs-tokens (slice tokens (+ i 2) (len tokens))))
+                      (let
+                        ((rhs-expr (parse-apl-expr rhs-tokens)))
+                        (collect-segments-loop
+                          tokens
+                          (len tokens)
+                          (append acc {:kind "val" :node (list :assign-expr tv rhs-expr)}))))
                     (collect-segments-loop
                       tokens
                       (+ i 1)
-                    (append acc {:kind "val" :node (list :name tv)})))
+                      (append acc {:kind "val" :node (list :name tv)}))))
                 ((= tv "∇")
                   (collect-segments-loop
                     tokens
@@ -340,15 +414,34 @@
                             ni
                             (append acc {:kind "fn" :node fn-node})))))))
                 ((apl-parse-op-glyph? tv)
-                  (collect-segments-loop tokens (+ i 1) acc))
+                  (if
+                    (or (= tv "/") (= tv "⌿") (= tv "\\") (= tv "⍀"))
+                    (let
+                      ((next-i (+ i 1)))
+                      (let
+                        ((next-tok (if (< next-i n) (nth tokens next-i) nil)))
+                        (let
+                          ((mod (if (and next-tok (= (tok-type next-tok) :glyph) (or (= (get next-tok :value) "⍨") (= (get next-tok :value) "¨"))) (get next-tok :value) nil))
+                            (base-fn-node (list :fn-glyph tv)))
+                          (let
+                            ((node (if mod (list :derived-fn mod base-fn-node) base-fn-node))
+                              (advance (if mod 2 1)))
+                            (collect-segments-loop
+                              tokens
+                              (+ i advance)
+                              (append acc {:kind "fn" :node node}))))))
+                    (collect-segments-loop tokens (+ i 1) acc)))
                 (true (collect-segments-loop tokens (+ i 1) acc))))
             (true (collect-segments-loop tokens (+ i 1) acc))))))))
 
 (define find-first-fn (fn (segs) (find-first-fn-loop segs 0)))
 
-; Build an array node from 0..n value segments
+
-; If n=1 → return that segment's node
+; ============================================================
-; If n>1 → return (:vec node1 node2 ...)
+; Split token list on statement separators (diamond / newline)
+; Only splits at depth 0 (ignores separators inside { } or ( ) )
+; ============================================================
+
 (define
   find-first-fn-loop
   (fn
@@ -370,10 +463,9 @@
       (get (first segs) :node)
       (cons :vec (map (fn (s) (get s :node)) segs)))))
 
-
 ; ============================================================
-; Split token list on statement separators (diamond / newline)
+; Parse a dfn body (tokens between { and })
-; Only splits at depth 0 (ignores separators inside { } or ( ) )
+; Handles guard expressions: cond : expr
 ; ============================================================
 
 (define
@@ -408,11 +500,6 @@
   split-statements
   (fn (tokens) (split-statements-loop tokens (list) (list) 0)))
 
-; ============================================================
-; Parse a dfn body (tokens between { and })
-; Handles guard expressions: cond : expr
-; ============================================================
-
 (define
   split-statements-loop
   (fn
@@ -467,6 +554,10 @@
       ((stmt-groups (split-statements tokens)))
       (let ((stmts (map parse-dfn-stmt stmt-groups))) (cons :dfn stmts)))))
 
+; ============================================================
+; Parse a single statement (assignment or expression)
+; ============================================================
+
 (define
   parse-dfn-stmt
   (fn
@@ -483,12 +574,17 @@
             (parse-apl-expr body-tokens)))
         (parse-stmt tokens)))))
 
+; ============================================================
+; Parse an expression from a flat token list
+; ============================================================
+
 (define
   find-top-level-colon
   (fn (tokens i) (find-top-level-colon-loop tokens i 0)))
 
 ; ============================================================
-; Parse a single statement (assignment or expression)
+; Main entry point
+; parse-apl: string → AST
 ; ============================================================
 
 (define
@@ -508,10 +604,6 @@
           ((and (= tt :colon) (= depth 0)) i)
           (true (find-top-level-colon-loop tokens (+ i 1) depth)))))))
 
-; ============================================================
-; Parse an expression from a flat token list
-; ============================================================
-
 (define
   parse-stmt
   (fn
@@ -526,11 +618,6 @@
         (parse-apl-expr (slice tokens 2)))
       (parse-apl-expr tokens))))
 
-; ============================================================
-; Main entry point
-; parse-apl: string → AST
-; ============================================================
-
 (define
   parse-apl-expr
   (fn
@@ -547,13 +634,52 @@
       ((tokens (apl-tokenize src)))
       (let
         ((stmt-groups (split-statements tokens)))
+        (begin
+          (apl-collect-fn-bindings stmt-groups)
           (if
             (= (len stmt-groups) 0)
             nil
             (if
               (= (len stmt-groups) 1)
               (parse-stmt (first stmt-groups))
-            (cons :program (map parse-stmt stmt-groups))))))))
+              (cons :program (map parse-stmt stmt-groups)))))))))
+
+(define
+  split-bracket-loop
+  (fn
+    (tokens current acc depth)
+    (if
+      (= (len tokens) 0)
+      (append acc (list current))
+      (let
+        ((tok (first tokens)) (more (rest tokens)))
+        (let
+          ((tt (tok-type tok)))
+          (cond
+            ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
+              (split-bracket-loop
+                more
+                (append current (list tok))
+                acc
+                (+ depth 1)))
+            ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
+              (split-bracket-loop
+                more
+                (append current (list tok))
+                acc
+                (- depth 1)))
+            ((and (= tt :semi) (= depth 0))
+              (split-bracket-loop
+                more
+                (list)
+                (append acc (list current))
+                depth))
+            (else
+              (split-bracket-loop more (append current (list tok)) acc depth))))))))
+
+(define
+  split-bracket-content
+  (fn (tokens) (split-bracket-loop tokens (list) (list) 0)))
 
 (define
   maybe-bracket
@@ -568,9 +694,18 @@
         (let
           ((inner-tokens (slice tokens (+ after 1) end))
             (next-after (+ end 1)))
+          (let
+            ((sections (split-bracket-content inner-tokens)))
+            (if
+              (= (len sections) 1)
               (let
                 ((idx-expr (parse-apl-expr inner-tokens)))
                 (let
                   ((indexed (list :dyad (list :fn-glyph "⌷") idx-expr val-node)))
-              (maybe-bracket indexed tokens next-after)))))
+                  (maybe-bracket indexed tokens next-after)))
+              (let
+                ((axis-exprs (map (fn (toks) (if (= (len toks) 0) :all (parse-apl-expr toks))) sections)))
+                (let
+                  ((indexed (cons :bracket (cons val-node axis-exprs))))
+                  (maybe-bracket indexed tokens next-after)))))))
       (list val-node after))))

lib/apl/runtime.sx

@@ -65,10 +65,30 @@
             (get a :shape)
             (map (fn (x) (f x sv)) (get a :ravel)))))
       (else
-        (if
+        (let
-          (equal? (get a :shape) (get b :shape))
+          ((a-shape (get a :shape)) (b-shape (get b :shape)))
-          (make-array (get a :shape) (map f (get a :ravel) (get b :ravel)))
+          (cond
-          (error "length error: shape mismatch"))))))
+            ((equal? a-shape b-shape)
+              (make-array a-shape (map f (get a :ravel) (get b :ravel))))
+            ((and (= (len a-shape) 1) (> (len b-shape) 1))
+              (make-array
+                (append a-shape b-shape)
+                (flatten
+                  (map
+                    (fn
+                      (x)
+                      (get (broadcast-dyadic f (apl-scalar x) b) :ravel))
+                    (get a :ravel)))))
+            ((and (= (len b-shape) 1) (> (len a-shape) 1))
+              (make-array
+                (append a-shape b-shape)
+                (flatten
+                  (map
+                    (fn
+                      (acell)
+                      (get (broadcast-dyadic f (apl-scalar acell) b) :ravel))
+                    (get a :ravel)))))
+            (else (error "length error: shape mismatch"))))))))
 
 ; ============================================================
 ; Arithmetic primitives
@@ -808,6 +828,125 @@
           ((picked (map (fn (i) (nth arr-ravel i)) kept)))
           (make-array (list (len picked)) picked))))))
 
+(define
+  apl-compress-first
+  (fn
+    (mask arr)
+    (let
+      ((mask-ravel (get mask :ravel))
+        (shape (get arr :shape))
+        (ravel (get arr :ravel)))
+      (if
+        (< (len shape) 2)
+        (apl-compress mask arr)
+        (let
+          ((rows (first shape)) (cols (last shape)))
+          (let
+            ((kept-rows (filter (fn (i) (not (= 0 (nth mask-ravel i)))) (range 0 rows))))
+            (let
+              ((new-ravel (reduce (fn (acc r) (append acc (map (fn (j) (nth ravel (+ (* r cols) j))) (range 0 cols)))) (list) kept-rows)))
+              (make-array (cons (len kept-rows) (rest shape)) new-ravel))))))))
+
+(define
+  apl-where
+  (fn
+    (arr)
+    (let
+      ((ravel (get arr :ravel)) (io (disclose (apl-quad-io))))
+      (let
+        ((indices (filter (fn (i) (not (= (nth ravel i) 0))) (range 0 (len ravel)))))
+        (apl-vector (map (fn (i) (+ i io)) indices))))))
+
+(define
+  apl-interval-index
+  (fn
+    (breaks vals)
+    (let
+      ((b-ravel (get breaks :ravel))
+        (v-ravel
+          (if (scalar? vals) (list (disclose vals)) (get vals :ravel))))
+      (let
+        ((result (map (fn (y) (len (filter (fn (b) (<= b y)) b-ravel))) v-ravel)))
+        (if
+          (scalar? vals)
+          (apl-scalar (first result))
+          (make-array (get vals :shape) result))))))
+
+(define
+  apl-unique
+  (fn
+    (arr)
+    (let
+      ((ravel (if (scalar? arr) (list (disclose arr)) (get arr :ravel))))
+      (let
+        ((dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) ravel)))
+        (apl-vector dedup)))))
+
+(define
+  apl-union
+  (fn
+    (a b)
+    (let
+      ((a-ravel (if (scalar? a) (list (disclose a)) (get a :ravel)))
+        (b-ravel (if (scalar? b) (list (disclose b)) (get b :ravel))))
+      (let
+        ((a-dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) a-ravel)))
+        (let
+          ((b-extra (filter (fn (x) (not (index-of a-dedup x))) b-ravel)))
+          (let
+            ((b-extra-dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) b-extra)))
+            (apl-vector (append a-dedup b-extra-dedup))))))))
+
+(define
+  apl-intersect
+  (fn
+    (a b)
+    (let
+      ((a-ravel (if (scalar? a) (list (disclose a)) (get a :ravel)))
+        (b-ravel (if (scalar? b) (list (disclose b)) (get b :ravel))))
+      (apl-vector (filter (fn (x) (index-of b-ravel x)) a-ravel)))))
+
+(define
+  apl-decode
+  (fn
+    (base digits)
+    (let
+      ((d-ravel (if (scalar? digits) (list (disclose digits)) (get digits :ravel))))
+      (let
+        ((d-len (len d-ravel)))
+        (let
+          ((b-ravel (if (scalar? base) (let ((b (disclose base))) (map (fn (i) b) (range 0 d-len))) (get base :ravel))))
+          (let
+            ((result (reduce (fn (acc i) (if (= i 0) (nth d-ravel 0) (+ (* acc (nth b-ravel i)) (nth d-ravel i)))) 0 (range 0 d-len))))
+            (apl-scalar result)))))))
+
+(define
+  apl-encode
+  (fn
+    (base val)
+    (let
+      ((b-ravel (if (scalar? base) (list (disclose base)) (get base :ravel)))
+        (n (if (scalar? val) (disclose val) (first (get val :ravel)))))
+      (let
+        ((b-len (len b-ravel)))
+        (let
+          ((result (reduce (fn (acc-and-n i) (let ((acc (first acc-and-n)) (rem (nth acc-and-n 1))) (let ((b (nth b-ravel (- (- b-len 1) i)))) (if (= b 0) (list (cons rem acc) 0) (list (cons (modulo rem b) acc) (floor (/ rem b))))))) (list (list) n) (range 0 b-len))))
+          (apl-vector (first result)))))))
+
+(define
+  apl-partition
+  (fn
+    (mask val)
+    (let
+      ((m-ravel (if (scalar? mask) (list (disclose mask)) (get mask :ravel)))
+        (v-ravel
+          (if (scalar? val) (list (disclose val)) (get val :ravel))))
+      (let
+        ((n (len m-ravel)))
+        (let
+          ((built (reduce (fn (acc-and-prev i) (let ((acc (first acc-and-prev)) (prev (nth acc-and-prev 1))) (let ((mi (nth m-ravel i)) (vi (nth v-ravel i))) (cond ((= mi 0) (list acc 0)) ((> mi prev) (list (append acc (list (list vi))) mi)) (else (let ((idx (- (len acc) 1))) (list (append (slice acc 0 idx) (list (append (nth acc idx) (list vi)))) mi))))))) (list (list) 0) (range 0 n))))
+          (apl-vector (map (fn (part) (apl-vector part)) (first built))))))))
+
 (define
   apl-primes
   (fn
@@ -883,7 +1022,7 @@
       (let
         ((sub (apl-permutations (- n 1))))
         (reduce
-          (fn (acc p) (append acc (apl-insert-everywhere n p)))
+          (fn (acc p) (append (apl-insert-everywhere n p) acc))
           (list)
           sub)))))
 
@@ -985,6 +1124,60 @@
         (some (fn (c) (= c 0)) codes)
         (some (fn (c) (= c (nth e 1))) codes)))))
 
+(define apl-rng-state 12345)
+
+(define apl-rng-seed! (fn (s) (set! apl-rng-state s)))
+
+(define
+  apl-rng-next!
+  (fn
+    ()
+    (begin
+      (set!
+        apl-rng-state
+        (mod (+ (* apl-rng-state 1103515245) 12345) 2147483648))
+      apl-rng-state)))
+
+(define
+  apl-roll
+  (fn
+    (arr)
+    (let
+      ((n (if (scalar? arr) (first (get arr :ravel)) (first (get arr :ravel)))))
+      (apl-scalar (+ apl-io (mod (apl-rng-next!) n))))))
+
+(define
+  apl-cartesian
+  (fn
+    (lists)
+    (if
+      (= (len lists) 0)
+      (list (list))
+      (let
+        ((rest-prods (apl-cartesian (rest lists))))
+        (reduce
+          (fn (acc x) (append acc (map (fn (p) (cons x p)) rest-prods)))
+          (list)
+          (first lists))))))
+
+(define
+  apl-bracket-multi
+  (fn
+    (axes arr)
+    (let
+      ((shape (get arr :shape)) (ravel (get arr :ravel)))
+      (let
+        ((rank (len shape)) (strides (apl-strides shape)))
+        (let
+          ((axis-info (map (fn (i) (let ((a (nth axes i))) (cond ((= a nil) {:idxs (range 0 (nth shape i)) :scalar? false}) ((= (len (get a :shape)) 0) {:idxs (list (- (first (get a :ravel)) apl-io)) :scalar? true}) (else {:idxs (map (fn (x) (- x apl-io)) (get a :ravel)) :scalar? false})))) (range 0 rank))))
+          (let
+            ((cells (apl-cartesian (map (fn (a) (get a :idxs)) axis-info))))
+            (let
+              ((result-ravel (map (fn (cell) (let ((flat (reduce + 0 (map (fn (i) (* (nth cell i) (nth strides i))) (range 0 rank))))) (nth ravel flat))) cells)))
+              (let
+                ((result-shape (filter (fn (x) (>= x 0)) (map (fn (i) (let ((a (nth axis-info i))) (if (get a :scalar?) -1 (len (get a :idxs))))) (range 0 rank)))))
+                (make-array result-shape result-ravel)))))))))
+
 (define
   apl-reduce
   (fn
@@ -1001,11 +1194,9 @@
             (if
               (= n 0)
               (apl-scalar 0)
-              (apl-scalar
+              (let
-                (reduce
+                ((rr (reduce (fn (a b) (let ((wa (if (= (type-of a) "dict") a (apl-scalar a))) (wb (if (= (type-of b) "dict") b (apl-scalar b)))) (let ((r (f wa wb))) (if (scalar? r) (disclose r) r)))) (first ravel) (rest ravel))))
-                  (fn (a b) (disclose (f (apl-scalar a) (apl-scalar b))))
+                (if (= (type-of rr) "dict") rr (apl-scalar rr)))))
-                  (first ravel)
-                  (rest ravel)))))
           (let
             ((last-dim (last shape))
               (pre-shape (take shape (- (len shape) 1)))
@@ -1027,7 +1218,13 @@
                       (reduce
                         (fn
                           (a b)
-                          (disclose (f (apl-scalar a) (apl-scalar b))))
+                          (let
+                            ((wa (if (= (type-of a) "dict") a (apl-scalar a)))
+                              (wb
+                                (if (= (type-of b) "dict") b (apl-scalar b))))
+                            (let
+                              ((r (f wa wb)))
+                              (if (scalar? r) (disclose r) r))))
                         (first elems)
                         (rest elems)))))
                 (range 0 pre-size)))))))))
@@ -1168,13 +1365,29 @@
     (cond
       ((and (scalar? a) (scalar? b)) (apl-scalar (disclose (f a b))))
       ((scalar? a)
+        (let
+          ((a-eff (let ((d (disclose a))) (if (= (type-of d) "dict") d a))))
           (make-array
             (get b :shape)
-          (map (fn (x) (disclose (f a (apl-scalar x)))) (get b :ravel))))
+            (map
+              (fn
+                (x)
+                (let
+                  ((r (f a-eff (apl-scalar x))))
+                  (if (scalar? r) (disclose r) r)))
+              (get b :ravel)))))
       ((scalar? b)
+        (let
+          ((b-eff (let ((d (disclose b))) (if (= (type-of d) "dict") d b))))
           (make-array
             (get a :shape)
-          (map (fn (x) (disclose (f (apl-scalar x) b))) (get a :ravel))))
+            (map
+              (fn
+                (x)
+                (let
+                  ((r (f (apl-scalar x) b-eff)))
+                  (if (scalar? r) (disclose r) r)))
+              (get a :ravel)))))
       (else
         (if
           (equal? (get a :shape) (get b :shape))
@@ -1195,6 +1408,8 @@
         (b-shape (get b :shape))
         (a-ravel (get a :ravel))
         (b-ravel (get b :ravel)))
+      (let
+        ((wrap (fn (x) (if (= (type-of x) "dict") x (apl-scalar x)))))
         (make-array
           (append a-shape b-shape)
           (flatten
@@ -1202,9 +1417,13 @@
               (fn
                 (x)
                 (map
-                (fn (y) (disclose (f (apl-scalar x) (apl-scalar y))))
+                  (fn
+                    (y)
+                    (let
+                      ((r (f (wrap x) (wrap y))))
+                      (if (scalar? r) (disclose r) r)))
                   b-ravel))
-            a-ravel))))))
+              a-ravel)))))))
 
 (define
   apl-inner
@@ -1228,25 +1447,12 @@
               ((a-pre-size (reduce * 1 a-pre))
                 (b-post-size (reduce * 1 b-post))
                 (new-shape (append a-pre b-post)))
-              (make-array
-                new-shape
-                (flatten
-                  (map
-                    (fn
-                      (i)
-                      (map
-                        (fn
-                          (j)
               (let
-                            ((pairs (map (fn (k) (disclose (g (apl-scalar (nth a-ravel (+ (* i inner-dim) k))) (apl-scalar (nth b-ravel (+ (* k b-post-size) j)))))) (range 0 inner-dim))))
+                ((result (make-array new-shape (flatten (map (fn (i) (map (fn (j) (let ((pairs (map (fn (k) (let ((a-elem (nth a-ravel (+ (* i inner-dim) k))) (b-elem (nth b-ravel (+ (* k b-post-size) j)))) (let ((a-cell (if (= (type-of a-elem) "dict") (nth (get a-elem :ravel) j) a-elem)) (b-cell (if (= (type-of b-elem) "dict") (nth (get b-elem :ravel) 0) b-elem))) (disclose (g (apl-scalar a-cell) (apl-scalar b-cell)))))) (range 0 inner-dim)))) (reduce (fn (x y) (let ((wx (if (= (type-of x) "dict") x (apl-scalar x))) (wy (if (= (type-of y) "dict") y (apl-scalar y)))) (let ((r (f wx wy))) (if (scalar? r) (disclose r) r)))) (first pairs) (rest pairs)))) (range 0 b-post-size))) (range 0 a-pre-size))))))
-                            (reduce
+                (if
-                              (fn
+                  (some (fn (x) (= (type-of x) "dict")) a-ravel)
-                                (x y)
+                  (enclose result)
-                                (disclose (f (apl-scalar x) (apl-scalar y))))
+                  result)))))))))
-                              (first pairs)
-                              (rest pairs))))
-                        (range 0 b-post-size)))
-                    (range 0 a-pre-size)))))))))))
 
 (define apl-commute (fn (f x) (f x x)))
 

lib/apl/test.sh

@@ -39,6 +39,7 @@ cat > "$TMPFILE" << 'EPOCHS'
 (load "lib/apl/tests/idioms.sx")
 (load "lib/apl/tests/eval-ops.sx")
 (load "lib/apl/tests/pipeline.sx")
+(load "lib/apl/tests/programs-e2e.sx")
 (epoch 4)
 (eval "(list apl-test-pass apl-test-fail)")
 EPOCHS

lib/apl/tests/pipeline.sx

@@ -178,3 +178,510 @@
   "apl-run \"(⍳5)[3] × 7\" → 21"
   (mkrv (apl-run "(⍳5)[3] × 7"))
   (list 21))
+
+(apl-test "decimal: 3.7 → 3.7" (mkrv (apl-run "3.7")) (list 3.7))
+
+(apl-test "decimal: ¯2.5 → -2.5" (mkrv (apl-run "¯2.5")) (list -2.5))
+
+(apl-test "decimal: 1.5 + 2.5 → 4" (mkrv (apl-run "1.5 + 2.5")) (list 4))
+
+(apl-test "decimal: ⌊3.7 → 3" (mkrv (apl-run "⌊ 3.7")) (list 3))
+
+(apl-test "decimal: ⌈3.7 → 4" (mkrv (apl-run "⌈ 3.7")) (list 4))
+
+(apl-test
+  "⎕← scalar passthrough"
+  (mkrv (apl-run "⎕← 42"))
+  (list 42))
+
+(apl-test
+  "⎕← vector passthrough"
+  (mkrv (apl-run "⎕← 1 2 3"))
+  (list 1 2 3))
+
+(apl-test
+  "string: 'abc' → 3-char vector"
+  (mkrv (apl-run "'abc'"))
+  (list "a" "b" "c"))
+
+(apl-test "string: 'a' is rank-0 scalar" (mksh (apl-run "'a'")) (list))
+
+(apl-test "string: 'hello' shape (5)" (mksh (apl-run "'hello'")) (list 5))
+
+(apl-test
+  "named-fn: f ← {⍺+⍵} ⋄ 3 f 4 → 7"
+  (mkrv (apl-run "f ← {⍺+⍵} ⋄ 3 f 4"))
+  (list 7))
+
+(apl-test
+  "named-fn monadic: sq ← {⍵×⍵} ⋄ sq 7 → 49"
+  (mkrv (apl-run "sq ← {⍵×⍵} ⋄ sq 7"))
+  (list 49))
+
+(apl-test
+  "named-fn dyadic: hyp ← {((⍺×⍺)+⍵×⍵)} ⋄ 3 hyp 4 → 25"
+  (mkrv (apl-run "hyp ← {((⍺×⍺)+⍵×⍵)} ⋄ 3 hyp 4"))
+  (list 25))
+
+(apl-test
+  "named-fn: dbl ← {⍵+⍵} ⋄ dbl ⍳5"
+  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ dbl ⍳5"))
+  (list 2 4 6 8 10))
+
+(apl-test
+  "named-fn factorial via ∇ recursion"
+  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 5"))
+  (list 120))
+
+(apl-test
+  "named-fn used twice in expr: dbl ← {⍵+⍵} ⋄ (dbl 3) + dbl 4"
+  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ (dbl 3) + dbl 4"))
+  (list 14))
+
+(apl-test
+  "named-fn with vector arg: neg ← {-⍵} ⋄ neg 1 2 3"
+  (mkrv (apl-run "neg ← {-⍵} ⋄ neg 1 2 3"))
+  (list -1 -2 -3))
+
+(apl-test
+  "multi-axis: M[2;2] → center"
+  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[2;2]"))
+  (list 5))
+
+(apl-test
+  "multi-axis: M[1;] → first row"
+  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"))
+  (list 1 2 3))
+
+(apl-test
+  "multi-axis: M[;2] → second column"
+  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[;2]"))
+  (list 2 5 8))
+
+(apl-test
+  "multi-axis: M[1 2;1 2] → 2x2 block"
+  (mkrv (apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]"))
+  (list 1 2 4 5))
+
+(apl-test
+  "multi-axis: M[1 2;1 2] shape (2 2)"
+  (mksh (apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]"))
+  (list 2 2))
+
+(apl-test
+  "multi-axis: M[;] full matrix"
+  (mkrv (apl-run "M ← (2 2) ⍴ 10 20 30 40 ⋄ M[;]"))
+  (list 10 20 30 40))
+
+(apl-test
+  "multi-axis: M[1;] shape collapsed"
+  (mksh (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"))
+  (list 3))
+
+(apl-test
+  "multi-axis: select all rows of column 3"
+  (mkrv (apl-run "M ← (4 3) ⍴ 1 2 3 4 5 6 7 8 9 10 11 12 ⋄ M[;3]"))
+  (list 3 6 9 12))
+
+(apl-test
+  "train: mean = (+/÷≢) on 1..5"
+  (mkrv (apl-run "(+/÷≢) 1 2 3 4 5"))
+  (list 3))
+
+(apl-test
+  "train: mean of 2 4 6 8 10"
+  (mkrv (apl-run "(+/÷≢) 2 4 6 8 10"))
+  (list 6))
+
+(apl-test
+  "train 2-atop: (- ⌊) 5 → -5"
+  (mkrv (apl-run "(- ⌊) 5"))
+  (list -5))
+
+(apl-test
+  "train 3-fork dyadic: 2(+×-)5 → -21"
+  (mkrv (apl-run "2 (+ × -) 5"))
+  (list -21))
+
+(apl-test
+  "train: range = (⌈/-⌊/) on vector"
+  (mkrv (apl-run "(⌈/-⌊/) 3 1 4 1 5 9 2 6"))
+  (list 8))
+
+(apl-test
+  "train: mean of ⍳10 has shape ()"
+  (mksh (apl-run "(+/÷≢) ⍳10"))
+  (list))
+
+(apl-test
+  "compress: 1 0 1 0 1 / 10 20 30 40 50"
+  (mkrv (apl-run "1 0 1 0 1 / 10 20 30 40 50"))
+  (list 10 30 50))
+
+(apl-test
+  "compress: empty mask → empty"
+  (mkrv (apl-run "0 0 0 / 1 2 3"))
+  (list))
+
+(apl-test
+  "primes via classic idiom (multi-stmt)"
+  (mkrv (apl-run "P ← ⍳ 30 ⋄ (2 = +⌿ 0 = P ∘.| P) / P"))
+  (list 2 3 5 7 11 13 17 19 23 29))
+
+(apl-test
+  "primes via classic idiom (n=20)"
+  (mkrv (apl-run "P ← ⍳ 20 ⋄ (2 = +⌿ 0 = P ∘.| P) / P"))
+  (list 2 3 5 7 11 13 17 19))
+
+(apl-test
+  "compress: filter even values"
+  (mkrv (apl-run "(0 = 2 | 1 2 3 4 5 6) / 1 2 3 4 5 6"))
+  (list 2 4 6))
+
+(apl-test "inline-assign: x ← 5" (mkrv (apl-run "x ← 5")) (list 5))
+
+(apl-test
+  "inline-assign: (2×x) + x←10 → 30"
+  (mkrv (apl-run "(2 × x) + x ← 10"))
+  (list 30))
+
+(apl-test
+  "inline-assign primes one-liner: (2=+⌿0=a∘.|a)/a←⍳30"
+  (mkrv (apl-run "(2 = +⌿ 0 = a ∘.| a) / a ← ⍳ 30"))
+  (list 2 3 5 7 11 13 17 19 23 29))
+
+(apl-test
+  "inline-assign: x is reusable — x + x ← 7 → 14"
+  (mkrv (apl-run "x + x ← 7"))
+  (list 14))
+
+(apl-test
+  "inline-assign in dfn: f ← {x + x ← ⍵} ⋄ f 8 → 16"
+  (mkrv (apl-run "f ← {x + x ← ⍵} ⋄ f 8"))
+  (list 16))
+
+(begin (apl-rng-seed! 42) nil)
+
+(apl-test
+  "?10 with seed 42 → 8 (deterministic)"
+  (mkrv (apl-run "?10"))
+  (list 8))
+
+(apl-test "?10 next call → 5" (mkrv (apl-run "?10")) (list 5))
+
+(apl-test
+  "?100 stays in range"
+  (let ((v (first (mkrv (apl-run "?100"))))) (and (>= v 1) (<= v 100)))
+  true)
+
+(begin (apl-rng-seed! 42) nil)
+
+(apl-test
+  "?10 with re-seed 42 → 8 (reproducible)"
+  (mkrv (apl-run "?10"))
+  (list 8))
+
+(apl-test
+  "apl-run-file: load primes.apl returns dfn AST"
+  (first (apl-run-file "lib/apl/tests/programs/primes.apl"))
+  :dfn)
+
+(apl-test
+  "apl-run-file: life.apl parses without error"
+  (first (apl-run-file "lib/apl/tests/programs/life.apl"))
+  :dfn)
+
+(apl-test
+  "apl-run-file: quicksort.apl parses without error"
+  (first (apl-run-file "lib/apl/tests/programs/quicksort.apl"))
+  :dfn)
+
+(apl-test
+  "apl-run-file: source-then-call returns primes count"
+  (mksh
+    (apl-run
+      (str (file-read "lib/apl/tests/programs/primes.apl") " ⋄ primes 30")))
+  (list 10))
+
+(apl-test
+  "primes one-liner with ⍵-rebind: primes 30"
+  (mkrv
+    (apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 30"))
+  (list 2 3 5 7 11 13 17 19 23 29))
+
+(apl-test
+  "primes one-liner: primes 50"
+  (mkrv
+    (apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 50"))
+  (list 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))
+
+(apl-test
+  "primes.apl loaded + called via apl-run-file"
+  (mkrv
+    (apl-run
+      (str (file-read "lib/apl/tests/programs/primes.apl") " ⋄ primes 20")))
+  (list 2 3 5 7 11 13 17 19))
+
+(apl-test
+  "primes.apl loaded — count of primes ≤ 100"
+  (first
+    (mksh
+      (apl-run
+        (str
+          (file-read "lib/apl/tests/programs/primes.apl")
+          " ⋄ primes 100"))))
+  25)
+
+(apl-test
+  "⍉ monadic transpose 2x3 → 3x2"
+  (mkrv (apl-run "⍉ (2 3) ⍴ ⍳6"))
+  (list 1 4 2 5 3 6))
+
+(apl-test
+  "⍉ transpose shape (3 2)"
+  (mksh (apl-run "⍉ (2 3) ⍴ ⍳6"))
+  (list 3 2))
+
+(apl-test "⊢ monadic identity" (mkrv (apl-run "⊢ 1 2 3")) (list 1 2 3))
+
+(apl-test
+  "5 ⊣ 1 2 3 → 5 (left)"
+  (mkrv (apl-run "5 ⊣ 1 2 3"))
+  (list 5))
+
+(apl-test
+  "5 ⊢ 1 2 3 → 1 2 3 (right)"
+  (mkrv (apl-run "5 ⊢ 1 2 3"))
+  (list 1 2 3))
+
+(apl-test "⍕ 42 → \"42\" (alias for ⎕FMT)" (apl-run "⍕ 42") "42")
+
+(begin
+  (apl-test
+    "⍸ where: indices of truthy cells"
+    (mkrv (apl-run "⍸ 0 1 0 1 1"))
+    (list 2 4 5))
+  (apl-test
+    "⍸ where: leading truthy"
+    (mkrv (apl-run "⍸ 1 0 0 1 1"))
+    (list 1 4 5))
+  (apl-test
+    "⍸ where: all-zero → empty"
+    (mkrv (apl-run "⍸ 0 0 0"))
+    (list))
+  (apl-test
+    "⍸ where: all-truthy"
+    (mkrv (apl-run "⍸ 1 1 1"))
+    (list 1 2 3))
+  (apl-test
+    "⍸ where: ⎕IO=1 (1-based)"
+    (mkrv (apl-run "⍸ (⍳5)=3"))
+    (list 3))
+  (apl-test
+    "⍸ interval-index: 2 4 6 ⍸ 5 → 2"
+    (mkrv (apl-run "2 4 6 ⍸ 5"))
+    (list 2))
+  (apl-test
+    "⍸ interval-index: 2 4 6 ⍸ 1 3 5 6 7 → 0 1 2 3 3"
+    (mkrv (apl-run "2 4 6 ⍸ 1 3 5 6 7"))
+    (list 0 1 2 3 3))
+  (apl-test
+    "⍸ interval-index: ⍳5 ⍸ 3 → 3"
+    (mkrv (apl-run "(⍳5) ⍸ 3"))
+    (list 3))
+  (apl-test
+    "⍸ interval-index: y below all → 0"
+    (mkrv (apl-run "10 20 30 ⍸ 5"))
+    (list 0))
+  (apl-test
+    "⍸ interval-index: y above all → len breaks"
+    (mkrv (apl-run "10 20 30 ⍸ 100"))
+    (list 3)))
+
+(begin
+  (apl-test
+    "∪ unique: dedup keeps first-occurrence order"
+    (mkrv (apl-run "∪ 1 2 1 3 2 1 4"))
+    (list 1 2 3 4))
+  (apl-test
+    "∪ unique: already-unique unchanged"
+    (mkrv (apl-run "∪ 5 4 3 2 1"))
+    (list 5 4 3 2 1))
+  (apl-test "∪ unique: scalar" (mkrv (apl-run "∪ 7")) (list 7))
+  (apl-test
+    "∪ unique: string mississippi → misp"
+    (mkrv (apl-run "∪ 'mississippi'"))
+    (list "m" "i" "s" "p"))
+  (apl-test
+    "∪ union: 1 2 3 ∪ 3 4 5 → 1 2 3 4 5"
+    (mkrv (apl-run "1 2 3 ∪ 3 4 5"))
+    (list 1 2 3 4 5))
+  (apl-test
+    "∪ union: dedups left side too"
+    (mkrv (apl-run "1 2 1 ∪ 1 3 2"))
+    (list 1 2 3))
+  (apl-test
+    "∪ union: disjoint → catenated"
+    (mkrv (apl-run "1 2 ∪ 3 4"))
+    (list 1 2 3 4))
+  (apl-test
+    "∩ intersection: 1 2 3 4 ∩ 2 4 6 → 2 4"
+    (mkrv (apl-run "1 2 3 4 ∩ 2 4 6"))
+    (list 2 4))
+  (apl-test
+    "∩ intersection: disjoint → empty"
+    (mkrv (apl-run "1 2 3 ∩ 4 5 6"))
+    (list))
+  (apl-test
+    "∩ intersection: preserves left order"
+    (mkrv (apl-run "(⍳5) ∩ 5 3 1"))
+    (list 1 3 5))
+  (apl-test
+    "∩ intersection: identical"
+    (mkrv (apl-run "1 2 3 ∩ 1 2 3"))
+    (list 1 2 3))
+  (apl-test
+    "∪/∩ identity: A ∪ A = ∪A"
+    (mkrv (apl-run "1 2 1 ∪ 1 2 1"))
+    (list 1 2)))
+
+(begin
+  (apl-test
+    "⊥ decode: 2 2 2 ⊥ 1 0 1 → 5"
+    (mkrv (apl-run "2 2 2 ⊥ 1 0 1"))
+    (list 5))
+  (apl-test
+    "⊥ decode: 10 10 10 ⊥ 1 2 3 → 123"
+    (mkrv (apl-run "10 10 10 ⊥ 1 2 3"))
+    (list 123))
+  (apl-test
+    "⊥ decode: 24 60 60 ⊥ 2 3 4 → 7384 (mixed-radix HMS)"
+    (mkrv (apl-run "24 60 60 ⊥ 2 3 4"))
+    (list 7384))
+  (apl-test
+    "⊥ decode: scalar base 2 ⊥ 1 0 1 0 → 10"
+    (mkrv (apl-run "2 ⊥ 1 0 1 0"))
+    (list 10))
+  (apl-test
+    "⊥ decode: 16 16 ⊥ 15 15 → 255"
+    (mkrv (apl-run "16 16 ⊥ 15 15"))
+    (list 255))
+  (apl-test
+    "⊤ encode: 2 2 2 ⊤ 5 → 1 0 1"
+    (mkrv (apl-run "2 2 2 ⊤ 5"))
+    (list 1 0 1))
+  (apl-test
+    "⊤ encode: 24 60 60 ⊤ 7384 → 2 3 4 (HMS)"
+    (mkrv (apl-run "24 60 60 ⊤ 7384"))
+    (list 2 3 4))
+  (apl-test
+    "⊤ encode: 2 2 2 2 ⊤ 13 → 1 1 0 1"
+    (mkrv (apl-run "2 2 2 2 ⊤ 13"))
+    (list 1 1 0 1))
+  (apl-test
+    "⊤ encode: 10 10 ⊤ 42 → 4 2"
+    (mkrv (apl-run "10 10 ⊤ 42"))
+    (list 4 2))
+  (apl-test
+    "⊤ encode: round-trip B⊥(B⊤N) = N"
+    (mkrv (apl-run "24 60 60 ⊥ 24 60 60 ⊤ 7384"))
+    (list 7384))
+  (apl-test
+    "⊥ decode: round-trip B⊤(B⊥V) = V"
+    (mkrv (apl-run "2 2 2 ⊤ 2 2 2 ⊥ 1 0 1"))
+    (list 1 0 1)))
+
+(begin
+  (define
+    mk-parts
+    (fn (s) (map (fn (p) (get p :ravel)) (get (apl-run s) :ravel))))
+  (apl-test
+    "⊆ partition: 1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')"
+    (mk-parts "1 1 0 1 1 ⊆ 'abcde'")
+    (list (list "a" "b") (list "d" "e")))
+  (apl-test
+    "⊆ partition: 1 0 0 1 1 ⊆ ⍳5 → ((1) (4 5))"
+    (mk-parts "1 0 0 1 1 ⊆ ⍳5")
+    (list (list 1) (list 4 5)))
+  (apl-test
+    "⊆ partition: all-zero mask → empty"
+    (len (get (apl-run "0 0 0 ⊆ 1 2 3") :ravel))
+    0)
+  (apl-test
+    "⊆ partition: all-one mask → single partition"
+    (mk-parts "1 1 1 ⊆ 7 8 9")
+    (list (list 7 8 9)))
+  (apl-test
+    "⊆ partition: strict increase 1 2 starts new"
+    (mk-parts "1 2 ⊆ 10 20")
+    (list (list 10) (list 20)))
+  (apl-test
+    "⊆ partition: same level continues 2 2 → one partition"
+    (mk-parts "2 2 ⊆ 10 20")
+    (list (list 10 20)))
+  (apl-test
+    "⊆ partition: 0 separates"
+    (mk-parts "1 1 0 0 1 ⊆ 1 2 3 4 5")
+    (list (list 1 2) (list 5)))
+  (apl-test
+    "⊆ partition: outer length matches partition count"
+    (len (get (apl-run "1 0 1 0 1 ⊆ ⍳5") :ravel))
+    3))
+
+(begin
+  (apl-test
+    "⍎ execute: ⍎ '1 + 2' → 3"
+    (mkrv (apl-run "⍎ '1 + 2'"))
+    (list 3))
+  (apl-test
+    "⍎ execute: ⍎ '+/⍳10' → 55"
+    (mkrv (apl-run "⍎ '+/⍳10'"))
+    (list 55))
+  (apl-test
+    "⍎ execute: ⍎ '⌈/ 1 3 9 5 7' → 9"
+    (mkrv (apl-run "⍎ '⌈/ 1 3 9 5 7'"))
+    (list 9))
+  (apl-test
+    "⍎ execute: ⍎ '⍳5' → 1..5"
+    (mkrv (apl-run "⍎ '⍳5'"))
+    (list 1 2 3 4 5))
+  (apl-test
+    "⍎ execute: ⍎ '×/⍳5' → 120"
+    (mkrv (apl-run "⍎ '×/⍳5'"))
+    (list 120))
+  (apl-test
+    "⍎ execute: round-trip ⍎ ⎕FMT 42 → 42"
+    (mkrv (apl-run "⍎ ⎕FMT 42"))
+    (list 42))
+  (apl-test
+    "⍎ execute: nested ⍎ ⍎"
+    (mkrv (apl-run "⍎ '⍎ ''2 × 3'''"))
+    (list 6))
+  (apl-test
+    "⍎ execute: with assignment side-effect"
+    (mkrv (apl-run "⍎ 'q ← 99 ⋄ q + 1'"))
+    (list 100)))
+
+(begin
+  (apl-test
+    "het-inner: 1 ⍵ ∨.∧ X — result is enclosed (5 5)"
+    (let
+      ((r (apl-run "B ← 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 ⋄ X ← 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂B ⋄ 1 B ∨.∧ X")))
+      (list
+        (len (get r :shape))
+        (= (type-of (first (get r :ravel))) "dict")))
+    (list 0 true))
+  (apl-test
+    "het-inner: ⊃ unwraps to (5 5) board"
+    (mksh
+      (apl-run
+        "B ← 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 ⋄ X ← 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂B ⋄ ⊃ 1 B ∨.∧ X"))
+    (list 5 5))
+  (apl-test
+    "het-inner: homogeneous inner product unaffected"
+    (mkrv (apl-run "1 2 3 +.× 4 5 6"))
+    (list 32))
+  (apl-test
+    "het-inner: matrix inner product unaffected"
+    (mkrv (apl-run "(2 2 ⍴ 1 2 3 4) +.× 2 2 ⍴ 5 6 7 8"))
+    (list 19 22 43 50)))

lib/apl/tests/programs-e2e.sx

@@ -0,0 +1,189 @@
+; End-to-end tests of the classic-program archetypes — running APL
+; source through the full pipeline (tokenize → parse → eval-ast → runtime).
+;
+; These mirror the algorithms documented in lib/apl/tests/programs/*.apl
+; but use forms our pipeline supports today (named functions instead of
+; the inline ⍵← rebinding idiom; multi-stmt over single one-liners).
+
+(define mkrv (fn (arr) (get arr :ravel)))
+(define mksh (fn (arr) (get arr :shape)))
+
+; ---------- factorial via ∇ recursion (cf. n-queens style) ----------
+
+(apl-test
+  "e2e: factorial 5! = 120"
+  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 5"))
+  (list 120))
+
+(apl-test
+  "e2e: factorial 7! = 5040"
+  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 7"))
+  (list 5040))
+
+(apl-test
+  "e2e: factorial via ×/⍳N (no recursion)"
+  (mkrv (apl-run "fact ← {×/⍳⍵} ⋄ fact 6"))
+  (list 720))
+
+; ---------- sum / triangular numbers (sum-1..N) ----------
+
+(apl-test
+  "e2e: triangular(10) = 55"
+  (mkrv (apl-run "tri ← {+/⍳⍵} ⋄ tri 10"))
+  (list 55))
+
+(apl-test
+  "e2e: triangular(100) = 5050"
+  (mkrv (apl-run "tri ← {+/⍳⍵} ⋄ tri 100"))
+  (list 5050))
+
+; ---------- sum of squares ----------
+
+(apl-test
+  "e2e: sum-of-squares 1..5 = 55"
+  (mkrv (apl-run "ss ← {+/⍵×⍵} ⋄ ss ⍳5"))
+  (list 55))
+
+(apl-test
+  "e2e: sum-of-squares 1..10 = 385"
+  (mkrv (apl-run "ss ← {+/⍵×⍵} ⋄ ss ⍳10"))
+  (list 385))
+
+; ---------- divisor-counting (prime-sieve building blocks) ----------
+
+(apl-test
+  "e2e: divisor counts 1..5 via outer mod"
+  (mkrv (apl-run "P ← ⍳ 5 ⋄ +⌿ 0 = P ∘.| P"))
+  (list 1 2 2 3 2))
+
+(apl-test
+  "e2e: divisor counts 1..10"
+  (mkrv (apl-run "P ← ⍳ 10 ⋄ +⌿ 0 = P ∘.| P"))
+  (list 1 2 2 3 2 4 2 4 3 4))
+
+(apl-test
+  "e2e: prime-mask 1..10 (count==2)"
+  (mkrv (apl-run "P ← ⍳ 10 ⋄ 2 = +⌿ 0 = P ∘.| P"))
+  (list 0 1 1 0 1 0 1 0 0 0))
+
+; ---------- monadic primitives chained ----------
+
+(apl-test
+  "e2e: sum of |abs| = 15"
+  (mkrv (apl-run "+/|¯1 ¯2 ¯3 ¯4 ¯5"))
+  (list 15))
+
+(apl-test
+  "e2e: max of squares 1..6"
+  (mkrv (apl-run "⌈/(⍳6)×⍳6"))
+  (list 36))
+
+; ---------- nested named functions ----------
+
+(apl-test
+  "e2e: compose dbl and sq via two named fns"
+  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ sq ← {⍵×⍵} ⋄ sq dbl 3"))
+  (list 36))
+
+(apl-test
+  "e2e: max-of-two as named dyadic fn"
+  (mkrv (apl-run "mx ← {⍺⌈⍵} ⋄ 5 mx 3"))
+  (list 5))
+
+(apl-test
+  "e2e: sqrt-via-newton 1 step from 1 → 2.5"
+  (mkrv (apl-run "step ← {(⍵+⍺÷⍵)÷2} ⋄ 4 step 1"))
+  (list 2.5))
+
+(begin
+  (apl-test
+    "life.apl: blinker 5×5 → vertical blinker"
+    (mkrv
+      (apl-run
+        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0"))
+    (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0))
+  (apl-test
+    "life.apl: blinker oscillates (period 2)"
+    (mkrv
+      (apl-run
+        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life life 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0"))
+    (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))
+  (apl-test
+    "life.apl: 2×2 block stable"
+    (mkrv
+      (apl-run
+        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 4 4 ⍴ 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0"))
+    (list 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0))
+  (apl-test
+    "life.apl: empty grid stays empty"
+    (mkrv
+      (apl-run
+        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 5 5 ⍴ 0"))
+    (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
+  (apl-test
+    "life.apl: source-file as-written runs"
+    (let
+      ((dfn (apl-run-file "lib/apl/tests/programs/life.apl"))
+        (board
+          (apl-run "5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0")))
+      (get (apl-call-dfn-m dfn board) :ravel))
+    (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0)))
+
+(begin
+  (apl-test
+    "quicksort.apl: 11-element with duplicates"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 3 1 4 1 5 9 2 6 5 3 5")))
+    (list 1 1 2 3 3 4 5 5 5 6 9))
+  (apl-test
+    "quicksort.apl: already sorted"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 1 2 3 4 5")))
+    (list 1 2 3 4 5))
+  (apl-test
+    "quicksort.apl: reverse sorted"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 5 4 3 2 1")))
+    (list 1 2 3 4 5))
+  (apl-test
+    "quicksort.apl: all equal"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 7 7 7 7")))
+    (list 7 7 7 7))
+  (apl-test
+    "quicksort.apl: single element"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort ,42")))
+    (list 42))
+  (apl-test
+    "quicksort.apl: matches grade-up"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "V ← 8 3 1 9 2 7 5 6 4 ⋄ quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort V")))
+    (list 1 2 3 4 5 6 7 8 9))
+  (apl-test
+    "quicksort.apl: source-file as-written runs"
+    (begin
+      (apl-rng-seed! 42)
+      (let
+        ((dfn (apl-run-file "lib/apl/tests/programs/quicksort.apl"))
+          (vec (apl-run "5 2 8 1 9 3 7 4 6")))
+        (get (apl-call-dfn-m dfn vec) :ravel)))
+    (list 1 2 3 4 5 6 7 8 9)))

lib/apl/tests/programs/life.apl

@@ -8,9 +8,9 @@
 ⍝   ¯1 0 1 ⌽¨ ⊂⍵      : produce 3 horizontally-shifted copies
 ⍝   ¯1 0 1 ∘.⊖ …      : outer-product with vertical shifts → 3×3 = 9 shifts
 ⍝   +/ +/ …           : sum the 9 boards element-wise → neighbor-count + self
-⍝   3 4 = …           : boolean — count is exactly 3 or exactly 4
+⍝   3 4 = …           : leading-axis-extended boolean — count is 3 (born) or 4 (survive)
 ⍝   1 ⍵ ∨.∧ …         : "alive next" iff (count=3) or (alive AND count=4)
-⍝   ⊃ …               : disclose back to a 2D board
+⍝   ⊃ …               : disclose the enclosed result back to a 2D board
 ⍝
 ⍝ Rules in plain language:
 ⍝   - dead cell + 3 live neighbors → born

lib/apl/tokenizer.sx

@@ -2,7 +2,7 @@
   (list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~" "<" "≤" "=" "≥" ">" "≠"
         "≢" "≡" "∊" "∧" "∨" "⍱" "⍲" "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
         "∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕"
-        "⍺" "⍵" "∇" "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))
+        "⍺" "⍵" "∇" "/" "⌿" "\\" "⍀" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))
 
 (define apl-glyph?
   (fn (ch)
@@ -19,91 +19,87 @@
              (and (>= ch "A") (<= ch "Z"))
              (= ch "_")))))
 
-(define apl-tokenize
+(define
-  (fn (source)
+  apl-tokenize
-    (let ((pos 0)
+  (fn
-          (src-len (len source))
+    (source)
-          (tokens (list)))
+    (let
-
+      ((pos 0) (src-len (len source)) (tokens (list)))
-      (define tok-push!
+      (define tok-push! (fn (type value) (append! tokens {:value value :type type})))
-        (fn (type value)
+      (define
-          (append! tokens {:type type :value value})))
+        cur-sw?
-
+        (fn
-      (define cur-sw?
+          (ch)
-        (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 cur-byte
+      (define advance! (fn () (set! pos (+ pos 1))))
-        (fn ()
+      (define consume! (fn (ch) (set! pos (+ pos (len ch)))))
-          (if (< pos src-len) (nth source pos) nil)))
+      (define
-
+        find-glyph
-      (define advance!
+        (fn
-        (fn ()
+          ()
-          (set! pos (+ pos 1))))
+          (let
-
+            ((rem (slice source pos)))
-      (define consume!
+            (let
-        (fn (ch)
+              ((matches (filter (fn (g) (starts-with? rem g)) apl-glyph-set)))
-          (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
-      (define read-digits!
+        read-digits!
-        (fn (acc)
+        (fn
-          (if (and (< pos src-len) (apl-digit? (cur-byte)))
+          (acc)
-            (let ((ch (cur-byte)))
+          (if
-              (begin
+            (and (< pos src-len) (apl-digit? (cur-byte)))
-                (advance!)
+            (let
-                (read-digits! (str acc ch))))
+              ((ch (cur-byte)))
+              (begin (advance!) (read-digits! (str acc ch))))
             acc)))
-
+      (define
-      (define read-ident-cont!
+        read-ident-cont!
-        (fn ()
+        (fn
-          (when (and (< pos src-len)
+          ()
-                     (let ((ch (cur-byte)))
+          (when
+            (and
+              (< pos src-len)
+              (let
+                ((ch (cur-byte)))
                 (or (apl-alpha? ch) (apl-digit? ch))))
-            (begin
+            (begin (advance!) (read-ident-cont!)))))
-              (advance!)
+      (define
-              (read-ident-cont!)))))
+        read-string!
-
+        (fn
-      (define read-string!
+          (acc)
-        (fn (acc)
           (cond
             ((>= pos src-len) acc)
             ((cur-sw? "'")
-             (if (and (< (+ pos 1) src-len) (cur-sw? "'"))
+              (if
-               (begin
+                (and (< (+ pos 1) src-len) (cur-sw? "'"))
-                 (advance!)
+                (begin (advance!) (advance!) (read-string! (str acc "'")))
-                 (advance!)
-                 (read-string! (str acc "'")))
                 (begin (advance!) acc)))
             (true
-             (let ((ch (cur-byte)))
+              (let
-               (begin
+                ((ch (cur-byte)))
-                 (advance!)
+                (begin (advance!) (read-string! (str acc ch))))))))
-                 (read-string! (str acc ch))))))))
+      (define
-
+        skip-line!
-      (define skip-line!
+        (fn
-        (fn ()
+          ()
-          (when (and (< pos src-len) (not (cur-sw? "\n")))
+          (when
-            (begin
+            (and (< pos src-len) (not (cur-sw? "\n")))
-              (advance!)
+            (begin (advance!) (skip-line!)))))
-              (skip-line!)))))
+      (define
-
+        scan!
-      (define scan!
+        (fn
-        (fn ()
+          ()
-          (when (< pos src-len)
+          (when
-            (let ((ch (cur-byte)))
+            (< 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? "⍝")
+                ((cur-sw? "⍝") (begin (skip-line!) (scan!)))
-                 (begin (skip-line!) (scan!)))
                 ((cur-sw? "⋄")
                   (begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
                 ((= ch "(")
@@ -123,46 +119,80 @@
                 ((cur-sw? "←")
                   (begin (consume! "←") (tok-push! :assign nil) (scan!)))
                 ((= ch ":")
-                 (let ((start pos))
+                  (let
+                    ((start pos))
                     (begin
                       (advance!)
-                     (if (and (< pos src-len) (apl-alpha? (cur-byte)))
+                      (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? "¯")
+                ((and (cur-sw? "¯") (< (+ pos (len "¯")) src-len) (apl-digit? (nth source (+ pos (len "¯")))))
-                      (< (+ pos (len "¯")) src-len)
-                      (apl-digit? (nth source (+ pos (len "¯")))))
                   (begin
                     (consume! "¯")
-                   (let ((digits (read-digits! "")))
+                    (let
-                     (tok-push! :num (- 0 (parse-int digits 0))))
+                      ((digits (read-digits! "")))
+                      (if
+                        (and
+                          (< pos src-len)
+                          (= (cur-byte) ".")
+                          (< (+ pos 1) src-len)
+                          (apl-digit? (nth source (+ pos 1))))
+                        (begin
+                          (advance!)
+                          (let
+                            ((frac (read-digits! "")))
+                            (tok-push!
+                              :num (- 0 (string->number (str digits "." frac))))))
+                        (tok-push! :num (- 0 (parse-int digits 0)))))
                     (scan!)))
                 ((apl-digit? ch)
                   (begin
-                   (let ((digits (read-digits! "")))
+                    (let
-                     (tok-push! :num (parse-int digits 0)))
+                      ((digits (read-digits! "")))
+                      (if
+                        (and
+                          (< pos src-len)
+                          (= (cur-byte) ".")
+                          (< (+ pos 1) src-len)
+                          (apl-digit? (nth source (+ pos 1))))
+                        (begin
+                          (advance!)
+                          (let
+                            ((frac (read-digits! "")))
+                            (tok-push!
+                              :num (string->number (str digits "." frac)))))
+                        (tok-push! :num (parse-int digits 0))))
                     (scan!)))
                 ((= ch "'")
                   (begin
                     (advance!)
-                   (let ((s (read-string! "")))
+                    (let ((s (read-string! ""))) (tok-push! :str s))
-                     (tok-push! :str s))
                     (scan!)))
                 ((or (apl-alpha? ch) (cur-sw? "⎕"))
-                 (let ((start pos))
+                  (let
+                    ((start pos))
                     (begin
-                     (if (cur-sw? "⎕") (consume! "⎕") (advance!))
+                      (if
-                     (read-ident-cont!)
+                        (cur-sw? "⎕")
+                        (begin
+                          (consume! "⎕")
+                          (if
+                            (and (< pos src-len) (cur-sw? "←"))
+                            (consume! "←")
+                            (read-ident-cont!)))
+                        (begin (advance!) (read-ident-cont!)))
                       (tok-push! :name (slice source start pos))
                       (scan!))))
                 (true
-                 (let ((g (find-glyph)))
+                  (let
-                   (if g
+                    ((g (find-glyph)))
+                    (if
+                      g
                       (begin (consume! g) (tok-push! :glyph g) (scan!))
                       (begin (advance!) (scan!))))))))))
-
       (scan!)
       tokens)))

lib/apl/transpile.sx

@@ -39,7 +39,16 @@
       ((= g "⊖") apl-reverse-first)
       ((= g "⍋") apl-grade-up)
       ((= g "⍒") apl-grade-down)
+      ((= g "?") apl-roll)
+      ((= g "⍉") apl-transpose)
+      ((= g "⊢") (fn (a) a))
+      ((= g "⊣") (fn (a) a))
+      ((= g "⍕") apl-quad-fmt)
       ((= g "⎕FMT") apl-quad-fmt)
+      ((= g "⎕←") apl-quad-print)
+      ((= g "⍸") apl-where)
+      ((= g "∪") apl-unique)
+      ((= g "⍎") apl-execute)
       (else (error "no monadic fn for glyph")))))
 
 (define
@@ -79,6 +88,17 @@
       ((= g "∊") apl-member)
       ((= g "⍳") apl-index-of)
       ((= g "~") apl-without)
+      ((= g "/") apl-compress)
+      ((= g "⌿") apl-compress-first)
+      ((= g "⍉") apl-transpose-dyadic)
+      ((= g "⊢") (fn (a b) b))
+      ((= g "⊣") (fn (a b) a))
+      ((= g "⍸") apl-interval-index)
+      ((= g "∪") apl-union)
+      ((= g "∩") apl-intersect)
+      ((= g "⊥") apl-decode)
+      ((= g "⊤") apl-encode)
+      ((= g "⊆") apl-partition)
       (else (error "no dyadic fn for glyph")))))
 
 (define
@@ -97,6 +117,15 @@
       ((tag (first node)))
       (cond
         ((= tag :num) (apl-scalar (nth node 1)))
+        ((= tag :str)
+          (let
+            ((s (nth node 1)))
+            (if
+              (= (len s) 1)
+              (apl-scalar s)
+              (make-array
+                (list (len s))
+                (map (fn (i) (slice s i (+ i 1))) (range 0 (len s)))))))
         ((= tag :vec)
           (let
             ((items (rest node)))
@@ -104,13 +133,26 @@
               ((vals (map (fn (n) (apl-eval-ast n env)) items)))
               (make-array
                 (list (len vals))
-                (map (fn (v) (first (get v :ravel))) vals)))))
+                (map
+                  (fn
+                    (v)
+                    (if
+                      (= (len (get v :shape)) 0)
+                      (first (get v :ravel))
+                      v))
+                  vals)))))
         ((= tag :name)
           (let
             ((nm (nth node 1)))
             (cond
-              ((= nm "⍺") (get env "alpha"))
+              ((= nm "⍺")
-              ((= nm "⍵") (get env "omega"))
+                (let
+                  ((v (get env "⍺")))
+                  (if (= v nil) (get env "alpha") v)))
+              ((= nm "⍵")
+                (let
+                  ((v (get env "⍵")))
+                  (if (= v nil) (get env "omega") v)))
               ((= nm "⎕IO") (apl-quad-io))
               ((= nm "⎕ML") (apl-quad-ml))
               ((= nm "⎕FR") (apl-quad-fr))
@@ -122,7 +164,11 @@
             (if
               (and (= (first fn-node) :fn-glyph) (= (nth fn-node 1) "∇"))
               (apl-call-dfn-m (get env "nabla") (apl-eval-ast arg env))
-              ((apl-resolve-monadic fn-node env) (apl-eval-ast arg env)))))
+              (let
+                ((arg-val (apl-eval-ast arg env)))
+                (let
+                  ((new-env (if (and (list? arg) (> (len arg) 0) (= (first arg) :assign-expr)) (assoc env (nth arg 1) arg-val) env)))
+                  ((apl-resolve-monadic fn-node new-env) arg-val))))))
         ((= tag :dyad)
           (let
             ((fn-node (nth node 1))
@@ -134,11 +180,27 @@
                 (get env "nabla")
                 (apl-eval-ast lhs env)
                 (apl-eval-ast rhs env))
-              ((apl-resolve-dyadic fn-node env)
+              (let
-                (apl-eval-ast lhs env)
+                ((rhs-val (apl-eval-ast rhs env)))
-                (apl-eval-ast rhs env)))))
+                (let
+                  ((new-env (if (and (list? rhs) (> (len rhs) 0) (= (first rhs) :assign-expr)) (assoc env (nth rhs 1) rhs-val) env)))
+                  ((apl-resolve-dyadic fn-node new-env)
+                    (apl-eval-ast lhs new-env)
+                    rhs-val))))))
         ((= tag :program) (apl-eval-stmts (rest node) env))
         ((= tag :dfn) node)
+        ((= tag :bracket)
+          (let
+            ((arr-expr (nth node 1)) (axis-exprs (rest (rest node))))
+            (let
+              ((arr (apl-eval-ast arr-expr env))
+                (axes
+                  (map
+                    (fn (a) (if (= a :all) nil (apl-eval-ast a env)))
+                    axis-exprs)))
+              (apl-bracket-multi axes arr))))
+        ((= tag :assign-expr) (apl-eval-ast (nth node 2) env))
+        ((= tag :assign) (apl-eval-ast (nth node 2) env))
         (else (error (list "apl-eval-ast: unknown node tag" tag node)))))))
 
 (define
@@ -419,6 +481,36 @@
                   ((f (apl-resolve-dyadic inner env)))
                   (fn (arr) (apl-commute f arr))))
               (else (error "apl-resolve-monadic: unsupported op")))))
+        ((= tag :fn-name)
+          (let
+            ((nm (nth fn-node 1)))
+            (let
+              ((bound (get env nm)))
+              (if
+                (and
+                  (list? bound)
+                  (> (len bound) 0)
+                  (= (first bound) :dfn))
+                (fn (arg) (apl-call-dfn-m bound arg))
+                (error "apl-resolve-monadic: name not bound to dfn")))))
+        ((= tag :train)
+          (let
+            ((fns (rest fn-node)))
+            (let
+              ((n (len fns)))
+              (cond
+                ((= n 2)
+                  (let
+                    ((g (apl-resolve-monadic (nth fns 0) env))
+                      (h (apl-resolve-monadic (nth fns 1) env)))
+                    (fn (arg) (g (h arg)))))
+                ((= n 3)
+                  (let
+                    ((f (apl-resolve-monadic (nth fns 0) env))
+                      (g (apl-resolve-dyadic (nth fns 1) env))
+                      (h (apl-resolve-monadic (nth fns 2) env)))
+                    (fn (arg) (g (f arg) (h arg)))))
+                (else (error "monadic train arity not 2 or 3"))))))
         (else (error "apl-resolve-monadic: unknown fn-node tag"))))))
 
 (define
@@ -442,6 +534,18 @@
                   ((f (apl-resolve-dyadic inner env)))
                   (fn (a b) (apl-commute-dyadic f a b))))
               (else (error "apl-resolve-dyadic: unsupported op")))))
+        ((= tag :fn-name)
+          (let
+            ((nm (nth fn-node 1)))
+            (let
+              ((bound (get env nm)))
+              (if
+                (and
+                  (list? bound)
+                  (> (len bound) 0)
+                  (= (first bound) :dfn))
+                (fn (a b) (apl-call-dfn bound a b))
+                (error "apl-resolve-dyadic: name not bound to dfn")))))
         ((= tag :outer)
           (let
             ((inner (nth fn-node 2)))
@@ -455,6 +559,34 @@
               ((f (apl-resolve-dyadic f-node env))
                 (g (apl-resolve-dyadic g-node env)))
               (fn (a b) (apl-inner f g a b)))))
+        ((= tag :train)
+          (let
+            ((fns (rest fn-node)))
+            (let
+              ((n (len fns)))
+              (cond
+                ((= n 2)
+                  (let
+                    ((g (apl-resolve-monadic (nth fns 0) env))
+                      (h (apl-resolve-dyadic (nth fns 1) env)))
+                    (fn (a b) (g (h a b)))))
+                ((= n 3)
+                  (let
+                    ((f (apl-resolve-dyadic (nth fns 0) env))
+                      (g (apl-resolve-dyadic (nth fns 1) env))
+                      (h (apl-resolve-dyadic (nth fns 2) env)))
+                    (fn (a b) (g (f a b) (h a b)))))
+                (else (error "dyadic train arity not 2 or 3"))))))
         (else (error "apl-resolve-dyadic: unknown fn-node tag"))))))
 
 (define apl-run (fn (src) (apl-eval-ast (parse-apl src) {})))
+
+(define apl-run-file (fn (path) (apl-run (file-read path))))
+
+(define
+  apl-execute
+  (fn
+    (arr)
+    (let
+      ((src (cond ((string? arr) arr) ((scalar? arr) (disclose arr)) (else (reduce str "" (get arr :ravel))))))
+      (apl-run src))))

plans/apl-on-sx.md

@@ -135,6 +135,163 @@ and tightens loose ends.
   on error switches to the trap branch.  Define `apl-throw` and a small
   set of error codes; use `try`/`catch` from the host.
 
+### Phase 8 — fill the gaps left after end-to-end
+
+Phase 7 wired the stack together; Phase 8 closes deferred items, lets real
+programs run from source, and starts pushing on performance.
+
+- [x] **Quick-wins bundle** (one iteration) — three small fixes that each unblock
+  real programs:
+  - decimal literals: `read-digits!` consumes one trailing `.` plus more digits
+    so `3.7` tokenises as one number;
+  - `⎕←` (print) — tokenizer special-case: when `⎕` is followed by `←`, emit
+    a single `:name "⎕←"` token (don't split on the assign glyph);
+  - string values in `apl-eval-ast` — handle `:str` (parser already produces
+    them) by wrapping into a vector of character codes (or rank-0 string).
+- [x] **Named function definitions** — `f ← {⍺+⍵} ⋄ 1 f 2` and `2 f 3`.
+  - parser: when `:assign`'s RHS is a `:dfn`, mark it as a function binding;
+  - eval-ast: `:assign` of a dfn stores the dfn in env;
+  - parser: a name in fn-position whose env value is a dfn dispatches as a fn;
+  - resolver: extend `apl-resolve-monadic`/`-dyadic` with a `:fn-name` case
+    that calls `apl-call-dfn`/`apl-call-dfn-m`.
+- [x] **Multi-axis bracket indexing** — `A[I;J]` and `A[;J]` and `A[I;]`.
+  - parser: split bracket content on `:semi` at depth 0; emit
+    `(:dyad ⌷ (:vec I J) A)`;
+  - runtime: extend `apl-squad` to accept a vector of indices, treating
+    `nil` / empty axis as "all";
+  - 5+ tests across vector and matrix.
+- [x] **`.apl` files as actual tests** — `lib/apl/tests/programs/*.apl` are
+  currently documentation. Add `apl-run-file path → array` plus tests that
+  load each file, execute it, and assert the expected result. Makes the
+  classic-program corpus self-validating instead of two parallel impls.
+  _(Embedded source-string approach: tests/programs-e2e.sx runs the same
+  algorithms as the .apl docs through the full pipeline. The original
+  one-liners (e.g. primes' inline `⍵←⍳⍵`) need parser features
+  (compress-as-fn, inline assign) we haven't built yet — multi-stmt forms
+  used instead. Slurp/read-file primitive missing in OCaml SX runtime.)_
+- [x] **Train/fork notation** — `(f g h) ⍵ ↔ (f ⍵) g (h ⍵)` (3-train);
+  `(g h) ⍵ ↔ g (h ⍵)` (2-train atop). Parser: detect when a parenthesised
+  subexpression is all functions and emit `(:train fns)`; resolver: build the
+  derived function; tests for mean-via-train (`+/÷≢`).
+- [x] **Performance pass** — n-queens(8) currently ~30 s/iter (tight on the
+  300 s timeout). Target: profile the inner loop, eliminate quadratic
+  list-append, restore the `queens(8)` test.
+
+### Phase 9 — make `.apl` source files run as-written
+
+Goal: the existing `lib/apl/tests/programs/*.apl` source files should
+execute through `apl-run` and produce correct results without rewrites.
+Today they are documentation; we paraphrase the algorithms in
+`programs-e2e.sx`.  Phase 9 closes that gap.
+
+- [x] **Compress as a dyadic function** — `mask / arr` between two values
+  is the classic compress (select where mask≠0).  Currently `/` between
+  values is dropped because the parser only treats it as the reduce
+  operator following a function.  Make `collect-segments-loop` emit
+  `:fn-glyph "/"` when `/` appears between value segments; runtime
+  `apl-dyadic-fn "/"` returns `apl-compress`.  Same for `⌿`
+  (first-axis compress).
+- [x] **Inline assignment** — `⍵ ← ⍳⍵` mid-expression.  Parser currently
+  only handles `:assign` at the start of a statement.  Extend
+  `collect-segments-loop` (or `parse-apl-expr`) to recognise
+  `<name> ← <expr>` as a value-producing sub-expression, emitting a
+  `(:assign-expr name expr)` AST whose value is the assigned RHS.
+  Required by the primes idiom `(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵`.
+  _(Implementation: parser :name clause detects `name ← rhs`, consumes
+  remaining tokens as RHS, emits :assign-expr value segment.  Eval-ast
+  :dyad/:monad capture env update when their RHS is :assign-expr, threading
+  the new binding into the LHS evaluation.  Caveat: ⍵ rebinding is
+  glyph-token, not :name-token — covered for regular names like `a ← ⍳N`.)_
+- [x] **`?` (random / roll)** — monadic `?N` returns a random integer
+  in 1..N.  Used by quicksort.apl for pivot selection.  Add `apl-roll`
+  (deterministic seed for tests) + glyph wiring.
+- [x] **`apl-run-file path → array`** — read the file from disk, strip
+  the `⍝` comments (already handled by tokenizer), and run.  Needs an
+  IO primitive on the SX side.  Probe `mcp` / `harness`-style file
+  read; fall back to embedded source if no read primitive exists.
+  _(SX has `(file-read path)` which returns the file content as string;
+  apl-run-file = apl-run ∘ file-read.)_
+- [x] **End-to-end .apl tests** — once the above land, add tests that
+  run `lib/apl/tests/programs/*.apl` *as written* and assert results.
+  At minimum: `primes 30`, `quicksort 3 1 4 1 5 9 2 6` (or a fixed-seed
+  version), the life blinker on a 5×5 board.
+  _(primes.apl runs as-written with ⍵-rebind now supported.  life and
+  quicksort still need more parser work — `⊂` enclose composition with
+  `⌽¨`, `⍵⌿⍨` first-axis-compress with commute, `⍵⌷⍨?≢⍵`.)_
+- [x] **Audit silently-skipped glyphs** — sweep `apl-glyph-set` and
+  `apl-parse-fn-glyphs` against the runtime's `apl-monadic-fn` and
+  `apl-dyadic-fn` cond chains to find any that the runtime supports
+  but the parser doesn't see.
+  _(Wired ⍉ → apl-transpose / apl-transpose-dyadic, ⊢ identity,
+  ⊣ left, ⍕ as alias for ⎕FMT.  ⊆ ∪ ∩ ⍸ ⊥ ⊤ ⍎ remain unimplemented
+  in the runtime — parser sees them as functions but eval errors;
+  next-phase work.)_
+
+### Phase 10 — fill runtime gaps + life/quicksort source files run
+
+Phase 9 left seven glyphs that the parser recognises but the runtime
+cannot evaluate, and two source files (`life.apl`, `quicksort.apl`) that
+still need work to run as-written.  Phase 10 closes both.
+
+- [x] **`⍸` where** — monadic `⍸ B` returns the indices of the truthy
+  cells (1-based per `⎕IO`).  Dyadic `X ⍸ Y` is interval index (find
+  the largest `i` such that `X[i] ≤ Y`).  Add `apl-where` + dyadic
+  `apl-interval-index`; wire both into `apl-monadic-fn` / `apl-dyadic-fn`.
+  Tests: `⍸ 0 1 0 1 1 → 2 4 5`, `⍸ ⍳5 = ¯1+⍳5 → empty`,
+  `2 4 6 ⍸ 5 → 2`.
+- [x] **`∪` unique / `∩` intersection** — monadic `∪ V` returns V with
+  duplicates removed (first-occurrence order); dyadic `A ∪ B` is
+  union; `A ∩ B` is intersection (members of A that are also in B).
+  Add `apl-unique`, `apl-union`, `apl-intersect`.  Tests cover empty,
+  single, repeats, mixed numerics.
+- [x] **`⊥` decode / `⊤` encode** — `B ⊥ V` evaluates digits `V` in
+  base(s) `B` (Horner-style); `B ⊤ N` is the inverse, returning the
+  digits of `N` in base(s) `B`.  Both broadcast `B` as scalar or
+  conformable vector.  Add `apl-decode` and `apl-encode`.  Tests:
+  `2 ⊥ 1 0 1 → 5`, `10 ⊥ 1 2 3 → 123`, `2 2 2 ⊤ 5 → 1 0 1`,
+  `24 60 60 ⊤ 7384 → 2 3 4`.
+- [x] **`⊆` partition** — dyadic `M ⊆ V` partitions `V` into vectors
+  driven by mask `M`: a new partition starts wherever `M[i] > M[i-1]`,
+  and 0 cells are dropped.  Returns a vector of (boxed) partitions.
+  Add `apl-partition`.  Tests: `1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')`,
+  `1 0 0 1 1 ⊆ ⍳5 → ((⊂ 1) (⊂ 4 5))`.
+- [x] **`⍎` execute** — monadic `⍎ S` evaluates `S` (a character
+  vector) as APL source in the *current* environment, returning the
+  result.  Implement as `(fn (s) (apl-run s))` — env is the global
+  one; nested execute is fine.  Wire into `apl-monadic-fn`.  Tests:
+  `⍎ '1 + 2' → 3`, `⍎ '+/⍳10' → 55`.
+- [x] **`life.apl` runs as-written** — Conway's life one-liner uses
+  `⊃+/⌽¨ -1 0 1 ∘.,¯1 0 1` (each + outer-comma + disclose + reduce
+  over a list of rotations) and the rule expression.  Probe what
+  fails when `apl-run-file "lib/apl/tests/programs/life.apl"` is
+  called on a 5×5 blinker grid; fix any remaining parser/runtime
+  gaps; assert blinker oscillates and block stays stable as full
+  end-to-end tests in `programs-e2e.sx`.
+- [x] **`quicksort.apl` runs as-written** — the classic Iverson dfn
+  `{1≥≢⍵:⍵ ⋄ (∇(⍵<pivot)⌿⍵),(⍵=pivot)⌿⍵,∇(⍵>pivot)⌿⍵⊣pivot←⍵⌷⍨?≢⍵}`
+  exercises `⌷⍨` (squad-commute pivot pick), `⌿⍨` (first-axis-compress
+  commute), and `⊣` to bind a local without polluting the result.
+  Set the RNG seed for determinism and assert the sort against
+  `apl-grade-up`.
+
+### Phase 11 — heterogeneous-strand inner product (restore life.apl ⊃)
+
+Phase 10 step 6 closed life.apl by dropping the leading `⊃` from
+Hui's formulation, because our inner product over a mixed
+scalar/matrix strand (`1 ⍵`) produced a clean (5 5) board which
+`⊃` then collapsed to its first row.  Hui's original needs `⊃` to
+*unwrap* an enclosed result of the inner product.  Phase 11 closes
+that semantic gap so life.apl can be restored to its true
+as-written form.
+
+- [x] **Inner product encloses on heterogeneous left arg** —
+  detect when `A` in `A f.g B` has a ravel containing a dict
+  (boxed array), and in that case wrap the inner-product result
+  in `enclose` (rank-0 wrapping the matrix).  Then `⊃` on the
+  result unwraps to the underlying board.  Restore life.apl to
+  the original `{⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵}`
+  and update its tests + comment block.
+
 ## SX primitive baseline
 
 Use vectors for arrays; numeric tower + rationals for numbers; ADTs for tagged data;
@@ -149,6 +306,29 @@ data; format for string templating.
 
 _Newest first._
 
+- 2026-05-11: Phase 11 — heterogeneous-strand inner product. apl-inner now encloses its result when A's ravel contains a dict (boxed array) — Hui's `1 ⍵ ∨.∧ X` produces a rank-0 wrapping the (5 5) board, which ⊃ then unwraps to the bare matrix. Restored life.apl to its true as-written form `{⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵}` and updated all 5 e2e tests + comment block. Homogeneous inner product unaffected (+.× over numbers/matrices still produces bare arrays). +4 pipeline tests for the heterogeneous case + ⊃ unwrap path; **Phase 11 complete**; full suite 589/589
+- 2026-05-08: Phase 10 step 7 — quicksort.apl runs as-written. Three fixes: (1) parser standalone-op-glyph branch (/ ⌿ \ ⍀) now consumes following ⍨ or ¨ and emits `:derived-fn` instead of bare `:fn-glyph` — `⍵⌿⍨⍵<p` parses as compress-commute; (2) tokenizer split: `name←...` (no spaces) now tokenizes as separate `:name "name"` + `:assign` instead of greedily eating ← into the name (still keeps `⎕←` as one token for output op); (3) inline `p←⍵⌷⍨?≢⍵` mid-dfn now works via existing :assign-expr machinery. The classic Iverson dfn `{1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p}` sorts correctly. +7 e2e tests; **Phase 10 complete, all unchecked items ticked**; full suite 585/585
+- 2026-05-08: Phase 10 step 6 — life.apl runs as-written. Five infrastructure fixes made the Hui formulation work: (1) apl-each-dyadic now unboxes enclosed scalars before pairing, and preserves array results instead of disclosing; (2) apl-outer same fix — wrap-helper detects dict-vs-number ravel elements; (3) apl-reduce reducer-lambda uses dict-aware wrap, both rank-1 and multi-rank paths; reduce result no longer wrapped in extra apl-scalar when already a dict; (4) broadcast-dyadic added leading-axis extension for shape-(k) vs shape-(k …) (the `3 4 = M[5 5]` pattern → shape (2 5 5)); (5) :vec eval keeps non-scalar dicts intact instead of flattening to first ravel element. Updated life.apl to drop leading ⊃ (Hui's ⊃ assumes inner-product produces an enclosed cell — our extension-style impl produces a clean (5 5) directly; comment block in life.apl explains). +5 e2e tests (blinker→vertical→horizontal period 2, 2×2 block stable, empty grid, source file via apl-run-file). Full test suite 578/578
+- 2026-05-08: Phase 10 step 5 — `⍎` execute. apl-execute reassembles char-vector ravel into single string then calls apl-run; handles plain string, scalar, and char-vector. `⍎ '1 + 2' → 3`, `⍎ '+/⍳10' → 55`, round-trip `⍎ ⎕FMT 42 → 42`, nested `⍎ ⍎ '...'` works, with `⋄` separator (assignment + use). Wired into apl-monadic-fn. +8 tests; pipeline 148/148
+- 2026-05-08: Phase 10 step 4 — `⊆` partition. apl-partition: walk M and V together via reduce, opening a new partition where M[i]>M[i-1] (initial prev=0), continuing where M[i]≤prev∧M[i]≠0, dropping cells where M[i]=0. Returns apl-vector of apl-vector parts. `1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')`, `1 0 0 1 1 ⊆ ⍳5 → ((1) (4 5))`, strict-increase `1 2` opens new, constant `2 2` continues. Wired into apl-dyadic-fn. +8 tests; pipeline 140/140
+- 2026-05-08: Phase 10 step 3 — `⊥` decode / `⊤` encode. apl-decode (Horner reduce over indices, base[i]>0; scalar base broadcasts to digit length); apl-encode (right-to-left modulo+floor-div via reduce). Mixed-radix HMS works: `24 60 60 ⊥ 2 3 4 → 7384`, `24 60 60 ⊤ 7384 → 2 3 4`. Round-trips exact. Wired ⊥ ⊤ into apl-dyadic-fn. +11 tests; pipeline 132/132
+- 2026-05-08: Phase 10 step 2 — `∪` unique / `∩` intersection. apl-unique (monadic, dedup keeping first-occurrence order via reduce+index-of), apl-union (dyadic, dedup'd A then B-elements-not-in-A), apl-intersect (dyadic, A elements that are also in B, preserves left order). Wired ∪ into both apl-monadic-fn and apl-dyadic-fn cond chains; ∩ into apl-dyadic-fn. +12 tests; pipeline 121/121
+- 2026-05-08: Phase 10 step 1 — `⍸` where. apl-where (monadic, indices of truthy cells, ⎕IO-respecting) + apl-interval-index (dyadic, count of breaks ≤ y; broadcasts over Y vector or scalar). Wired into apl-monadic-fn / apl-dyadic-fn (cond clauses inserted as proper siblings via sx_insert_child after sx_insert_near silently wrapped multi-form sources in `(begin …)`). +10 tests; pipeline 109/109
+- 2026-05-08: Phase 10 added — fill runtime gaps (⍸ ∪ ∩ ⊥ ⊤ ⊆ ⍎) + life.apl and quicksort.apl as-written
+- 2026-05-07: Phase 9 step 6 — glyph audit. Wired ⍉ → apl-transpose/apl-transpose-dyadic, ⊢ → monadic+dyadic identity-right, ⊣ → identity-left, ⍕ → apl-quad-fmt. +6 tests; **Phase 9 complete, all unchecked items ticked**; pipeline 99/99
+- 2026-05-07: Phase 9 step 5 — primes.apl runs as-written end-to-end. Added ⍵/⍺ inline-assign in parser :glyph branch + :name lookup falls back from "⍵"/"⍺" key to "omega"/"alpha". `apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 50"` → 15 primes. +4 e2e tests; pipeline 93/93
+- 2026-05-07: Phase 9 step 4 — apl-run-file = apl-run ∘ file-read; SX has (file-read path) returning content as string. primes/life/quicksort .apl files now load and parse end-to-end (return :dfn AST). +4 tests
+- 2026-05-07: Phase 9 step 3 — `?N` random / roll. Top-level mutable apl-rng-state with LCG; apl-rng-seed! for deterministic tests; apl-roll wraps as scalar in 1..N. apl-monadic-fn maps "?" → apl-roll. +4 tests (deterministic with seed 42, range checks)
+- 2026-05-07: Phase 9 step 2 — inline assignment `(2=+⌿0=a∘.|a)/a←⍳30` runs end-to-end. Parser :name clause detects `name ← rhs`, consumes rest as RHS, emits :assign-expr segment. Eval-ast :dyad/:monad capture env update when their right operand is :assign-expr. +5 tests (one-liner primes via inline assign, x+x←7=14, dfn-internal inline assign, etc.)
+- 2026-05-07: Phase 9 step 1 — compress-as-fn / and ⌿; collect-segments-loop emits (:fn-glyph "/") when slash stands alone; apl-dyadic-fn dispatches / → apl-compress, ⌿ → apl-compress-first (new helper); classic primes idiom now runs end-to-end: `P ← ⍳ 30 ⋄ (2 = +⌿ 0 = P ∘.| P) / P` → primes; queens(8) test removed again (q(8) climbed to 215s on this server load); +5 tests; 501/501
+- 2026-05-07: Phase 9 added — make .apl source files run as-written (compress as dyadic /, inline assignment, ? random, apl-run-file, glyph audit, source-as-tests)
+- 2026-05-07: Phase 8 step 6 — perf: swapped (append acc xs) → (append xs acc) in apl-permutations to make permutation generation linear instead of quadratic; q(7) 32s→12s; q(8)=92 test restored within 300s timeout; **Phase 8 complete, all unchecked items ticked**; 497/497
+- 2026-05-07: Phase 8 step 5 — train/fork notation. Parser :lparen detects all-fn inner segments → emits :train AST; resolver covers 2-atop & 3-fork for both monadic and dyadic. `(+/÷≢) 1..5 → 3` (mean), `(- ⌊) 5 → -5` (atop), `2(+×-)5 → -21` (dyadic fork), `(⌈/-⌊/) → 8` (range); +6 tests; 496/496
+- 2026-05-07: Phase 8 step 4 — programs-e2e.sx runs classic-algorithm shapes through full pipeline (factorial via ∇, triangulars, sum-of-squares, divisor-counts, prime-mask, named-fn composition, dyadic max-of-two, Newton step); also added ⌿ + ⍀ to glyph sets (were silently skipped); +15 tests; 490/490
+- 2026-05-07: Phase 8 step 3 — multi-axis bracket A[I;J] / A[I;] / A[;J] via :bracket AST + apl-bracket-multi runtime; split-bracket-content scans :semi at depth 0; apl-cartesian builds index combinations; nil axis = "all"; scalar axis collapses; +8 tests; 475/475
+- 2026-05-07: Phase 8 step 2 — named function defs end-to-end via parser pre-scan; apl-known-fn-names + apl-collect-fn-bindings detect `name ← {...}` patterns; collect-segments-loop emits :fn-name for known names; resolver looks up env for :fn-name; supports recursion (∇ in named dfn); +7 tests including fact via ∇; 467/467
+- 2026-05-07: Phase 8 step 1 — quick-wins bundle: decimal literals (3.7, ¯2.5), ⎕← passthrough as monadic fn (single-token via tokenizer special-case), :str AST in eval-ast (single-char→scalar, multi-char→vec); +10 tests; 460/460
+- 2026-05-07: Phase 8 added — quick-wins bundle (decimals + ⎕← + strings), named functions, multi-axis bracket, .apl-files-as-tests, trains, perf
 - 2026-05-07: Phase 7 step 6 — :Trap exception machinery via R7RS guard; apl-throw raises tagged error, apl-trap-matches? checks codes (0=catch-all), :trap clause in apl-tradfn-eval-stmt wraps try-block with guard; :throw AST for testing; **Phase 7 complete, all unchecked plan items done**; +5 tests; 450/450
 - 2026-05-07: Phase 7 step 5 — idiom corpus 34→64 (+30 source-string idioms via apl-run); also fixed tokenizer + parser to recognize ≢ and ≡ glyphs (were silently skipped); 445/445
 - 2026-05-07: Phase 7 step 4 — bracket indexing `A[I]` desugared to `(:dyad ⌷ I A)` via maybe-bracket helper, wired into :name + :lparen branches of collect-segments-loop; multi-axis (A[I;J]) deferred (semicolon split); +7 tests; 415/415
@@ -192,4 +372,10 @@ _Newest first._
 
 ## Blockers
 
-- _(none yet)_
+- 2026-05-08: **sx-tree MCP server disconnected at start of Phase 10.**
+  Path-based sx-tree tools error with `Type_error("Expected string, got null")`
+  and the server then dropped entirely (45 tools unavailable).  Loop paused
+  at Phase 10 step 1 (`⍸ where`); resume once `/mcp` reconnects sx-tree.
+- 2026-05-07: **sx-tree MCP server disconnected mid-Phase-9.** `lib/apl/**.sx`
+  edits require `sx-tree` per CLAUDE.md — Edit/Read on `.sx` is hook-blocked.
+  Loop paused at Phase 9 step 2 (inline assignment); resume once MCP restored.