10 Commits

Author SHA1 Message Date
40dff449ef apl: het-inner-product encloses (+4); life.apl restored to as-written
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
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.
2026-05-11 21:19:06 +00:00
eeb530eb85 apl: quicksort.apl runs as-written (+7); Phase 10 complete
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
Three fixes for Iverson's dfn
{1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p}:

1. parser: standalone op-glyph branch (/ ⌿ \ ⍀) now consumes a
   following ⍨ or ¨ and emits :derived-fn — `⍵⌿⍨⍵<p` parses
   as compress-commute (was previously dropping ⍨)
2. tokenizer: `name←...` (no spaces) now tokenizes as separate
   :name + :assign instead of eating ← into the name. ⎕← still
   stays one token for the output op
3. inline p←⍵⌷⍨?≢⍵ mid-dfn now works via existing :assign-expr

Full suite 585/585. Phase 10 complete (all 7 items ticked).

Remaining gaps for a future phase: heterogeneous-strand inner
product is the only unfinished part — life works after dropping ⊃,
quicksort works directly.
2026-05-08 23:53:49 +00:00
36e1519613 apl: life.apl runs as-written (+5 e2e)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
Five infrastructure fixes to make the Hui formulation
{1 ⍵ ∨.∧ 3 4 = +/+/¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} work:

1. apl-each-dyadic: unbox enclosed-array scalar before pairing;
   preserve array results instead of disclosing
2. apl-outer: same dict-vs-number wrap detection
3. apl-reduce: dict-aware wrap in reducer; don't double-wrap
   the final result in apl-scalar when it's already a dict
4. broadcast-dyadic: leading-axis extension for shape-(k) vs
   shape-(k …) — `3 4 = M[5,5]` → shape (2 5 5)
5. :vec eval keeps non-scalar dicts intact (no flatten-to-first)

life.apl: drop leading ⊃ (Hui's ⊃ assumes inner-product produces
enclosed cell; our extension-style impl produces clean (5 5)).
Comment block in life.apl explains.

5 e2e tests: blinker oscillates period-2, 2×2 block stable,
empty grid stays empty, source file load via apl-run-file.

Full suite 578/578.
2026-05-08 23:35:14 +00:00
d1a491e530 apl: ⍎ execute — eval string as APL source (+8)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
- apl-execute: reassemble char-vector ravel into single string,
  then apl-run; handles plain string, scalar, and char-vector
- nested ⍎ ⍎ works; ⋄ separator threads through
- pipeline 148/148
2026-05-08 23:00:39 +00:00
015ecb8bc8 apl: ⊆ partition — mask-driven split (+8)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
- apl-partition: new partition where M[i]>M[i-1] (init prev=0);
  continue where M[i]≤prev∧M[i]≠0; drop cells where M[i]=0
- Returns apl-vector of apl-vector parts
- pipeline 140/140
2026-05-08 22:55:01 +00:00
a074ea9e98 apl: ⊥ decode / ⊤ encode (mixed-radix; +11)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
- apl-decode: Horner reduce; scalar base broadcasts to digit length
- apl-encode: right-to-left modulo + floor-div
- 24 60 60 ⊥ 2 3 4 → 7384, 24 60 60 ⊤ 7384 → 2 3 4
- pipeline 132/132
2026-05-08 22:49:11 +00:00
ef53232314 apl: ∪ unique / ∪ union / ∩ intersection (+12)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
- apl-unique: dedup keeping first-occurrence order
- apl-union: dedup'd A then B-elements-not-in-A
- apl-intersect: A elements that are in B, preserves left order
- ∪ wired both monadic and dyadic; ∩ wired dyadic
- pipeline 121/121
2026-05-08 22:42:29 +00:00
8cdebbe305 apl: ⍸ where — monadic indices-of-truthy + dyadic interval-index
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
- apl-where (monadic): ravel scan, filter non-zero, +⎕IO offsets
- apl-interval-index (dyadic): count of breaks ≤ y; broadcasts over
  scalar or vector Y
- Wired into apl-monadic-fn / apl-dyadic-fn cond chains
- +10 pipeline tests covering both arities, ⎕IO offsetting, edge cases
  (empty mask, all-truthy, y below/above all breaks)
