apl: train/fork notation (f g h) and (g h) (+6 tests, 496/496)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s

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)
This commit is contained in:
2026-05-07 19:02:17 +00:00
parent a677585639
commit b661318a45
4 changed files with 85 additions and 6 deletions

View File

@@ -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)))

View File

@@ -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))

View File

@@ -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) {})))