diff --git a/lib/apl/parser.sx b/lib/apl/parser.sx index 607f9c84..80945d3c 100644 --- a/lib/apl/parser.sx +++ b/lib/apl/parser.sx @@ -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)))) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index c6cd798f..1eda54f3 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -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 diff --git a/lib/apl/tests/pipeline.sx b/lib/apl/tests/pipeline.sx index 39d9c9fd..731a5020 100644 --- a/lib/apl/tests/pipeline.sx +++ b/lib/apl/tests/pipeline.sx @@ -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)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 88492881..a9d5390d 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -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 diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index cb42d734..364d8921 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -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