apl: multi-axis bracket A[I;J] / A[I;] / A[;J] (+8 tests, 475/475)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s

Parser: split-bracket-content splits inner tokens on :semi at
depth 0; maybe-bracket emits (:bracket arr axis-exprs...) for
multi-axis access, with :all marker for empty axes.

Runtime: apl-bracket-multi enumerates index combinations via
apl-cartesian (helper) and produces sub-array. Scalar axes
collapse from result shape; vector / nil axes contribute their
length.

apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[2;2]"  → 5
apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"   → 1 2 3
apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[;2]"   → 2 5 8
apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]" → 2x2 sub-block
This commit is contained in:
2026-05-07 17:56:24 +00:00
parent b13819c50c
commit c04f38a1ba
5 changed files with 134 additions and 5 deletions

View File

@@ -594,6 +594,43 @@
(parse-stmt (first stmt-groups))
(cons :program (map parse-stmt stmt-groups)))))))))
(define
split-bracket-loop
(fn
(tokens current acc depth)
(if
(= (len tokens) 0)
(append acc (list current))
(let
((tok (first tokens)) (more (rest tokens)))
(let
((tt (tok-type tok)))
(cond
((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
(split-bracket-loop
more
(append current (list tok))
acc
(+ depth 1)))
((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
(split-bracket-loop
more
(append current (list tok))
acc
(- depth 1)))
((and (= tt :semi) (= depth 0))
(split-bracket-loop
more
(list)
(append acc (list current))
depth))
(else
(split-bracket-loop more (append current (list tok)) acc depth))))))))
(define
split-bracket-content
(fn (tokens) (split-bracket-loop tokens (list) (list) 0)))
(define
maybe-bracket
(fn
@@ -608,8 +645,17 @@
((inner-tokens (slice tokens (+ after 1) end))
(next-after (+ end 1)))
(let
((idx-expr (parse-apl-expr inner-tokens)))
(let
((indexed (list :dyad (list :fn-glyph "⌷") idx-expr val-node)))
(maybe-bracket indexed tokens next-after)))))
((sections (split-bracket-content inner-tokens)))
(if
(= (len sections) 1)
(let
((idx-expr (parse-apl-expr inner-tokens)))
(let
((indexed (list :dyad (list :fn-glyph "⌷") idx-expr val-node)))
(maybe-bracket indexed tokens next-after)))
(let
((axis-exprs (map (fn (toks) (if (= (len toks) 0) :all (parse-apl-expr toks))) sections)))
(let
((indexed (cons :bracket (cons val-node axis-exprs))))
(maybe-bracket indexed tokens next-after)))))))
(list val-node after))))

View File

