From b661318a4580105a5f8559124ff7d46023a59022 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 19:02:17 +0000 Subject: [PATCH] apl: train/fork notation (f g h) and (g h) (+6 tests, 496/496) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Parser: when a parenthesised subexpression contains only function segments (>= 2), collect-segments-loop now emits a :train AST node instead of treating it as a value-producing expression. Resolver: apl-resolve-{monadic,dyadic} handle :train. - monadic 2-train (atop): (g h)⍵ = g (h ⍵) - monadic 3-train (fork): (f g h)⍵ = (f ⍵) g (h ⍵) - dyadic 2-train: ⍺(g h)⍵ = g (⍺ h ⍵) - dyadic 3-train: ⍺(f g h)⍵ = (⍺ f ⍵) g (⍺ h ⍵) apl-run "(+/÷≢) 1 2 3 4 5" → 3 (mean) apl-run "(- ⌊) 5" → -5 (atop) apl-run "2 (+ × -) 5" → -21 (dyadic fork) apl-run "(⌈/-⌊/) 3 1 4 …" → 8 (range) --- lib/apl/parser.sx | 22 +++++++++++++++++----- lib/apl/tests/pipeline.sx | 30 ++++++++++++++++++++++++++++++ lib/apl/transpile.sx | 36 ++++++++++++++++++++++++++++++++++++ plans/apl-on-sx.md | 3 ++- 4 files changed, 85 insertions(+), 6 deletions(-) diff --git a/lib/apl/parser.sx b/lib/apl/parser.sx index ee49f14b..43e2f50f 100644 --- a/lib/apl/parser.sx +++ b/lib/apl/parser.sx @@ -308,11 +308,23 @@ ((inner-tokens (slice tokens (+ i 1) end)) (after (+ end 1))) (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)})))))) + ((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)})))))))) ((= tt :lbrace) (let ((end (find-matching-close tokens (+ i 1) :lbrace :rbrace))) diff --git a/lib/apl/tests/pipeline.sx b/lib/apl/tests/pipeline.sx index 731a5020..3ec999ea 100644 --- a/lib/apl/tests/pipeline.sx +++ b/lib/apl/tests/pipeline.sx @@ -282,3 +282,33 @@ "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)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index a9d5390d..f0771138 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -451,6 +451,24 @@ (= (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 @@ -499,6 +517,24 @@ ((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) {}))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index c156fc64..55ca61c1 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -169,7 +169,7 @@ programs run from source, and starts pushing on performance. 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.)_ -- [ ] **Train/fork notation** — `(f g h) ⍵ ↔ (f ⍵) g (h ⍵)` (3-train); +- [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 (`+/÷≢`). @@ -191,6 +191,7 @@ data; format for string templating. _Newest first._ +- 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