- pipeline 109/109
2026-05-08 22:35:35 +00:00
58c6ec27f3 plans: log blocker — sx-tree MCP disconnected at start of Phase 10
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
2026-05-08 07:46:59 +00:00
fa43aa6711 plans: Phase 10 — runtime gaps (⍸ ∪ ∩ ⊥ ⊤ ⊆ ⍎) + life/quicksort as-written
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
2026-05-08 07:27:22 +00:00
8 changed files with 771 additions and 185 deletions

View File

@@ -416,10 +416,20 @@
((apl-parse-op-glyph? tv) ((apl-parse-op-glyph? tv)
(if (if
(or (= tv "/") (= tv "⌿") (= tv "\\") (= tv "⍀")) (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 (collect-segments-loop
tokens tokens
(+ i 1) (+ i advance)
(append acc {:kind "fn" :node (list :fn-glyph tv)})) (append acc {:kind "fn" :node node}))))))
(collect-segments-loop tokens (+ i 1) acc))) (collect-segments-loop tokens (+ i 1) acc)))
(true (collect-segments-loop tokens (+ i 1) acc)))) (true (collect-segments-loop tokens (+ i 1) acc))))
(true (collect-segments-loop tokens (+ i 1) acc)))))))) (true (collect-segments-loop tokens (+ i 1) acc))))))))

View File

