From 36e151961364b2e1d0919aa4d476264d189d955c Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 23:35:14 +0000 Subject: [PATCH] apl: life.apl runs as-written (+5 e2e) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/apl/runtime.sx | 100 +++++++++++++++++++++++--------- lib/apl/tests/programs-e2e.sx | 34 +++++++++++ lib/apl/tests/programs/life.apl | 10 ++-- lib/apl/transpile.sx | 9 ++- plans/apl-on-sx.md | 3 +- 5 files changed, 122 insertions(+), 34 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index c020634c..19b935f3 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -65,10 +65,30 @@ (get a :shape) (map (fn (x) (f x sv)) (get a :ravel))))) (else - (if - (equal? (get a :shape) (get b :shape)) - (make-array (get a :shape) (map f (get a :ravel) (get b :ravel))) - (error "length error: shape mismatch")))))) + (let + ((a-shape (get a :shape)) (b-shape (get b :shape))) + (cond + ((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 @@ -1174,11 +1194,9 @@ (if (= n 0) (apl-scalar 0) - (apl-scalar - (reduce - (fn (a b) (disclose (f (apl-scalar a) (apl-scalar b)))) - (first ravel) - (rest ravel))))) + (let + ((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)))) + (if (= (type-of rr) "dict") rr (apl-scalar rr))))) (let ((last-dim (last shape)) (pre-shape (take shape (- (len shape) 1))) @@ -1200,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))))))))) @@ -1341,13 +1365,29 @@ (cond ((and (scalar? a) (scalar? b)) (apl-scalar (disclose (f a b)))) ((scalar? a) - (make-array - (get b :shape) - (map (fn (x) (disclose (f a (apl-scalar x)))) (get b :ravel)))) + (let + ((a-eff (let ((d (disclose a))) (if (= (type-of d) "dict") d a)))) + (make-array + (get b :shape) + (map + (fn + (x) + (let + ((r (f a-eff (apl-scalar x)))) + (if (scalar? r) (disclose r) r))) + (get b :ravel))))) ((scalar? b) - (make-array - (get a :shape) - (map (fn (x) (disclose (f (apl-scalar x) b))) (get a :ravel)))) + (let + ((b-eff (let ((d (disclose b))) (if (= (type-of d) "dict") d b)))) + (make-array + (get a :shape) + (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)) @@ -1368,16 +1408,22 @@ (b-shape (get b :shape)) (a-ravel (get a :ravel)) (b-ravel (get b :ravel))) - (make-array - (append a-shape b-shape) - (flatten - (map - (fn - (x) - (map - (fn (y) (disclose (f (apl-scalar x) (apl-scalar y)))) - b-ravel)) - a-ravel)))))) + (let + ((wrap (fn (x) (if (= (type-of x) "dict") x (apl-scalar x))))) + (make-array + (append a-shape b-shape) + (flatten + (map + (fn + (x) + (map + (fn + (y) + (let + ((r (f (wrap x) (wrap y)))) + (if (scalar? r) (disclose r) r))) + b-ravel)) + a-ravel))))))) (define apl-inner @@ -1411,7 +1457,7 @@ (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)))) + ((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) diff --git a/lib/apl/tests/programs-e2e.sx b/lib/apl/tests/programs-e2e.sx index 33ff6b29..db4f80bb 100644 --- a/lib/apl/tests/programs-e2e.sx +++ b/lib/apl/tests/programs-e2e.sx @@ -94,3 +94,37 @@ "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))) diff --git a/lib/apl/tests/programs/life.apl b/lib/apl/tests/programs/life.apl index b461d544..bfec11f8 100644 --- a/lib/apl/tests/programs/life.apl +++ b/lib/apl/tests/programs/life.apl @@ -1,16 +1,16 @@ ⍝ Conway's Game of Life — toroidal one-liner ⍝ -⍝ The classic Roger Hui formulation: -⍝ life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} +⍝ Roger Hui formulation (without leading ⊃, since our inner-product +⍝ already produces a clean 2D board from a heterogeneous strand): +⍝ life ← {1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⍝ ⍝ Read right-to-left: ⍝ ⊂⍵ : enclose the board (so it's a single scalar item) ⍝ ¯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 ⍝ ⍝ Rules in plain language: ⍝ - dead cell + 3 live neighbors → born @@ -19,4 +19,4 @@ ⍝ ⍝ Toroidal: edges wrap (rotate is cyclic). -life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} +life ← {1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 5207c646..0a542de5 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -133,7 +133,14 @@ ((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))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 79ae1fac..cc62457c 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -260,7 +260,7 @@ still need work to run as-written. Phase 10 closes both. 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`. -- [ ] **`life.apl` runs as-written** — Conway's life one-liner uses +- [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 @@ -288,6 +288,7 @@ data; format for string templating. _Newest first._ +- 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