@@ -985,6 +985,38 @@
(some (fn (c) (= c 0)) codes)
(some (fn (c) (= c (nth e 1))) codes)))))
(define
apl-cartesian
(fn
(lists)
(if
(= (len lists) 0)
(list (list))
(let
((rest-prods (apl-cartesian (rest lists))))
(reduce
(fn (acc x) (append acc (map (fn (p) (cons x p)) rest-prods)))
(list)
(first lists))))))
(define
apl-bracket-multi
(fn
(axes arr)
(let
((shape (get arr :shape)) (ravel (get arr :ravel)))
(let
((rank (len shape)) (strides (apl-strides shape)))
(let
((axis-info (map (fn (i) (let ((a (nth axes i))) (cond ((= a nil) {:idxs (range 0 (nth shape i)) :scalar? false}) ((= (len (get a :shape)) 0) {:idxs (list (- (first (get a :ravel)) apl-io)) :scalar? true}) (else {:idxs (map (fn (x) (- x apl-io)) (get a :ravel)) :scalar? false})))) (range 0 rank))))
(let
((cells (apl-cartesian (map (fn (a) (get a :idxs)) axis-info))))
(let
((result-ravel (map (fn (cell) (let ((flat (reduce + 0 (map (fn (i) (* (nth cell i) (nth strides i))) (range 0 rank))))) (nth ravel flat))) cells)))
(let
((result-shape (filter (fn (x) (>= x 0)) (map (fn (i) (let ((a (nth axis-info i))) (if (get a :scalar?) -1 (len (get a :idxs))))) (range 0 rank)))))
(make-array result-shape result-ravel)))))))))
(define
apl-reduce
(fn

View File

@@ -242,3 +242,43 @@
"named-fn with vector arg: neg ← {-⍵} ⋄ neg 1 2 3"
(mkrv (apl-run "neg ← {-⍵} ⋄ neg 1 2 3"))
(list -1 -2 -3))
(apl-test
"multi-axis: M[2;2] → center"
(mkrv (apl-run "M ← (3 3) 9 ⋄ M[2;2]"))
(list 5))
(apl-test
"multi-axis: M[1;] → first row"
(mkrv (apl-run "M ← (3 3) 9 ⋄ M[1;]"))
(list 1 2 3))
(apl-test
"multi-axis: M[;2] → second column"
(mkrv (apl-run "M ← (3 3) 9 ⋄ M[;2]"))
(list 2 5 8))
(apl-test
"multi-axis: M[1 2;1 2] → 2x2 block"
(mkrv (apl-run "M ← (2 3) 6 ⋄ M[1 2;1 2]"))
(list 1 2 4 5))
(apl-test
"multi-axis: M[1 2;1 2] shape (2 2)"
(mksh (apl-run "M ← (2 3) 6 ⋄ M[1 2;1 2]"))
(list 2 2))
(apl-test
"multi-axis: M[;] full matrix"
(mkrv (apl-run "M ← (2 2) 10 20 30 40 ⋄ M[;]"))
(list 10 20 30 40))
(apl-test
"multi-axis: M[1;] shape collapsed"
(mksh (apl-run "M ← (3 3) 9 ⋄ M[1;]"))
(list 3))
(apl-test
"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))

View File

@@ -149,6 +149,16 @@
(apl-eval-ast rhs env)))))
((= tag :program) (apl-eval-stmts (rest node) env))
((= tag :dfn) node)
((= tag :bracket)
(let
((arr-expr (nth node 1)) (axis-exprs (rest (rest node))))
(let
((arr (apl-eval-ast arr-expr env))
(axes
(map
(fn (a) (if (= a :all) nil (apl-eval-ast a env)))
axis-exprs)))
(apl-bracket-multi axes arr))))
(else (error (list "apl-eval-ast: unknown node tag" tag node)))))))
(define

View File

@@ -154,7 +154,7 @@ programs run from source, and starts pushing on performance.
- parser: a name in fn-position whose env value is a dfn dispatches as a fn;
- resolver: extend `apl-resolve-monadic`/`-dyadic` with a `:fn-name` case
that calls `apl-call-dfn`/`apl-call-dfn-m`.
- [ ] **Multi-axis bracket indexing**`A[I;J]` and `A[;J]` and `A[I;]`.
- [x] **Multi-axis bracket indexing**`A[I;J]` and `A[;J]` and `A[I;]`.
- parser: split bracket content on `:semi` at depth 0; emit
`(:dyad ⌷ (:vec I J) A)`;
- runtime: extend `apl-squad` to accept a vector of indices, treating
@@ -186,6 +186,7 @@ data; format for string templating.
_Newest first._
- 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
- 2026-05-07: Phase 8 step 1 — quick-wins bundle: decimal literals (3.7, ¯2.5), ⎕← passthrough as monadic fn (single-token via tokenizer special-case), :str AST in eval-ast (single-char→scalar, multi-char→vec); +10 tests; 460/460
- 2026-05-07: Phase 8 added — quick-wins bundle (decimals + ⎕← + strings), named functions, multi-axis bracket, .apl-files-as-tests, trains, perf