@@ -65,10 +65,30 @@
(get a :shape) (get a :shape)
(map (fn (x) (f x sv)) (get a :ravel))))) (map (fn (x) (f x sv)) (get a :ravel)))))
(else (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 ; Arithmetic primitives
@@ -827,6 +847,106 @@
((new-ravel (reduce (fn (acc r) (append acc (map (fn (j) (nth ravel (+ (* r cols) j))) (range 0 cols)))) (list) kept-rows))) ((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)))))))) (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 (define
apl-primes apl-primes
(fn (fn
@@ -1074,11 +1194,9 @@
(if (if
(= n 0) (= n 0)
(apl-scalar 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 (let
((last-dim (last shape)) ((last-dim (last shape))
(pre-shape (take shape (- (len shape) 1))) (pre-shape (take shape (- (len shape) 1)))
@@ -1100,7 +1218,13 @@
(reduce (reduce
(fn (fn
(a b) (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) (first elems)
(rest elems))))) (rest elems)))))
(range 0 pre-size))))))))) (range 0 pre-size)))))))))
@@ -1241,13 +1365,29 @@
(cond (cond
((and (scalar? a) (scalar? b)) (apl-scalar (disclose (f a b)))) ((and (scalar? a) (scalar? b)) (apl-scalar (disclose (f a b))))
((scalar? a) ((scalar? a)
(let
((a-eff (let ((d (disclose a))) (if (= (type-of d) "dict") d a))))
(make-array (make-array
(get b :shape) (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) ((scalar? b)
(let
((b-eff (let ((d (disclose b))) (if (= (type-of d) "dict") d b))))
(make-array (make-array
(get a :shape) (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 (else
(if (if
(equal? (get a :shape) (get b :shape)) (equal? (get a :shape) (get b :shape))
@@ -1268,6 +1408,8 @@
(b-shape (get b :shape)) (b-shape (get b :shape))
(a-ravel (get a :ravel)) (a-ravel (get a :ravel))
(b-ravel (get b :ravel))) (b-ravel (get b :ravel)))
(let
((wrap (fn (x) (if (= (type-of x) "dict") x (apl-scalar x)))))
(make-array (make-array
(append a-shape b-shape) (append a-shape b-shape)
(flatten (flatten
@@ -1275,9 +1417,13 @@
(fn (fn
(x) (x)
(map (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)) b-ravel))
a-ravel)))))) a-ravel)))))))
(define (define
apl-inner apl-inner
@@ -1301,25 +1447,12 @@
((a-pre-size (reduce * 1 a-pre)) ((a-pre-size (reduce * 1 a-pre))
(b-post-size (reduce * 1 b-post)) (b-post-size (reduce * 1 b-post))
(new-shape (append a-pre b-post))) (new-shape (append a-pre b-post)))
(make-array
new-shape
(flatten
(map
(fn
(i)
(map
(fn
(j)
(let (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))) (define apl-commute (fn (f x) (f x x)))

View File

@@ -455,3 +455,233 @@
(list 1 2 3)) (list 1 2 3))
(apl-test "⍕ 42 → \"42\" (alias for ⎕FMT)" (apl-run "⍕ 42") "42") (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⊥(BN) = 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)))

View File

@@ -94,3 +94,96 @@
"e2e: sqrt-via-newton 1 step from 1 → 2.5" "e2e: sqrt-via-newton 1 step from 1 → 2.5"
(mkrv (apl-run "step ← {(⍵+⍺÷⍵)÷2} ⋄ 4 step 1")) (mkrv (apl-run "step ← {(⍵+⍺÷⍵)÷2} ⋄ 4 step 1"))
(list 2.5)) (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)))

View File

@@ -8,9 +8,9 @@
⍝ ¯1 0 1 ⌽¨ ⊂⍵ : produce 3 horizontally-shifted copies ⍝ ¯1 0 1 ⌽¨ ⊂⍵ : produce 3 horizontally-shifted copies
⍝ ¯1 0 1 ∘.⊖ … : outer-product with vertical shifts → 3×3 = 9 shifts ⍝ ¯1 0 1 ∘.⊖ … : outer-product with vertical shifts → 3×3 = 9 shifts
⍝ +/ +/ … : sum the 9 boards element-wise → neighbor-count + self ⍝ +/ +/ … : 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) ⍝ 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: ⍝ Rules in plain language:
⍝ - dead cell + 3 live neighbors → born ⍝ - dead cell + 3 live neighbors → born

View File

@@ -19,91 +19,87 @@
(and (>= ch "A") (<= ch "Z")) (and (>= ch "A") (<= ch "Z"))
(= ch "_"))))) (= 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)))) (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))))) (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))) 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)))) (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 (cond
((>= pos src-len) acc) ((>= pos src-len) acc)
((cur-sw? "'") ((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))) (begin (advance!) acc)))
(true (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 (cond
((or (= ch " ") (= ch "\t") (= ch "\r")) ((or (= ch " ") (= ch "\t") (= ch "\r"))
(begin (advance!) (scan!))) (begin (advance!) (scan!)))
((= ch "\n") ((= ch "\n")
(begin (advance!) (tok-push! :newline nil) (scan!))) (begin (advance!) (tok-push! :newline nil) (scan!)))
((cur-sw? "⍝") ((cur-sw? "⍝") (begin (skip-line!) (scan!)))
(begin (skip-line!) (scan!)))
((cur-sw? "⋄") ((cur-sw? "⋄")
(begin (consume! "⋄") (tok-push! :diamond nil) (scan!))) (begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
((= ch "(") ((= ch "(")
@@ -123,58 +119,80 @@
((cur-sw? "←") ((cur-sw? "←")
(begin (consume! "←") (tok-push! :assign nil) (scan!))) (begin (consume! "←") (tok-push! :assign nil) (scan!)))
((= ch ":") ((= ch ":")
(let ((start pos)) (let
((start pos))
(begin (begin
(advance!) (advance!)
(if (and (< pos src-len) (apl-alpha? (cur-byte))) (if
(and (< pos src-len) (apl-alpha? (cur-byte)))
(begin (begin
(read-ident-cont!) (read-ident-cont!)
(tok-push! :keyword (slice source start pos))) (tok-push! :keyword (slice source start pos)))
(tok-push! :colon nil)) (tok-push! :colon nil))
(scan!)))) (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 (begin
(consume! "¯") (consume! "¯")
(let ((digits (read-digits! ""))) (let
(if (and (< pos src-len) (= (cur-byte) ".") ((digits (read-digits! "")))
(< (+ pos 1) src-len) (apl-digit? (nth source (+ pos 1)))) (if
(begin (advance!) (and
(let ((frac (read-digits! ""))) (< pos src-len)
(tok-push! :num (- 0 (string->number (str digits "." frac)))))) (= (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))))) (tok-push! :num (- 0 (parse-int digits 0)))))
(scan!))) (scan!)))
((apl-digit? ch) ((apl-digit? ch)
(begin (begin
(let ((digits (read-digits! ""))) (let
(if (and (< pos src-len) (= (cur-byte) ".") ((digits (read-digits! "")))
(< (+ pos 1) src-len) (apl-digit? (nth source (+ pos 1)))) (if
(begin (advance!) (and
(let ((frac (read-digits! ""))) (< pos src-len)
(tok-push! :num (string->number (str digits "." frac))))) (= (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)))) (tok-push! :num (parse-int digits 0))))
(scan!))) (scan!)))
((= ch "'") ((= ch "'")
(begin (begin
(advance!) (advance!)
(let ((s (read-string! ""))) (let ((s (read-string! ""))) (tok-push! :str s))
(tok-push! :str s))
(scan!))) (scan!)))
((or (apl-alpha? ch) (cur-sw? "⎕")) ((or (apl-alpha? ch) (cur-sw? "⎕"))
(let ((start pos)) (let
((start pos))
(begin (begin
(if (cur-sw? "⎕") (consume! "⎕") (advance!)) (if
(if (and (< pos src-len) (cur-sw? "←")) (cur-sw? "⎕")
(begin
(consume! "⎕")
(if
(and (< pos src-len) (cur-sw? "←"))
(consume! "←") (consume! "←")
(read-ident-cont!)) (read-ident-cont!)))
(begin (advance!) (read-ident-cont!)))
(tok-push! :name (slice source start pos)) (tok-push! :name (slice source start pos))
(scan!)))) (scan!))))
(true (true
(let ((g (find-glyph))) (let
(if g ((g (find-glyph)))
(if
g
(begin (consume! g) (tok-push! :glyph g) (scan!)) (begin (consume! g) (tok-push! :glyph g) (scan!))
(begin (advance!) (scan!)))))))))) (begin (advance!) (scan!))))))))))
(scan!) (scan!)
tokens))) tokens)))

