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