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
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:
@@ -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)))
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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) {})))
|
||||
|
||||
Reference in New Issue
Block a user