View File

@@ -46,6 +46,9 @@
((= g "⍕") apl-quad-fmt) ((= g "⍕") apl-quad-fmt)
((= g "⎕FMT") apl-quad-fmt) ((= g "⎕FMT") apl-quad-fmt)
((= g "⎕←") apl-quad-print) ((= g "⎕←") apl-quad-print)
((= g "⍸") apl-where)
((= g "") apl-unique)
((= g "⍎") apl-execute)
(else (error "no monadic fn for glyph"))))) (else (error "no monadic fn for glyph")))))
(define (define
@@ -90,6 +93,12 @@
((= g "⍉") apl-transpose-dyadic) ((= g "⍉") apl-transpose-dyadic)
((= g "⊢") (fn (a b) b)) ((= g "⊢") (fn (a b) b))
((= g "⊣") (fn (a b) a)) ((= 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"))))) (else (error "no dyadic fn for glyph")))))
(define (define
@@ -124,7 +133,14 @@
((vals (map (fn (n) (apl-eval-ast n env)) items))) ((vals (map (fn (n) (apl-eval-ast n env)) items)))
(make-array (make-array
(list (len vals)) (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) ((= tag :name)
(let (let
((nm (nth node 1))) ((nm (nth node 1)))
@@ -566,3 +582,11 @@
(define apl-run (fn (src) (apl-eval-ast (parse-apl src) {}))) (define apl-run (fn (src) (apl-eval-ast (parse-apl src) {})))
(define apl-run-file (fn (path) (apl-run (file-read path)))) (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))))

View File

@@ -227,6 +227,71 @@ Today they are documentation; we paraphrase the algorithms in
in the runtime — parser sees them as functions but eval errors; in the runtime — parser sees them as functions but eval errors;
next-phase work.)_ 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 ## SX primitive baseline
Use vectors for arrays; numeric tower + rationals for numbers; ADTs for tagged data; Use vectors for arrays; numeric tower + rationals for numbers; ADTs for tagged data;
@@ -241,6 +306,15 @@ data; format for string templating.
_Newest first._ _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 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 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 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
@@ -298,6 +372,10 @@ _Newest first._
## Blockers ## Blockers
- 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` - 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. 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. Loop paused at Phase 9 step 2 (inline assignment); resume once MCP restored.