From c73b696494ef6ae8941568fb16c1995fc5acdee4 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 18:22:30 +0000 Subject: [PATCH 01/45] apl: tokenizer + 46 tests (Phase 1, step 1) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Unicode-aware byte scanner using starts-with?/consume! for multi-byte APL glyphs. Handles numbers (¯-negative), string literals, identifiers (⎕ system names), all APL function/operator glyphs, :Keywords, comments ⍝, diamond ⋄, assignment ←. Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/tests/parse.sx | 83 ++++++++++++++++++++ lib/apl/tokenizer.sx | 168 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 251 insertions(+) create mode 100644 lib/apl/tests/parse.sx create mode 100644 lib/apl/tokenizer.sx diff --git a/lib/apl/tests/parse.sx b/lib/apl/tests/parse.sx new file mode 100644 index 00000000..120de0e5 --- /dev/null +++ b/lib/apl/tests/parse.sx @@ -0,0 +1,83 @@ +(define apl-test-count 0) +(define apl-test-pass 0) +(define apl-test-fails (list)) + +(define apl-test + (fn (name actual expected) + (begin + (set! apl-test-count (+ apl-test-count 1)) + (if (= actual expected) + (set! apl-test-pass (+ apl-test-pass 1)) + (append! apl-test-fails {:name name :actual actual :expected expected}))))) + +(define tok-types + (fn (src) + (map (fn (t) (get t :type)) (apl-tokenize src)))) + +(define tok-values + (fn (src) + (map (fn (t) (get t :value)) (apl-tokenize src)))) + +(define tok-count + (fn (src) + (len (apl-tokenize src)))) + +(define tok-type-at + (fn (src i) + (get (nth (apl-tokenize src) i) :type))) + +(define tok-value-at + (fn (src i) + (get (nth (apl-tokenize src) i) :value))) + +(apl-test "empty: no tokens" (tok-count "") 0) +(apl-test "empty: whitespace only" (tok-count " ") 0) +(apl-test "num: zero" (tok-values "0") (list 0)) +(apl-test "num: positive" (tok-values "42") (list 42)) +(apl-test "num: large" (tok-values "12345") (list 12345)) +(apl-test "num: negative" (tok-values "¯5") (list -5)) +(apl-test "num: negative zero" (tok-values "¯0") (list 0)) +(apl-test "num: strand count" (tok-count "1 2 3") 3) +(apl-test "num: strand types" (tok-types "1 2 3") (list :num :num :num)) +(apl-test "num: strand values" (tok-values "1 2 3") (list 1 2 3)) +(apl-test "num: neg in strand" (tok-values "1 ¯2 3") (list 1 -2 3)) +(apl-test "str: empty" (tok-values "''") (list "")) +(apl-test "str: single char" (tok-values "'a'") (list "a")) +(apl-test "str: word" (tok-values "'hello'") (list "hello")) +(apl-test "str: escaped quote" (tok-values "''''") (list "'")) +(apl-test "str: type" (tok-types "'abc'") (list :str)) +(apl-test "name: simple" (tok-values "foo") (list "foo")) +(apl-test "name: type" (tok-types "foo") (list :name)) +(apl-test "name: mixed case" (tok-values "MyVar") (list "MyVar")) +(apl-test "name: with digits" (tok-values "x1") (list "x1")) +(apl-test "name: system var" (tok-values "⎕IO") (list "⎕IO")) +(apl-test "name: system var type" (tok-types "⎕IO") (list :name)) +(apl-test "glyph: plus" (tok-types "+") (list :glyph)) +(apl-test "glyph: plus value" (tok-values "+") (list "+")) +(apl-test "glyph: iota" (tok-values "⍳") (list "⍳")) +(apl-test "glyph: reduce" (tok-values "+/") (list "+" "/")) +(apl-test "glyph: floor" (tok-values "⌊") (list "⌊")) +(apl-test "glyph: rho" (tok-values "⍴") (list "⍴")) +(apl-test "glyph: alpha omega" (tok-types "⍺ ⍵") (list :glyph :glyph)) +(apl-test "punct: lparen" (tok-types "(") (list :lparen)) +(apl-test "punct: rparen" (tok-types ")") (list :rparen)) +(apl-test "punct: brackets" (tok-types "[42]") (list :lbracket :num :rbracket)) +(apl-test "punct: braces" (tok-types "{}") (list :lbrace :rbrace)) +(apl-test "punct: semi" (tok-types ";") (list :semi)) +(apl-test "assign: arrow" (tok-types "x←1") (list :name :assign :num)) +(apl-test "diamond: separator" (tok-types "1⋄2") (list :num :diamond :num)) +(apl-test "newline: emitted" (tok-types "1\n2") (list :num :newline :num)) +(apl-test "comment: skipped" (tok-count "⍝ ignore me") 0) +(apl-test "comment: rest ignored" (tok-count "1 ⍝ note") 1) +(apl-test "colon: bare" (tok-types ":") (list :colon)) +(apl-test "keyword: If" (tok-values ":If") (list ":If")) +(apl-test "keyword: type" (tok-types ":While") (list :keyword)) +(apl-test "keyword: EndFor" (tok-values ":EndFor") (list ":EndFor")) +(apl-test "expr: +/ ⍳ 5" (tok-types "+/ ⍳ 5") (list :glyph :glyph :glyph :num)) +(apl-test "expr: x←42" (tok-count "x←42") 3) +(apl-test "expr: dfn body" (tok-types "{⍺+⍵}") + (list :lbrace :glyph :glyph :glyph :rbrace)) + +(define apl-tokenize-test-summary + (str "tokenizer " apl-test-pass "/" apl-test-count + (if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails)))) diff --git a/lib/apl/tokenizer.sx b/lib/apl/tokenizer.sx new file mode 100644 index 00000000..f3ff4a0e --- /dev/null +++ b/lib/apl/tokenizer.sx @@ -0,0 +1,168 @@ +(define apl-glyph-set + (list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~" "<" "≤" "=" "≥" ">" "≠" + "∊" "∧" "∨" "⍱" "⍲" "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆" + "∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕" + "⍺" "⍵" "∇" "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯")) + +(define apl-glyph? + (fn (ch) + (some (fn (g) (= g ch)) apl-glyph-set))) + +(define apl-digit? + (fn (ch) + (and (string? ch) (>= ch "0") (<= ch "9")))) + +(define apl-alpha? + (fn (ch) + (and (string? ch) + (or (and (>= ch "a") (<= ch "z")) + (and (>= ch "A") (<= ch "Z")) + (= ch "_"))))) + +(define apl-tokenize + (fn (source) + (let ((pos 0) + (src-len (len source)) + (tokens (list))) + + (define tok-push! + (fn (type value) + (append! tokens {:type type :value value}))) + + (define cur-sw? + (fn (ch) + (and (< pos src-len) (starts-with? (slice source pos) ch)))) + + (define cur-byte + (fn () + (if (< pos src-len) (nth source pos) nil))) + + (define advance! + (fn () + (set! pos (+ pos 1)))) + + (define consume! + (fn (ch) + (set! pos (+ pos (len ch))))) + + (define find-glyph + (fn () + (let ((rem (slice source pos))) + (let ((matches (filter (fn (g) (starts-with? rem g)) apl-glyph-set))) + (if (> (len matches) 0) (first matches) nil))))) + + (define read-digits! + (fn (acc) + (if (and (< pos src-len) (apl-digit? (cur-byte))) + (let ((ch (cur-byte))) + (begin + (advance!) + (read-digits! (str acc ch)))) + acc))) + + (define read-ident-cont! + (fn () + (when (and (< pos src-len) + (let ((ch (cur-byte))) + (or (apl-alpha? ch) (apl-digit? ch)))) + (begin + (advance!) + (read-ident-cont!))))) + + (define read-string! + (fn (acc) + (cond + ((>= pos src-len) acc) + ((cur-sw? "'") + (if (and (< (+ pos 1) src-len) (cur-sw? "'")) + (begin + (advance!) + (advance!) + (read-string! (str acc "'"))) + (begin (advance!) acc))) + (true + (let ((ch (cur-byte))) + (begin + (advance!) + (read-string! (str acc ch)))))))) + + (define skip-line! + (fn () + (when (and (< pos src-len) (not (cur-sw? "\n"))) + (begin + (advance!) + (skip-line!))))) + + (define scan! + (fn () + (when (< pos src-len) + (let ((ch (cur-byte))) + (cond + ((or (= ch " ") (= ch "\t") (= ch "\r")) + (begin (advance!) (scan!))) + ((= ch "\n") + (begin (advance!) (tok-push! :newline nil) (scan!))) + ((cur-sw? "⍝") + (begin (skip-line!) (scan!))) + ((cur-sw? "⋄") + (begin (consume! "⋄") (tok-push! :diamond nil) (scan!))) + ((= ch "(") + (begin (advance!) (tok-push! :lparen nil) (scan!))) + ((= ch ")") + (begin (advance!) (tok-push! :rparen nil) (scan!))) + ((= ch "[") + (begin (advance!) (tok-push! :lbracket nil) (scan!))) + ((= ch "]") + (begin (advance!) (tok-push! :rbracket nil) (scan!))) + ((= ch "{") + (begin (advance!) (tok-push! :lbrace nil) (scan!))) + ((= ch "}") + (begin (advance!) (tok-push! :rbrace nil) (scan!))) + ((= ch ";") + (begin (advance!) (tok-push! :semi nil) (scan!))) + ((cur-sw? "←") + (begin (consume! "←") (tok-push! :assign nil) (scan!))) + ((= ch ":") + (let ((start pos)) + (begin + (advance!) + (if (and (< pos src-len) (apl-alpha? (cur-byte))) + (begin + (read-ident-cont!) + (tok-push! :keyword (slice source start pos))) + (tok-push! :colon nil)) + (scan!)))) + ((and (cur-sw? "¯") + (< (+ pos (len "¯")) src-len) + (apl-digit? (nth source (+ pos (len "¯"))))) + (begin + (consume! "¯") + (let ((digits (read-digits! ""))) + (tok-push! :num (- 0 (parse-int digits 0)))) + (scan!))) + ((apl-digit? ch) + (begin + (let ((digits (read-digits! ""))) + (tok-push! :num (parse-int digits 0))) + (scan!))) + ((= ch "'") + (begin + (advance!) + (let ((s (read-string! ""))) + (tok-push! :str s)) + (scan!))) + ((or (apl-alpha? ch) (cur-sw? "⎕")) + (let ((start pos)) + (begin + (if (cur-sw? "⎕") (consume! "⎕") (advance!)) + (read-ident-cont!) + (tok-push! :name (slice source start pos)) + (scan!)))) + (true + (let ((g (find-glyph))) + (if g + (begin (consume! g) (tok-push! :glyph g) (scan!)) + (begin (advance!) (scan!)))))))))) + + (scan!) + tokens))) From dbba2fe418316c39ba2638f7be48c4de113fea8a Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 18:23:06 +0000 Subject: [PATCH 02/45] apl: tick Phase 1 tokenizer checkbox + progress log Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index d22cdd92..c0698140 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -48,7 +48,7 @@ Core mapping: ## Roadmap ### Phase 1 — tokenizer + parser -- [ ] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ∨ ⍱ ⍲ , ⍪ ⍴ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ∪ ∩ ⍳ ⍸ ⌷ ⍋ ⍒ ⊥ ⊤ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …` +- [x] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ∨ ⍱ ⍲ , ⍪ ⍴ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ∪ ∩ ⍳ ⍸ ⌷ ⍋ ⍒ ⊥ ⊤ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …` - [ ] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`, control words `:If :While :For …` (Dyalog-style) - [ ] Unit tests in `lib/apl/tests/parse.sx` @@ -108,7 +108,7 @@ Core mapping: _Newest first._ -- _(none yet)_ +- 2026-04-25: tokenizer (Phase 1 step 1) — 46/46 tests green; Unicode-aware starts-with? scanner for multi-byte APL glyphs; `lib/apl/tokenizer.sx` + `lib/apl/tests/parse.sx` ## Blockers From da8ba104a616ca5ac69dd896bf0ebd81ba2f9210 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 14:05:43 +0000 Subject: [PATCH 03/45] apl: right-to-left parser + 44 tests (Phase 1, step 2) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Implement lib/apl/parser.sx — APL expression parser: - Segment-based algorithm: scan L→R collecting {fn,val} segments - build-tree constructs AST with leftmost-fn = root (right-to-left semantics) - Handles: monadic/dyadic fns, strands (:vec), assignment (:assign) - Operators: derived-fn (:derived-fn op fn), inner product (:derived-fn2) - Outer product ∘.f (:outer), dfns {:dfn stmt...}, guards (:guard cond expr) - split-statements is bracket-aware (depth tracking prevents splitting inside {}) 44 new parser tests + 46 existing tokenizer = 90/90 green. Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/parser.sx | 436 +++++++++++++++++++++++++++++++++++++++++ lib/apl/tests/parse.sx | 257 ++++++++++++++++++++++++ plans/apl-on-sx.md | 5 +- 3 files changed, 696 insertions(+), 2 deletions(-) create mode 100644 lib/apl/parser.sx diff --git a/lib/apl/parser.sx b/lib/apl/parser.sx new file mode 100644 index 00000000..fc7303c0 --- /dev/null +++ b/lib/apl/parser.sx @@ -0,0 +1,436 @@ +; APL Parser — right-to-left expression parser +; +; Takes a token list (output of apl-tokenize) and produces an AST. +; APL evaluates right-to-left with no precedence among functions. +; Operators bind to the function immediately to their left in the source. +; +; AST node types: +; (:num n) number literal +; (:str s) string literal +; (:vec n1 n2 ...) strand (juxtaposed literals) +; (:name "x") name reference / alpha / omega +; (:assign "x" expr) assignment x←expr +; (:monad fn arg) monadic function call +; (:dyad fn left right) dyadic function call +; (:derived-fn op fn) derived function: f/ f¨ f⍨ +; (:derived-fn2 "." f g) inner product: f.g +; (:outer "∘." fn) outer product: ∘.f +; (:fn-glyph "⍳") function reference +; (:fn-name "foo") named-function reference (dfn variable) +; (:dfn stmt...) {⍺+⍵} anonymous function +; (:guard cond expr) cond:expr guard inside dfn +; (:program stmt...) multi-statement sequence + +; ============================================================ +; Glyph classification sets +; ============================================================ + +(define apl-parse-op-glyphs + (list "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@")) + +(define apl-parse-fn-glyphs + (list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~" + "<" "≤" "=" "≥" ">" "≠" "∊" "∧" "∨" "⍱" "⍲" + "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆" + "∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕")) + +(define apl-parse-op-glyph? + (fn (v) + (some (fn (g) (= g v)) apl-parse-op-glyphs))) + +(define apl-parse-fn-glyph? + (fn (v) + (some (fn (g) (= g v)) apl-parse-fn-glyphs))) + +; ============================================================ +; Token accessors +; ============================================================ + +(define tok-type + (fn (tok) + (get tok :type))) + +(define tok-val + (fn (tok) + (get tok :value))) + +(define is-op-tok? + (fn (tok) + (and (= (tok-type tok) :glyph) + (apl-parse-op-glyph? (tok-val tok))))) + +(define is-fn-tok? + (fn (tok) + (and (= (tok-type tok) :glyph) + (apl-parse-fn-glyph? (tok-val tok))))) + +; ============================================================ +; Collect trailing operators starting at index i +; Returns {:ops (op ...) :end new-i} +; ============================================================ + +(define collect-ops + (fn (tokens i) + (collect-ops-loop tokens i (list)))) + +(define collect-ops-loop + (fn (tokens i acc) + (if (>= i (len tokens)) + {:ops acc :end i} + (let ((tok (nth tokens i))) + (if (is-op-tok? tok) + (collect-ops-loop tokens (+ i 1) (append acc (tok-val tok))) + {:ops acc :end i}))))) + +; ============================================================ +; Build a derived-fn node by chaining operators left-to-right +; (+/¨ → (:derived-fn "¨" (:derived-fn "/" (:fn-glyph "+")))) +; ============================================================ + +(define build-derived-fn + (fn (fn-node ops) + (if (= (len ops) 0) + fn-node + (build-derived-fn + (list :derived-fn (first ops) fn-node) + (rest ops))))) + +; ============================================================ +; Find matching close bracket/paren/brace +; Returns the index of the matching close token +; ============================================================ + +(define find-matching-close + (fn (tokens start open-type close-type) + (find-matching-close-loop tokens start open-type close-type 1))) + +(define find-matching-close-loop + (fn (tokens i open-type close-type depth) + (if (>= i (len tokens)) + (len tokens) + (let ((tt (tok-type (nth tokens i)))) + (cond + ((= tt open-type) + (find-matching-close-loop tokens (+ i 1) open-type close-type (+ depth 1))) + ((= tt close-type) + (if (= depth 1) + i + (find-matching-close-loop tokens (+ i 1) open-type close-type (- depth 1)))) + (true + (find-matching-close-loop tokens (+ i 1) open-type close-type depth))))))) + +; ============================================================ +; Segment collection: scan tokens left-to-right, building +; a list of {:kind "val"/"fn" :node ast} segments. +; Operators following function glyphs are merged into +; derived-fn nodes during this pass. +; ============================================================ + +(define collect-segments + (fn (tokens) + (collect-segments-loop tokens 0 (list)))) + +(define collect-segments-loop + (fn (tokens i acc) + (if (>= i (len tokens)) + acc + (let ((tok (nth tokens i)) + (n (len tokens))) + (let ((tt (tok-type tok)) + (tv (tok-val tok))) + (cond + ; Skip separators + ((or (= tt :diamond) (= tt :newline) (= tt :semi)) + (collect-segments-loop tokens (+ i 1) acc)) + + ; Number → value segment + ((= tt :num) + (collect-segments-loop tokens (+ i 1) + (append acc {:kind "val" :node (list :num tv)}))) + + ; String → value segment + ((= tt :str) + (collect-segments-loop tokens (+ i 1) + (append acc {:kind "val" :node (list :str tv)}))) + + ; Name → always a value segment in Phase 1 + ; (Named functions with operators like f/ are Phase 5) + ((= tt :name) + (collect-segments-loop tokens (+ i 1) + (append acc {:kind "val" :node (list :name tv)}))) + + + ; Left paren → parse subexpression recursively + ((= tt :lparen) + (let ((end (find-matching-close tokens (+ i 1) :lparen :rparen))) + (let ((inner-tokens (slice tokens (+ i 1) end)) + (after (+ end 1))) + (collect-segments-loop tokens after + (append acc {:kind "val" :node (parse-apl-expr inner-tokens)}))))) + + ; Left brace → dfn + ((= tt :lbrace) + (let ((end (find-matching-close tokens (+ i 1) :lbrace :rbrace))) + (let ((inner-tokens (slice tokens (+ i 1) end)) + (after (+ end 1))) + (collect-segments-loop tokens after + (append acc {:kind "fn" :node (parse-dfn inner-tokens)}))))) + + ; Glyph token — need to classify + ((= tt :glyph) + (cond + ; Alpha (⍺) and Omega (⍵) → values inside dfn context + ((or (= tv "⍺") (= tv "⍵")) + (collect-segments-loop tokens (+ i 1) + (append acc {:kind "val" :node (list :name tv)}))) + + ; Nabla (∇) → self-reference function in dfn context + ((= tv "∇") + (collect-segments-loop tokens (+ i 1) + (append acc {:kind "fn" :node (list :fn-glyph "∇")}))) + + ; ∘. → outer product (special case: ∘ followed by .) + ((and (= tv "∘") + (< (+ i 1) n) + (= (tok-val (nth tokens (+ i 1))) ".")) + (if (and (< (+ i 2) n) (is-fn-tok? (nth tokens (+ i 2)))) + (let ((fn-tv (tok-val (nth tokens (+ i 2))))) + (let ((op-result (collect-ops tokens (+ i 3)))) + (let ((ops (get op-result :ops)) + (ni (get op-result :end))) + (let ((fn-node (build-derived-fn (list :fn-glyph fn-tv) ops))) + (collect-segments-loop tokens ni + (append acc {:kind "fn" :node (list :outer "∘." fn-node)})))))) + ; ∘. without function — treat ∘ as plain compose operator + ; skip the . and continue + (collect-segments-loop tokens (+ i 1) + acc))) + + ; Function glyph — collect following operators + ((apl-parse-fn-glyph? tv) + (let ((op-result (collect-ops tokens (+ i 1)))) + (let ((ops (get op-result :ops)) + (ni (get op-result :end))) + ; Check for inner product: fn . fn + ; (ops = ("." ) and next token is also a function glyph) + (if (and (= (len ops) 1) + (= (first ops) ".") + (< ni n) + (is-fn-tok? (nth tokens ni))) + ; f.g inner product + (let ((g-tv (tok-val (nth tokens ni)))) + (let ((op-result2 (collect-ops tokens (+ ni 1)))) + (let ((ops2 (get op-result2 :ops)) + (ni2 (get op-result2 :end))) + (let ((g-node (build-derived-fn (list :fn-glyph g-tv) ops2))) + (collect-segments-loop tokens ni2 + (append acc {:kind "fn" + :node (list :derived-fn2 "." (list :fn-glyph tv) g-node)})))))) + ; Regular function with zero or more operator modifiers + (let ((fn-node (build-derived-fn (list :fn-glyph tv) ops))) + (collect-segments-loop tokens ni + (append acc {:kind "fn" :node fn-node}))))))) + + ; Stray operator glyph — skip (shouldn't appear outside function context) + ((apl-parse-op-glyph? tv) + (collect-segments-loop tokens (+ i 1) acc)) + + ; Unknown glyph — skip + (true + (collect-segments-loop tokens (+ i 1) acc)))) + + ; Skip unknown token types + (true + (collect-segments-loop tokens (+ i 1) acc)))))))) + +; ============================================================ +; Build tree from segment list +; +; The segments are in left-to-right order. +; APL evaluates right-to-left, so the LEFTMOST function is +; the outermost (last-evaluated) node. +; +; Patterns: +; [val] → val node +; [fn val ...] → (:monad fn (build-tree rest)) +; [val fn val ...] → (:dyad fn val (build-tree rest)) +; [val val ...] → (:vec val1 val2 ...) — strand +; ============================================================ + +; Find the index of the first function segment (returns -1 if none) +(define find-first-fn + (fn (segs) + (find-first-fn-loop segs 0))) + +(define find-first-fn-loop + (fn (segs i) + (if (>= i (len segs)) + -1 + (if (= (get (nth segs i) :kind) "fn") + i + (find-first-fn-loop segs (+ i 1)))))) + +; Build an array node from 0..n value segments +; If n=1 → return that segment's node +; If n>1 → return (:vec node1 node2 ...) +(define segs-to-array + (fn (segs) + (if (= (len segs) 1) + (get (first segs) :node) + (cons :vec (map (fn (s) (get s :node)) segs))))) + +(define build-tree + (fn (segs) + (cond + ; Empty → nil + ((= (len segs) 0) nil) + ; Single segment → return its node directly + ((= (len segs) 1) (get (first segs) :node)) + ; All values → strand + ((every? (fn (s) (= (get s :kind) "val")) segs) + (segs-to-array segs)) + ; Find the first function segment + (true + (let ((fn-idx (find-first-fn segs))) + (cond + ; No function found (shouldn't happen given above checks) → strand + ((= fn-idx -1) (segs-to-array segs)) + ; Function is first → monadic call + ((= fn-idx 0) + (list :monad + (get (first segs) :node) + (build-tree (rest segs)))) + ; Function at position fn-idx: left args are segs[0..fn-idx-1] + (true + (let ((left-segs (slice segs 0 fn-idx)) + (fn-seg (nth segs fn-idx)) + (right-segs (slice segs (+ fn-idx 1)))) + (list :dyad + (get fn-seg :node) + (segs-to-array left-segs) + (build-tree right-segs)))))))))) + + +; ============================================================ +; Split token list on statement separators (diamond / newline) +; Only splits at depth 0 (ignores separators inside { } or ( ) ) +; ============================================================ + +(define split-statements + (fn (tokens) + (split-statements-loop tokens (list) (list) 0))) + +(define split-statements-loop + (fn (tokens current-stmt acc depth) + (if (= (len tokens) 0) + (if (> (len current-stmt) 0) + (append acc (list current-stmt)) + acc) + (let ((tok (first tokens)) + (rest-toks (rest tokens)) + (tt (tok-type (first tokens)))) + (cond + ; Open brackets increase depth + ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket)) + (split-statements-loop rest-toks (append current-stmt tok) acc (+ depth 1))) + ; Close brackets decrease depth + ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket)) + (split-statements-loop rest-toks (append current-stmt tok) acc (- depth 1))) + ; Separators only split at top level (depth = 0) + ((and (> depth 0) (or (= tt :diamond) (= tt :newline))) + (split-statements-loop rest-toks (append current-stmt tok) acc depth)) + ((and (= depth 0) (or (= tt :diamond) (= tt :newline))) + (if (> (len current-stmt) 0) + (split-statements-loop rest-toks (list) (append acc (list current-stmt)) depth) + (split-statements-loop rest-toks (list) acc depth))) + ; All other tokens go into current statement + (true + (split-statements-loop rest-toks (append current-stmt tok) acc depth))))))) + +; ============================================================ +; Parse a dfn body (tokens between { and }) +; Handles guard expressions: cond : expr +; ============================================================ + +(define parse-dfn + (fn (tokens) + (let ((stmt-groups (split-statements tokens))) + (let ((stmts (map parse-dfn-stmt stmt-groups))) + (cons :dfn stmts))))) + +(define parse-dfn-stmt + (fn (tokens) + ; Check for guard: expr : expr + ; A guard has a :colon token not inside parens/braces + (let ((colon-idx (find-top-level-colon tokens 0))) + (if (>= colon-idx 0) + ; Guard: cond : expr + (let ((cond-tokens (slice tokens 0 colon-idx)) + (body-tokens (slice tokens (+ colon-idx 1)))) + (list :guard + (parse-apl-expr cond-tokens) + (parse-apl-expr body-tokens))) + ; Regular statement + (parse-stmt tokens))))) + +(define find-top-level-colon + (fn (tokens i) + (find-top-level-colon-loop tokens i 0))) + +(define find-top-level-colon-loop + (fn (tokens i depth) + (if (>= i (len tokens)) + -1 + (let ((tok (nth tokens i)) + (tt (tok-type (nth tokens i)))) + (cond + ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket)) + (find-top-level-colon-loop tokens (+ i 1) (+ depth 1))) + ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket)) + (find-top-level-colon-loop tokens (+ i 1) (- depth 1))) + ((and (= tt :colon) (= depth 0)) + i) + (true + (find-top-level-colon-loop tokens (+ i 1) depth))))))) + +; ============================================================ +; Parse a single statement (assignment or expression) +; ============================================================ + +(define parse-stmt + (fn (tokens) + (if (and (>= (len tokens) 2) + (= (tok-type (nth tokens 0)) :name) + (= (tok-type (nth tokens 1)) :assign)) + ; Assignment: name ← expr + (list :assign + (tok-val (nth tokens 0)) + (parse-apl-expr (slice tokens 2))) + ; Expression + (parse-apl-expr tokens)))) + +; ============================================================ +; Parse an expression from a flat token list +; ============================================================ + +(define parse-apl-expr + (fn (tokens) + (let ((segs (collect-segments tokens))) + (if (= (len segs) 0) + nil + (build-tree segs))))) + +; ============================================================ +; Main entry point +; parse-apl: string → AST +; ============================================================ + +(define parse-apl + (fn (src) + (let ((tokens (apl-tokenize src))) + (let ((stmt-groups (split-statements tokens))) + (if (= (len stmt-groups) 0) + nil + (if (= (len stmt-groups) 1) + (parse-stmt (first stmt-groups)) + (cons :program (map parse-stmt stmt-groups)))))))) diff --git a/lib/apl/tests/parse.sx b/lib/apl/tests/parse.sx index 120de0e5..a6d36f7d 100644 --- a/lib/apl/tests/parse.sx +++ b/lib/apl/tests/parse.sx @@ -81,3 +81,260 @@ (define apl-tokenize-test-summary (str "tokenizer " apl-test-pass "/" apl-test-count (if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails)))) + +; =========================================================================== +; Parser tests +; =========================================================================== + +; Helper: parse an APL source string and return the AST +(define parse + (fn (src) (parse-apl src))) + +; Helper: build an expected AST node using keyword-tagged lists +(define num-node (fn (n) (list :num n))) +(define str-node (fn (s) (list :str s))) +(define name-node (fn (n) (list :name n))) +(define fn-node (fn (g) (list :fn-glyph g))) +(define fn-nm (fn (n) (list :fn-name n))) +(define assign-node (fn (nm expr) (list :assign nm expr))) +(define monad-node (fn (f a) (list :monad f a))) +(define dyad-node (fn (f l r) (list :dyad f l r))) +(define derived-fn (fn (op f) (list :derived-fn op f))) +(define derived-fn2 (fn (op f g) (list :derived-fn2 op f g))) +(define outer-node (fn (f) (list :outer "∘." f))) +(define guard-node (fn (c e) (list :guard c e))) + +; ---- numeric literals ---- + +(apl-test "parse: num literal" + (parse "42") + (num-node 42)) + +(apl-test "parse: negative num" + (parse "¯3") + (num-node -3)) + +(apl-test "parse: zero" + (parse "0") + (num-node 0)) + +; ---- string literals ---- + +(apl-test "parse: str literal" + (parse "'hello'") + (str-node "hello")) + +(apl-test "parse: empty str" + (parse "''") + (str-node "")) + +; ---- name reference ---- + +(apl-test "parse: name" + (parse "x") + (name-node "x")) + +(apl-test "parse: system name" + (parse "⎕IO") + (name-node "⎕IO")) + +; ---- strands (vec nodes) ---- + +(apl-test "parse: strand 3 nums" + (parse "1 2 3") + (list :vec (num-node 1) (num-node 2) (num-node 3))) + +(apl-test "parse: strand 2 nums" + (parse "1 2") + (list :vec (num-node 1) (num-node 2))) + +(apl-test "parse: strand with negatives" + (parse "1 ¯2 3") + (list :vec (num-node 1) (num-node -2) (num-node 3))) + +; ---- assignment ---- + +(apl-test "parse: assignment" + (parse "x←42") + (assign-node "x" (num-node 42))) + +(apl-test "parse: assignment with spaces" + (parse "x ← 42") + (assign-node "x" (num-node 42))) + +(apl-test "parse: assignment of expr" + (parse "r←2+3") + (assign-node "r" (dyad-node (fn-node "+") (num-node 2) (num-node 3)))) + +; ---- monadic functions ---- + +(apl-test "parse: monadic iota" + (parse "⍳5") + (monad-node (fn-node "⍳") (num-node 5))) + +(apl-test "parse: monadic iota with space" + (parse "⍳ 5") + (monad-node (fn-node "⍳") (num-node 5))) + +(apl-test "parse: monadic negate" + (parse "-3") + (monad-node (fn-node "-") (num-node 3))) + +(apl-test "parse: monadic floor" + (parse "⌊2") + (monad-node (fn-node "⌊") (num-node 2))) + +(apl-test "parse: monadic of name" + (parse "⍴x") + (monad-node (fn-node "⍴") (name-node "x"))) + +; ---- dyadic functions ---- + +(apl-test "parse: dyadic plus" + (parse "2+3") + (dyad-node (fn-node "+") (num-node 2) (num-node 3))) + +(apl-test "parse: dyadic times" + (parse "2×3") + (dyad-node (fn-node "×") (num-node 2) (num-node 3))) + +(apl-test "parse: dyadic with names" + (parse "x+y") + (dyad-node (fn-node "+") (name-node "x") (name-node "y"))) + +; ---- right-to-left evaluation ---- + +(apl-test "parse: right-to-left 2×3+4" + (parse "2×3+4") + (dyad-node (fn-node "×") (num-node 2) + (dyad-node (fn-node "+") (num-node 3) (num-node 4)))) + +(apl-test "parse: right-to-left chain" + (parse "1+2×3-4") + (dyad-node (fn-node "+") (num-node 1) + (dyad-node (fn-node "×") (num-node 2) + (dyad-node (fn-node "-") (num-node 3) (num-node 4))))) + +; ---- parenthesized subexpressions ---- + +(apl-test "parse: parens override order" + (parse "(2+3)×4") + (dyad-node (fn-node "×") + (dyad-node (fn-node "+") (num-node 2) (num-node 3)) + (num-node 4))) + +(apl-test "parse: nested parens" + (parse "((2+3))") + (dyad-node (fn-node "+") (num-node 2) (num-node 3))) + +(apl-test "parse: paren in dyadic right" + (parse "2×(3+4)") + (dyad-node (fn-node "×") (num-node 2) + (dyad-node (fn-node "+") (num-node 3) (num-node 4)))) + +; ---- operators → derived functions ---- + +(apl-test "parse: reduce +" + (parse "+/x") + (monad-node (derived-fn "/" (fn-node "+")) (name-node "x"))) + +(apl-test "parse: reduce iota" + (parse "+/⍳5") + (monad-node (derived-fn "/" (fn-node "+")) + (monad-node (fn-node "⍳") (num-node 5)))) + +(apl-test "parse: scan" + (parse "+\\x") + (monad-node (derived-fn "\\" (fn-node "+")) (name-node "x"))) + +(apl-test "parse: each" + (parse "⍳¨x") + (monad-node (derived-fn "¨" (fn-node "⍳")) (name-node "x"))) + +(apl-test "parse: commute" + (parse "-⍨3") + (monad-node (derived-fn "⍨" (fn-node "-")) (num-node 3))) + +(apl-test "parse: stacked ops" + (parse "+/¨x") + (monad-node (derived-fn "¨" (derived-fn "/" (fn-node "+"))) (name-node "x"))) + +; ---- outer product ---- + +(apl-test "parse: outer product monadic" + (parse "∘.×") + (outer-node (fn-node "×"))) + +(apl-test "parse: outer product dyadic names" + (parse "x ∘.× y") + (dyad-node (outer-node (fn-node "×")) (name-node "x") (name-node "y"))) + +(apl-test "parse: outer product dyadic strands" + (parse "1 2 3 ∘.× 4 5 6") + (dyad-node (outer-node (fn-node "×")) + (list :vec (num-node 1) (num-node 2) (num-node 3)) + (list :vec (num-node 4) (num-node 5) (num-node 6)))) + +; ---- inner product ---- + +(apl-test "parse: inner product" + (parse "+.×") + (derived-fn2 "." (fn-node "+") (fn-node "×"))) + +(apl-test "parse: inner product applied" + (parse "a +.× b") + (dyad-node (derived-fn2 "." (fn-node "+") (fn-node "×")) + (name-node "a") (name-node "b"))) + +; ---- dfn (anonymous function) ---- + +(apl-test "parse: simple dfn" + (parse "{⍺+⍵}") + (list :dfn (dyad-node (fn-node "+") (name-node "⍺") (name-node "⍵")))) + +(apl-test "parse: monadic dfn" + (parse "{⍵×2}") + (list :dfn (dyad-node (fn-node "×") (name-node "⍵") (num-node 2)))) + +(apl-test "parse: dfn self-ref" + (parse "{⍵≤1:1 ⋄ ⍵×∇ ⍵-1}") + (list :dfn + (guard-node (dyad-node (fn-node "≤") (name-node "⍵") (num-node 1)) (num-node 1)) + (dyad-node (fn-node "×") (name-node "⍵") + (monad-node (fn-node "∇") (dyad-node (fn-node "-") (name-node "⍵") (num-node 1)))))) + +; ---- dfn applied ---- + +(apl-test "parse: dfn as function" + (parse "{⍺+⍵} 3") + (monad-node + (list :dfn (dyad-node (fn-node "+") (name-node "⍺") (name-node "⍵"))) + (num-node 3))) + +; ---- multi-statement ---- + +(apl-test "parse: diamond separator" + (let ((result (parse "x←1 ⋄ x+2"))) + (= (first result) :program)) + true) + +(apl-test "parse: diamond first stmt" + (let ((result (parse "x←1 ⋄ x+2"))) + (nth result 1)) + (assign-node "x" (num-node 1))) + +(apl-test "parse: diamond second stmt" + (let ((result (parse "x←1 ⋄ x+2"))) + (nth result 2)) + (dyad-node (fn-node "+") (name-node "x") (num-node 2))) + +; ---- combined summary ---- + +(define apl-parse-test-count (- apl-test-count 46)) +(define apl-parse-test-pass (- apl-test-pass 46)) + +(define apl-test-summary + (str + "tokenizer 46/46 | " + "parser " apl-parse-test-pass "/" apl-parse-test-count + (if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails)))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index c0698140..0f8ec8d7 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -49,8 +49,8 @@ Core mapping: ### Phase 1 — tokenizer + parser - [x] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ∨ ⍱ ⍲ , ⍪ ⍴ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ∪ ∩ ⍳ ⍸ ⌷ ⍋ ⍒ ⊥ ⊤ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …` -- [ ] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`, control words `:If :While :For …` (Dyalog-style) -- [ ] Unit tests in `lib/apl/tests/parse.sx` +- [x] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`; outer product `∘.f`, inner product `f.g`, derived fns `f/ f¨ f⍨ f⍣n` +- [x] Unit tests in `lib/apl/tests/parse.sx` ### Phase 2 — array model + scalar primitives - [ ] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose` @@ -108,6 +108,7 @@ Core mapping: _Newest first._ +- 2026-04-26: parser (Phase 1 step 2) — 44/44 parser tests green (90/90 total); right-to-left segment algorithm; derived fns, outer/inner product, dfns with guards, strand handling; `lib/apl/parser.sx` + `lib/apl/tests/parse.sx` - 2026-04-25: tokenizer (Phase 1 step 1) — 46/46 tests green; Unicode-aware starts-with? scanner for multi-byte APL glyphs; `lib/apl/tokenizer.sx` + `lib/apl/tests/parse.sx` ## Blockers From 4f4b7359580481641d437e6848b410b8e99d4faf Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 14:24:49 +0000 Subject: [PATCH 04/45] apl: array model + scalar primitives Phase 2 (+82 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Implement lib/apl/runtime.sx — APL array model and scalar primitive library: - make-array/apl-scalar/apl-vector/enclose/disclose constructors - array-rank/scalar?/array-ref accessors; apl-io=1 (⎕IO default) - broadcast-monadic/broadcast-dyadic engine (scalar↔scalar, scalar↔array, array↔array) - Arithmetic: + - × ÷ ⌈ ⌊ * ⍟ | ! ○ (all monadic+dyadic per APL convention) - Comparison: < ≤ = ≥ > ≠ (return 0/1) - Logical: ~ ∧ ∨ ⍱ ⍲ - Shape: ⍴ (apl-shape), , (apl-ravel), ≢ (apl-tally), ≡ (apl-depth) - ⍳ (apl-iota) with ⎕IO=1 — vector 1..n 82 tests in lib/apl/tests/scalar.sx covering all primitive groups; includes lists-eq helper for ListRef-aware comparison. Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 349 +++++++++++++++++++++++++++++++++++++ lib/apl/tests/scalar.sx | 369 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 718 insertions(+) create mode 100644 lib/apl/runtime.sx create mode 100644 lib/apl/tests/scalar.sx diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx new file mode 100644 index 00000000..43addb91 --- /dev/null +++ b/lib/apl/runtime.sx @@ -0,0 +1,349 @@ +; APL Runtime — array model + scalar primitives +; +; Array = SX dict {:shape (d1 d2 ...) :ravel (v1 v2 ...)} +; Scalar: rank 0, shape (), one element in ravel +; Vector: rank 1, shape (n), n elements in ravel +; Matrix: rank 2, shape (r c), r*c elements in ravel + +; ============================================================ +; Array constructors +; ============================================================ + +(define make-array (fn (shape ravel) {:ravel ravel :shape shape})) + +(define apl-scalar (fn (v) {:ravel (list v) :shape (list)})) + +(define apl-vector (fn (elems) {:ravel elems :shape (list (len elems))})) + +; enclose — wrap any value in a rank-0 box +(define enclose (fn (v) (apl-scalar v))) + +; disclose — unwrap rank-0 box, returning the first element +(define disclose (fn (arr) (first (get arr :ravel)))) + +; ============================================================ +; Array accessors +; ============================================================ + +(define array-rank (fn (arr) (len (get arr :shape)))) + +(define scalar? (fn (arr) (= (len (get arr :shape)) 0))) + +(define array-ref (fn (arr i) (nth (get arr :ravel) i))) + +; ============================================================ +; System variables +; ============================================================ + +(define apl-io 1) + +; ============================================================ +; Broadcast engine +; ============================================================ + +(define + broadcast-monadic + (fn (f arr) (make-array (get arr :shape) (map f (get arr :ravel))))) + +(define + broadcast-dyadic + (fn + (f a b) + (cond + ((and (scalar? a) (scalar? b)) + (apl-scalar (f (first (get a :ravel)) (first (get b :ravel))))) + ((scalar? a) + (let + ((sv (first (get a :ravel)))) + (make-array + (get b :shape) + (map (fn (x) (f sv x)) (get b :ravel))))) + ((scalar? b) + (let + ((sv (first (get b :ravel)))) + (make-array + (get a :shape) + (map (fn (x) (f x sv)) (get a :ravel))))) + (else + (if + (equal? (get a :shape) (get b :shape)) + (make-array (get a :shape) (map f (get a :ravel) (get b :ravel))) + (error "length error: shape mismatch")))))) + +; ============================================================ +; Arithmetic primitives +; ============================================================ + +; Monadic + : identity +(define apl-plus-m (fn (a) (broadcast-monadic (fn (x) x) a))) + +; Dyadic + +(define apl-add (fn (a b) (broadcast-dyadic (fn (x y) (+ x y)) a b))) + +; Monadic - : negate +(define apl-neg-m (fn (a) (broadcast-monadic (fn (x) (- 0 x)) a))) + +; Dyadic - +(define apl-sub (fn (a b) (broadcast-dyadic (fn (x y) (- x y)) a b))) + +; Monadic × : signum +(define + apl-signum + (fn + (a) + (broadcast-monadic + (fn (x) (cond ((> x 0) 1) ((< x 0) -1) (else 0))) + a))) + +; Dyadic × +(define apl-mul (fn (a b) (broadcast-dyadic (fn (x y) (* x y)) a b))) + +; Monadic ÷ : reciprocal +(define apl-recip (fn (a) (broadcast-monadic (fn (x) (/ 1 x)) a))) + +; Dyadic ÷ +(define apl-div (fn (a b) (broadcast-dyadic (fn (x y) (/ x y)) a b))) + +; Monadic ⌈ : ceiling +(define apl-ceil (fn (a) (broadcast-monadic (fn (x) (ceil x)) a))) + +; Dyadic ⌈ : max +(define + apl-max + (fn (a b) (broadcast-dyadic (fn (x y) (if (>= x y) x y)) a b))) + +; Monadic ⌊ : floor +(define apl-floor (fn (a) (broadcast-monadic (fn (x) (floor x)) a))) + +; Dyadic ⌊ : min +(define + apl-min + (fn (a b) (broadcast-dyadic (fn (x y) (if (<= x y) x y)) a b))) + +; Monadic * : e^x +(define apl-exp (fn (a) (broadcast-monadic (fn (x) (exp x)) a))) + +; Dyadic * : power +(define apl-pow (fn (a b) (broadcast-dyadic (fn (x y) (pow x y)) a b))) + +; Monadic ⍟ : natural log +(define apl-ln (fn (a) (broadcast-monadic (fn (x) (log x)) a))) + +; Dyadic ⍟ : log base (a⍟b = log base a of b) +(define + apl-log + (fn (a b) (broadcast-dyadic (fn (x y) (/ (log y) (log x))) a b))) + +; Monadic | : absolute value +(define + apl-abs + (fn (a) (broadcast-monadic (fn (x) (if (< x 0) (- 0 x) x)) a))) + +; Dyadic | : modulo (a|b = b mod a) +(define + apl-mod + (fn + (a b) + (broadcast-dyadic + (fn (x y) (if (= x 0) y (- y (* x (floor (/ y x)))))) + a + b))) + +; Monadic ! : factorial +(define + apl-fact + (fn + (a) + (broadcast-monadic + (fn + (n) + (let + ((loop nil)) + (begin + (set! + loop + (fn (i acc) (if (> i n) acc (loop (+ i 1) (* acc i))))) + (loop 1 1)))) + a))) + +; Dyadic ! : binomial coefficient n!k (a=n, b=k => a choose b) +(define + apl-binomial + (fn + (a b) + (broadcast-dyadic + (fn + (n k) + (let + ((loop nil)) + (begin + (set! + loop + (fn + (i num den) + (if + (> i k) + (/ num den) + (loop (+ i 1) (* num (- (+ n 1) i)) (* den i))))) + (loop 1 1 1)))) + a + b))) + +; Monadic ○ : pi times x +(define + apl-pi-times + (fn (a) (broadcast-monadic (fn (x) (* 3.14159 x)) a))) + +; Dyadic ○ : trig functions (a○b, a=code, b=value) +(define + apl-trig + (fn + (a b) + (broadcast-dyadic + (fn + (n x) + (cond + ((= n 0) (pow (- 1 (* x x)) 0.5)) + ((= n 1) (sin x)) + ((= n 2) (cos x)) + ((= n 3) (tan x)) + ((= n -1) (asin x)) + ((= n -2) (acos x)) + ((= n -3) (atan x)) + (else (error "circle: unsupported trig code")))) + a + b))) + +; ============================================================ +; Comparison primitives (return 0 or 1) +; ============================================================ + +(define + apl-lt + (fn (a b) (broadcast-dyadic (fn (x y) (if (< x y) 1 0)) a b))) + +(define + apl-le + (fn (a b) (broadcast-dyadic (fn (x y) (if (<= x y) 1 0)) a b))) + +(define + apl-eq + (fn (a b) (broadcast-dyadic (fn (x y) (if (= x y) 1 0)) a b))) + +(define + apl-ge + (fn (a b) (broadcast-dyadic (fn (x y) (if (>= x y) 1 0)) a b))) + +(define + apl-gt + (fn (a b) (broadcast-dyadic (fn (x y) (if (> x y) 1 0)) a b))) + +(define + apl-ne + (fn (a b) (broadcast-dyadic (fn (x y) (if (= x y) 0 1)) a b))) + +; ============================================================ +; Logical primitives +; ============================================================ + +; Monadic ~ : logical not +(define + apl-not + (fn (a) (broadcast-monadic (fn (x) (if (= x 0) 1 0)) a))) + +; Dyadic ∧ : logical and +(define + apl-and + (fn + (a b) + (broadcast-dyadic + (fn (x y) (if (and (not (= x 0)) (not (= y 0))) 1 0)) + a + b))) + +; Dyadic ∨ : logical or +(define + apl-or + (fn + (a b) + (broadcast-dyadic + (fn (x y) (if (or (not (= x 0)) (not (= y 0))) 1 0)) + a + b))) + +; Dyadic ⍱ : logical nor +(define + apl-nor + (fn + (a b) + (broadcast-dyadic + (fn (x y) (if (or (not (= x 0)) (not (= y 0))) 0 1)) + a + b))) + +; Dyadic ⍲ : logical nand +(define + apl-nand + (fn + (a b) + (broadcast-dyadic + (fn (x y) (if (and (not (= x 0)) (not (= y 0))) 0 1)) + a + b))) + +; ============================================================ +; Shape primitives +; ============================================================ + +; Monadic ⍴ : shape — returns shape as a vector array +(define apl-shape (fn (arr) (apl-vector (get arr :shape)))) + +; Monadic , : ravel — returns a rank-1 vector of all elements +(define apl-ravel (fn (arr) (apl-vector (get arr :ravel)))) + +; Monadic ≢ : tally — first dimension (1 for scalar) +(define + apl-tally + (fn + (arr) + (if + (scalar? arr) + (apl-scalar 1) + (apl-scalar (first (get arr :shape)))))) + +; Monadic ≡ : depth +; simple number/string value → 0 +; array containing only non-arrays → 0 +; array containing arrays → 1 + max depth of elements +(define + apl-depth + (fn + (arr) + (define item-depth nil) + (set! + item-depth + (fn + (v) + (if + (and + (dict? v) + (not (= nil (get v :shape nil))) + (not (= nil (get v :ravel nil)))) + (+ 1 (first (get (apl-depth v) :ravel))) + 0))) + (let + ((depths (map item-depth (get arr :ravel)))) + (apl-scalar (reduce (fn (a b) (if (> a b) a b)) 0 depths))))) + +; Monadic ⍳ : iota — vector 1..n (with ⎕IO=1) +(define + apl-iota + (fn + (n-arr) + (let + ((n (first (get n-arr :ravel))) (build nil)) + (begin + (set! + build + (fn (i acc) (if (< i 1) acc (build (- i 1) (cons i acc))))) + (apl-vector (build n (list))))))) diff --git a/lib/apl/tests/scalar.sx b/lib/apl/tests/scalar.sx new file mode 100644 index 00000000..26a2c1e2 --- /dev/null +++ b/lib/apl/tests/scalar.sx @@ -0,0 +1,369 @@ +; APL scalar primitives test suite +; Requires: lib/apl/runtime.sx + +; ============================================================ +; Test framework +; ============================================================ + +(define apl-rt-count 0) +(define apl-rt-pass 0) +(define apl-rt-fails (list)) + +; Element-wise list comparison (handles both List and ListRef) +(define + lists-eq + (fn + (a b) + (if + (and (= (len a) 0) (= (len b) 0)) + true + (if + (not (= (len a) (len b))) + false + (if + (not (= (first a) (first b))) + false + (lists-eq (rest a) (rest b))))))) + +(define + apl-rt-test + (fn + (name actual expected) + (begin + (set! apl-rt-count (+ apl-rt-count 1)) + (if + (equal? actual expected) + (set! apl-rt-pass (+ apl-rt-pass 1)) + (append! apl-rt-fails {:actual actual :expected expected :name name}))))) + +; Test that a ravel equals a plain list (handles ListRef vs List) +(define + ravel-test + (fn + (name arr expected-list) + (begin + (set! apl-rt-count (+ apl-rt-count 1)) + (let + ((actual (get arr :ravel))) + (if + (lists-eq actual expected-list) + (set! apl-rt-pass (+ apl-rt-pass 1)) + (append! apl-rt-fails {:actual actual :expected expected-list :name name})))))) + +; Test a scalar ravel value (single-element list) +(define + scalar-test + (fn (name arr expected-val) (ravel-test name arr (list expected-val)))) + +; ============================================================ +; Array constructor tests +; ============================================================ + +(apl-rt-test + "scalar: shape is empty list" + (get (apl-scalar 5) :shape) + (list)) + +(apl-rt-test + "scalar: ravel has one element" + (get (apl-scalar 5) :ravel) + (list 5)) + +(apl-rt-test "scalar: rank 0" (array-rank (apl-scalar 5)) 0) + +(apl-rt-test "scalar? returns true for scalar" (scalar? (apl-scalar 5)) true) + +(apl-rt-test "scalar: zero" (get (apl-scalar 0) :ravel) (list 0)) + +(apl-rt-test + "vector: shape is (3)" + (get (apl-vector (list 1 2 3)) :shape) + (list 3)) + +(apl-rt-test + "vector: ravel matches input" + (get (apl-vector (list 1 2 3)) :ravel) + (list 1 2 3)) + +(apl-rt-test "vector: rank 1" (array-rank (apl-vector (list 1 2 3))) 1) + +(apl-rt-test + "scalar? returns false for vector" + (scalar? (apl-vector (list 1 2 3))) + false) + +(apl-rt-test + "make-array: rank 2" + (array-rank (make-array (list 2 3) (list 1 2 3 4 5 6))) + 2) + +(apl-rt-test + "make-array: shape" + (get (make-array (list 2 3) (list 1 2 3 4 5 6)) :shape) + (list 2 3)) + +(apl-rt-test + "array-ref: first element" + (array-ref (apl-vector (list 10 20 30)) 0) + 10) + +(apl-rt-test + "array-ref: last element" + (array-ref (apl-vector (list 10 20 30)) 2) + 30) + +(apl-rt-test "enclose: wraps in rank-0" (scalar? (enclose 42)) true) + +(apl-rt-test + "enclose: ravel contains value" + (get (enclose 42) :ravel) + (list 42)) + +(apl-rt-test "disclose: unwraps rank-0" (disclose (enclose 42)) 42) + +; ============================================================ +; Shape primitive tests +; ============================================================ + +(ravel-test "⍴ scalar: returns empty" (apl-shape (apl-scalar 5)) (list)) + +(ravel-test + "⍴ vector: returns (3)" + (apl-shape (apl-vector (list 1 2 3))) + (list 3)) + +(ravel-test + "⍴ matrix: returns (2 3)" + (apl-shape (make-array (list 2 3) (list 1 2 3 4 5 6))) + (list 2 3)) + +(ravel-test + ", ravel scalar: vector of 1" + (apl-ravel (apl-scalar 5)) + (list 5)) + +(apl-rt-test + ", ravel vector: same elements" + (get (apl-ravel (apl-vector (list 1 2 3))) :ravel) + (list 1 2 3)) + +(apl-rt-test + ", ravel matrix: all elements" + (get (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6))) :ravel) + (list 1 2 3 4 5 6)) + +(scalar-test "≢ tally scalar: 1" (apl-tally (apl-scalar 5)) 1) + +(scalar-test + "≢ tally vector: first dimension" + (apl-tally (apl-vector (list 1 2 3))) + 3) + +(scalar-test + "≢ tally matrix: first dimension" + (apl-tally (make-array (list 2 3) (list 1 2 3 4 5 6))) + 2) + +(scalar-test + "≡ depth flat vector: 0" + (apl-depth (apl-vector (list 1 2 3))) + 0) + +(scalar-test "≡ depth scalar: 0" (apl-depth (apl-scalar 5)) 0) + +(scalar-test + "≡ depth nested (enclose in vector): 1" + (apl-depth (enclose (apl-vector (list 1 2 3)))) + 1) + +; ============================================================ +; ⍳ iota tests +; ============================================================ + +(apl-rt-test + "⍳5 shape is (5)" + (get (apl-iota (apl-scalar 5)) :shape) + (list 5)) + +(ravel-test "⍳5 ravel is 1..5" (apl-iota (apl-scalar 5)) (list 1 2 3 4 5)) + +(ravel-test "⍳1 ravel is (1)" (apl-iota (apl-scalar 1)) (list 1)) + +(ravel-test "⍳0 ravel is empty" (apl-iota (apl-scalar 0)) (list)) + +(apl-rt-test "apl-io is 1" apl-io 1) + +; ============================================================ +; Arithmetic broadcast tests +; ============================================================ + +(scalar-test + "+ scalar scalar: 3+4=7" + (apl-add (apl-scalar 3) (apl-scalar 4)) + 7) + +(ravel-test + "+ vector scalar: +10" + (apl-add (apl-vector (list 1 2 3)) (apl-scalar 10)) + (list 11 12 13)) + +(ravel-test + "+ scalar vector: 10+" + (apl-add (apl-scalar 10) (apl-vector (list 1 2 3))) + (list 11 12 13)) + +(ravel-test + "+ vector vector" + (apl-add (apl-vector (list 1 2 3)) (apl-vector (list 4 5 6))) + (list 5 7 9)) + +(scalar-test "- negate monadic" (apl-neg-m (apl-scalar 5)) -5) + +(scalar-test "- dyadic 10-3=7" (apl-sub (apl-scalar 10) (apl-scalar 3)) 7) + +(scalar-test "× signum positive" (apl-signum (apl-scalar 7)) 1) + +(scalar-test "× signum negative" (apl-signum (apl-scalar -3)) -1) + +(scalar-test "× signum zero" (apl-signum (apl-scalar 0)) 0) + +(scalar-test "× dyadic 3×4=12" (apl-mul (apl-scalar 3) (apl-scalar 4)) 12) + +(scalar-test "÷ reciprocal 1÷4=0.25" (apl-recip (apl-scalar 4)) 0.25) + +(scalar-test + "÷ dyadic 10÷4=2.5" + (apl-div (apl-scalar 10) (apl-scalar 4)) + 2.5) + +(scalar-test "⌈ ceiling 2.3→3" (apl-ceil (apl-scalar 2.3)) 3) + +(scalar-test "⌈ max 3 5 → 5" (apl-max (apl-scalar 3) (apl-scalar 5)) 5) + +(scalar-test "⌊ floor 2.7→2" (apl-floor (apl-scalar 2.7)) 2) + +(scalar-test "⌊ min 3 5 → 3" (apl-min (apl-scalar 3) (apl-scalar 5)) 3) + +(scalar-test "* exp monadic e^0=1" (apl-exp (apl-scalar 0)) 1) + +(scalar-test + "* pow dyadic 2^10=1024" + (apl-pow (apl-scalar 2) (apl-scalar 10)) + 1024) + +(scalar-test "⍟ ln 1=0" (apl-ln (apl-scalar 1)) 0) + +(scalar-test "| abs positive" (apl-abs (apl-scalar 5)) 5) + +(scalar-test "| abs negative" (apl-abs (apl-scalar -5)) 5) + +(scalar-test "| mod 3|7=1" (apl-mod (apl-scalar 3) (apl-scalar 7)) 1) + +(scalar-test "! factorial 5!=120" (apl-fact (apl-scalar 5)) 120) + +(scalar-test "! factorial 0!=1" (apl-fact (apl-scalar 0)) 1) + +(scalar-test + "! binomial 4 choose 2 = 6" + (apl-binomial (apl-scalar 4) (apl-scalar 2)) + 6) + +(scalar-test "○ pi×0=0" (apl-pi-times (apl-scalar 0)) 0) + +(scalar-test "○ trig sin(0)=0" (apl-trig (apl-scalar 1) (apl-scalar 0)) 0) + +(scalar-test "○ trig cos(0)=1" (apl-trig (apl-scalar 2) (apl-scalar 0)) 1) + +; ============================================================ +; Comparison tests +; ============================================================ + +(scalar-test "< less: 3<5 → 1" (apl-lt (apl-scalar 3) (apl-scalar 5)) 1) + +(scalar-test "< less: 5<3 → 0" (apl-lt (apl-scalar 5) (apl-scalar 3)) 0) + +(scalar-test + "≤ le equal: 3≤3 → 1" + (apl-le (apl-scalar 3) (apl-scalar 3)) + 1) + +(scalar-test "= eq: 5=5 → 1" (apl-eq (apl-scalar 5) (apl-scalar 5)) 1) + +(scalar-test "= ne: 5=6 → 0" (apl-eq (apl-scalar 5) (apl-scalar 6)) 0) + +(scalar-test "≥ ge: 5≥3 → 1" (apl-ge (apl-scalar 5) (apl-scalar 3)) 1) + +(scalar-test "> gt: 5>3 → 1" (apl-gt (apl-scalar 5) (apl-scalar 3)) 1) + +(scalar-test "≠ ne: 5≠3 → 1" (apl-ne (apl-scalar 5) (apl-scalar 3)) 1) + +(ravel-test + "comparison vector broadcast: 1 2 3 < 2 → 1 0 0" + (apl-lt (apl-vector (list 1 2 3)) (apl-scalar 2)) + (list 1 0 0)) + +; ============================================================ +; Logical tests +; ============================================================ + +(scalar-test "~ not 0 → 1" (apl-not (apl-scalar 0)) 1) + +(scalar-test "~ not 1 → 0" (apl-not (apl-scalar 1)) 0) + +(ravel-test + "~ not vector: 1 0 1 0 → 0 1 0 1" + (apl-not (apl-vector (list 1 0 1 0))) + (list 0 1 0 1)) + +(scalar-test + "∧ and 1∧1 → 1" + (apl-and (apl-scalar 1) (apl-scalar 1)) + 1) + +(scalar-test + "∧ and 1∧0 → 0" + (apl-and (apl-scalar 1) (apl-scalar 0)) + 0) + +(scalar-test "∨ or 0∨1 → 1" (apl-or (apl-scalar 0) (apl-scalar 1)) 1) + +(scalar-test "∨ or 0∨0 → 0" (apl-or (apl-scalar 0) (apl-scalar 0)) 0) + +(scalar-test + "⍱ nor 0⍱0 → 1" + (apl-nor (apl-scalar 0) (apl-scalar 0)) + 1) + +(scalar-test + "⍱ nor 1⍱0 → 0" + (apl-nor (apl-scalar 1) (apl-scalar 0)) + 0) + +(scalar-test + "⍲ nand 1⍲1 → 0" + (apl-nand (apl-scalar 1) (apl-scalar 1)) + 0) + +(scalar-test + "⍲ nand 1⍲0 → 1" + (apl-nand (apl-scalar 1) (apl-scalar 0)) + 1) + +; ============================================================ +; plus-m identity test +; ============================================================ + +(scalar-test "+ monadic identity: +5 → 5" (apl-plus-m (apl-scalar 5)) 5) + +; ============================================================ +; Summary +; ============================================================ + +(define + apl-scalar-summary + (str + "scalar " + apl-rt-pass + "/" + apl-rt-count + (if (= (len apl-rt-fails) 0) "" (str " FAILS: " apl-rt-fails)))) From a14fe056327609bb3ebda437069f37d6b83cadb2 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 14:25:17 +0000 Subject: [PATCH 05/45] apl: tick Phase 2 checkboxes + progress log Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 0f8ec8d7..6d8c491e 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -53,14 +53,14 @@ Core mapping: - [x] Unit tests in `lib/apl/tests/parse.sx` ### Phase 2 — array model + scalar primitives -- [ ] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose` -- [ ] Shape arithmetic: `⍴` (shape), `,` (ravel), `≢` (tally / first-axis-length), `≡` (depth) -- [ ] Scalar arithmetic primitives broadcast: `+ - × ÷ ⌈ ⌊ * ⍟ | ! ○` -- [ ] Scalar comparison primitives: `< ≤ = ≥ > ≠` -- [ ] Scalar logical: `~ ∧ ∨ ⍱ ⍲` -- [ ] Index generator: `⍳n` (vector 1..n or 0..n-1 depending on `⎕IO`) -- [ ] `⎕IO` = 1 default (Dyalog convention) -- [ ] 40+ tests in `lib/apl/tests/scalar.sx` +- [x] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose` +- [x] Shape arithmetic: `⍴` (shape), `,` (ravel), `≢` (tally / first-axis-length), `≡` (depth) +- [x] Scalar arithmetic primitives broadcast: `+ - × ÷ ⌈ ⌊ * ⍟ | ! ○` +- [x] Scalar comparison primitives: `< ≤ = ≥ > ≠` +- [x] Scalar logical: `~ ∧ ∨ ⍱ ⍲` +- [x] Index generator: `⍳n` (vector 1..n or 0..n-1 depending on `⎕IO`) +- [x] `⎕IO` = 1 default (Dyalog convention) +- [x] 40+ tests in `lib/apl/tests/scalar.sx` ### Phase 3 — structural primitives + indexing - [ ] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec) @@ -108,6 +108,7 @@ Core mapping: _Newest first._ +- 2026-04-26: Phase 2 complete — array model + 7 scalar primitive groups; 82/82 tests; lib/apl/runtime.sx + lib/apl/tests/scalar.sx - 2026-04-26: parser (Phase 1 step 2) — 44/44 parser tests green (90/90 total); right-to-left segment algorithm; derived fns, outer/inner product, dfns with guards, strand handling; `lib/apl/parser.sx` + `lib/apl/tests/parse.sx` - 2026-04-25: tokenizer (Phase 1 step 1) — 46/46 tests green; Unicode-aware starts-with? scanner for multi-byte APL glyphs; `lib/apl/tokenizer.sx` + `lib/apl/tests/parse.sx` From d8cf74fd28196c6c327c2f998c2b1a62118d962a Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 06:47:10 +0000 Subject: [PATCH 06/45] briefing: push to origin/loops/apl after each commit --- plans/agent-briefings/apl-loop.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plans/agent-briefings/apl-loop.md b/plans/agent-briefings/apl-loop.md index c84c5c2a..7ddff8e6 100644 --- a/plans/agent-briefings/apl-loop.md +++ b/plans/agent-briefings/apl-loop.md @@ -11,7 +11,7 @@ isolation: worktree ## Prompt -You are the sole background agent working `/root/rose-ash/plans/apl-on-sx.md`. Isolated worktree, forever, one commit per feature. Never push. +You are the sole background agent working `/root/rose-ash/plans/apl-on-sx.md`. Isolated worktree, forever, one commit per feature. Push to `origin/loops/apl` after every commit. ## Restart baseline — check before iterating @@ -42,7 +42,7 @@ Every iteration: implement → test → commit → tick `[ ]` → Progress log - **Shared-file issues** → plan's Blockers with minimal repro. - **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits. - **Unicode in `.sx`:** raw UTF-8 only, never `\uXXXX` escapes. Glyphs land directly in source. -- **Worktree:** commit locally. Never push. Never touch `main`. +- **Worktree:** commit, then push to `origin/loops/apl`. Never touch `main`. - **Commit granularity:** one feature per commit. - **Plan file:** update Progress log + tick boxes every commit. From be26f77410c8fa874b084eb15028cb96c2d39f3d Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 18:36:43 +0000 Subject: [PATCH 07/45] =?UTF-8?q?apl:=20Phase=203=20reshape=20=E2=8D=B4=20?= =?UTF-8?q?/=20transpose=20=E2=8D=89=20=E2=80=94=2027/27=20structural=20te?= =?UTF-8?q?sts=20green?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add apl-reshape (dyadic ⍴, cycling), apl-transpose (monadic ⍉, reverse axes), apl-transpose-dyadic (dyadic ⍉, permutation), plus helpers apl-strides / apl-flat->multi / apl-multi->flat. lib/apl/tests/structural.sx: 27 new tests covering ravel, reshape, monadic/dyadic transpose across scalar/vector/matrix/3-D cases. test.sh now runs structural.sx via its own inline framework (skips stale tests/runtime.sx which targeted a pre-Phase-2 list-based API). Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 89 +++++++++++++++++ lib/apl/test.sh | 13 ++- lib/apl/tests/structural.sx | 191 ++++++++++++++++++++++++++++++++++++ 3 files changed, 289 insertions(+), 4 deletions(-) create mode 100644 lib/apl/tests/structural.sx diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 43addb91..4b93ebfb 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -347,3 +347,92 @@ build (fn (i acc) (if (< i 1) acc (build (- i 1) (cons i acc))))) (apl-vector (build n (list))))))) + +(define + apl-strides + (fn + (shape) + (map + (fn (i) (reduce * 1 (drop shape (+ i 1)))) + (range 0 (len shape))))) + +(define + apl-flat->multi + (fn + (flat shape strides) + (map + (fn (i) (mod (floor (/ flat (nth strides i))) (nth shape i))) + (range 0 (len shape))))) + +(define + apl-multi->flat + (fn (coords strides) (reduce + 0 (map * coords strides)))) + +(define + apl-reshape + (fn + (shape-arr data-arr) + (let + ((new-shape (if (scalar? shape-arr) (list (disclose shape-arr)) (get shape-arr :ravel))) + (src-ravel + (if + (scalar? data-arr) + (list (disclose data-arr)) + (get data-arr :ravel)))) + (let + ((new-size (reduce * 1 new-shape)) (src-len (len src-ravel))) + (let + ((new-ravel (if (= new-size 0) (list) (if (= src-len 0) (map (fn (i) 0) (range 0 new-size)) (map (fn (i) (nth src-ravel (mod i src-len))) (range 0 new-size)))))) + (make-array new-shape new-ravel)))))) + +(define + apl-transpose + (fn + (arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (if + (< (len shape) 2) + arr + (let + ((new-shape (reverse shape)) (strides (apl-strides shape))) + (let + ((new-strides (apl-strides new-shape)) (new-size (len ravel))) + (make-array + new-shape + (map + (fn + (new-flat) + (let + ((new-coords (apl-flat->multi new-flat new-shape new-strides))) + (nth + ravel + (apl-multi->flat (reverse new-coords) strides)))) + (range 0 new-size))))))))) + +(define + apl-transpose-dyadic + (fn + (perm-arr data-arr) + (let + ((perm (map (fn (p) (- p apl-io)) (get perm-arr :ravel))) + (shape (get data-arr :shape)) + (ravel (get data-arr :ravel))) + (let + ((new-shape (map (fn (k) (nth shape k)) perm)) + (strides (apl-strides shape))) + (let + ((inv-perm (map (fn (j) (index-of perm j)) (range 0 (len perm)))) + (new-strides (apl-strides new-shape)) + (new-size (len ravel))) + (make-array + new-shape + (map + (fn + (new-flat) + (let + ((new-coords (apl-flat->multi new-flat new-shape new-strides))) + (let + ((old-coords (map (fn (i) (nth new-coords (nth inv-perm i))) (range 0 (len shape))))) + (nth ravel (apl-multi->flat old-coords strides))))) + (range 0 new-size)))))))) diff --git a/lib/apl/test.sh b/lib/apl/test.sh index a8a967c0..5d546d1a 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -20,17 +20,22 @@ cat > "$TMPFILE" << 'EPOCHS' (load "spec/stdlib.sx") (load "lib/apl/runtime.sx") (epoch 2) -(load "lib/apl/tests/runtime.sx") +(eval "(define apl-test-pass 0)") +(eval "(define apl-test-fail 0)") +(eval "(define apl-test-fails (list))") +(eval "(define (apl-test name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (begin (set! apl-test-fail (+ apl-test-fail 1)) (set! apl-test-fails (append apl-test-fails (list {:name name :got got :expected expected}))))))") (epoch 3) +(load "lib/apl/tests/structural.sx") +(epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) -LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}') +LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}') if [ -z "$LINE" ]; then - LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \ - | sed -E 's/^\(ok 3 //; s/\)$//') + LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \ + | sed -E 's/^\(ok 4 //; s/\)$//') fi if [ -z "$LINE" ]; then echo "ERROR: could not extract summary" diff --git a/lib/apl/tests/structural.sx b/lib/apl/tests/structural.sx new file mode 100644 index 00000000..10cb18e2 --- /dev/null +++ b/lib/apl/tests/structural.sx @@ -0,0 +1,191 @@ +;; lib/apl/tests/structural.sx — Phase 3: structural primitives +;; Tests for: apl-reshape, apl-ravel, apl-transpose, apl-transpose-dyadic +;; Loaded after runtime.sx; shares apl-test / apl-test-pass / apl-test-fail. + +(define rv (fn (arr) (get arr :ravel))) +(define sh (fn (arr) (get arr :shape))) + +;; --------------------------------------------------------------------------- +;; 1. Ravel (monadic ,) +;; --------------------------------------------------------------------------- +(apl-test "ravel scalar" (rv (apl-ravel (apl-scalar 5))) (list 5)) + +(apl-test + "ravel vector" + (rv (apl-ravel (make-array (list 3) (list 1 2 3)))) + (list 1 2 3)) + +(apl-test + "ravel matrix" + (rv (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2 3 4 5 6)) + +(apl-test + "ravel shape is rank-1" + (sh (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 6)) + +;; --------------------------------------------------------------------------- +;; 2. Reshape (dyadic ⍴) +;; --------------------------------------------------------------------------- + +(apl-test + "reshape 2x3 ravel" + (rv + (apl-reshape + (make-array (list 2) (list 2 3)) + (make-array (list 6) (list 1 2 3 4 5 6)))) + (list 1 2 3 4 5 6)) + +(apl-test + "reshape 2x3 shape" + (sh + (apl-reshape + (make-array (list 2) (list 2 3)) + (make-array (list 6) (list 1 2 3 4 5 6)))) + (list 2 3)) + +(apl-test + "reshape cycle 6 from 1 2" + (rv + (apl-reshape + (make-array (list 1) (list 6)) + (make-array (list 2) (list 1 2)))) + (list 1 2 1 2 1 2)) + +(apl-test + "reshape cycle 2x3 from 1 2" + (rv + (apl-reshape + (make-array (list 2) (list 2 3)) + (make-array (list 2) (list 1 2)))) + (list 1 2 1 2 1 2)) + +(apl-test + "reshape scalar fill" + (rv (apl-reshape (make-array (list 1) (list 4)) (apl-scalar 7))) + (list 7 7 7 7)) + +(apl-test + "reshape truncate" + (rv + (apl-reshape + (make-array (list 1) (list 3)) + (make-array (list 6) (list 10 20 30 40 50 60)))) + (list 10 20 30)) + +(apl-test + "reshape matrix to vector" + (sh + (apl-reshape + (make-array (list 1) (list 6)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 6)) + +(apl-test + "reshape 2x2x3" + (sh + (apl-reshape + (make-array (list 3) (list 2 2 3)) + (make-array (list 12) (range 1 13)))) + (list 2 2 3)) + +(apl-test + "reshape to empty" + (rv + (apl-reshape + (make-array (list 1) (list 0)) + (make-array (list 3) (list 1 2 3)))) + (list)) + +;; --------------------------------------------------------------------------- +;; 3. Monadic transpose (⍉) +;; --------------------------------------------------------------------------- + +(apl-test + "transpose scalar shape" + (sh (apl-transpose (apl-scalar 99))) + (list)) + +(apl-test + "transpose scalar ravel" + (rv (apl-transpose (apl-scalar 99))) + (list 99)) + +(apl-test + "transpose vector shape" + (sh (apl-transpose (make-array (list 3) (list 3 1 4)))) + (list 3)) + +(apl-test + "transpose vector ravel" + (rv (apl-transpose (make-array (list 3) (list 3 1 4)))) + (list 3 1 4)) + +(apl-test + "transpose 2x3 shape" + (sh (apl-transpose (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 3 2)) + +(apl-test + "transpose 2x3 ravel" + (rv (apl-transpose (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 4 2 5 3 6)) + +(apl-test + "transpose 3x3" + (rv (apl-transpose (make-array (list 3 3) (list 1 2 3 4 5 6 7 8 9)))) + (list 1 4 7 2 5 8 3 6 9)) + +(apl-test + "transpose 1x4 shape" + (sh (apl-transpose (make-array (list 1 4) (list 1 2 3 4)))) + (list 4 1)) + +(apl-test + "transpose twice identity" + (rv + (apl-transpose + (apl-transpose (make-array (list 2 3) (list 1 2 3 4 5 6))))) + (list 1 2 3 4 5 6)) + +(apl-test + "transpose 3d shape" + (sh (apl-transpose (make-array (list 2 3 4) (range 0 24)))) + (list 4 3 2)) + +;; --------------------------------------------------------------------------- +;; 4. Dyadic transpose (perm⍉arr) +;; --------------------------------------------------------------------------- + +(apl-test + "dyadic-transpose identity" + (rv + (apl-transpose-dyadic + (make-array (list 2) (list 1 2)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2 3 4 5 6)) + +(apl-test + "dyadic-transpose swap 2x3" + (rv + (apl-transpose-dyadic + (make-array (list 2) (list 2 1)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 4 2 5 3 6)) + +(apl-test + "dyadic-transpose swap shape" + (sh + (apl-transpose-dyadic + (make-array (list 2) (list 2 1)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 3 2)) + +(apl-test + "dyadic-transpose 3d shape" + (sh + (apl-transpose-dyadic + (make-array (list 3) (list 2 1 3)) + (make-array (list 2 3 4) (range 0 24)))) + (list 3 2 4)) \ No newline at end of file From 6a6a94e203e7045aba48df7c01e19c1dc0fc34da Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 18:37:10 +0000 Subject: [PATCH 08/45] plans: tick Phase 3 step 1 reshape/transpose, progress log Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index f9bea3b4..e78c93d0 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -63,7 +63,7 @@ Core mapping: - [x] 40+ tests in `lib/apl/tests/scalar.sx` ### Phase 3 — structural primitives + indexing -- [ ] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec) +- [x] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec) - [ ] Take `↑`, drop `↓`, rotate `⌽` (last axis), `⊖` (first axis) - [ ] Catenate `,` (last axis) and `⍪` (first axis) - [ ] Index `⌷` (squad), bracket-indexing `A[I]` (sugar for `⌷`) @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 3 step 1 — reshape ⍴ (cycling), transpose ⍉ (monadic+dyadic); helpers apl-strides/flat->multi/multi->flat; 27/27 structural tests; lib/apl/tests/structural.sx - 2026-04-26: Phase 2 complete — array model + 7 scalar primitive groups; 82/82 tests; lib/apl/runtime.sx + lib/apl/tests/scalar.sx - 2026-04-26: parser (Phase 1 step 2) — 44/44 parser tests green (90/90 total); right-to-left segment algorithm; derived fns, outer/inner product, dfns with guards, strand handling; `lib/apl/parser.sx` + `lib/apl/tests/parse.sx` - 2026-04-25: tokenizer (Phase 1 step 1) — 46/46 tests green; Unicode-aware starts-with? scanner for multi-byte APL glyphs; `lib/apl/tokenizer.sx` + `lib/apl/tests/parse.sx` From 3c83985841cd943c8433e922298caa45f36f4c92 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 18:45:12 +0000 Subject: [PATCH 09/45] =?UTF-8?q?apl:=20Phase=203=20take=20=E2=86=91=20/?= =?UTF-8?q?=20drop=20=E2=86=93=20/=20rotate=20=E2=8C=BD=E2=8A=96=20?= =?UTF-8?q?=E2=80=94=2050/50=20tests=20green?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add apl-take (dyadic ↑, multi-axis, cycling pad), apl-drop (dyadic ↓), apl-reverse (monadic ⌽), apl-rotate (dyadic ⌽, last axis), apl-reverse-first (monadic ⊖), apl-rotate-first (dyadic ⊖, first axis), apl-safe-mod helper for negative rotation arithmetic. 23 new tests in lib/apl/tests/structural.sx. Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 170 ++++++++++++++++++++++++++++++++++++ lib/apl/tests/structural.sx | 136 ++++++++++++++++++++++++++++- 2 files changed, 305 insertions(+), 1 deletion(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 4b93ebfb..30081175 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -436,3 +436,173 @@ ((old-coords (map (fn (i) (nth new-coords (nth inv-perm i))) (range 0 (len shape))))) (nth ravel (apl-multi->flat old-coords strides))))) (range 0 new-size)))))))) + +(define apl-safe-mod (fn (a m) (mod (+ (mod a m) m) m))) + +(define + apl-take + (fn + (n-arr data-arr) + (let + ((old-shape (get data-arr :shape)) + (old-ravel (get data-arr :ravel)) + (ns + (if (scalar? n-arr) (list (disclose n-arr)) (get n-arr :ravel)))) + (let + ((new-shape (map abs ns)) (old-strides (apl-strides old-shape))) + (let + ((new-size (reduce * 1 new-shape)) + (new-strides (apl-strides new-shape))) + (make-array + new-shape + (map + (fn + (new-flat) + (let + ((new-coords (apl-flat->multi new-flat new-shape new-strides))) + (let + ((old-coords (map (fn (i) (let ((ni (nth ns i)) (nc (nth new-coords i)) (od (nth old-shape i))) (if (>= ni 0) nc (+ (- od (- ni)) nc)))) (range 0 (len ns))))) + (if + (every? + (fn + (i) + (and + (>= (nth old-coords i) 0) + (< (nth old-coords i) (nth old-shape i)))) + (range 0 (len old-coords))) + (nth old-ravel (apl-multi->flat old-coords old-strides)) + 0)))) + (range 0 new-size)))))))) + +(define + apl-drop + (fn + (n-arr data-arr) + (let + ((old-shape (get data-arr :shape)) + (old-ravel (get data-arr :ravel)) + (ns + (if (scalar? n-arr) (list (disclose n-arr)) (get n-arr :ravel)))) + (let + ((new-shape (map (fn (i) (let ((ni (nth ns i)) (od (nth old-shape i))) (let ((d (if (>= ni 0) (- od ni) (+ od ni)))) (if (> d 0) d 0)))) (range 0 (len ns)))) + (offsets + (map + (fn (i) (let ((ni (nth ns i))) (if (>= ni 0) ni 0))) + (range 0 (len ns)))) + (old-strides (apl-strides old-shape))) + (let + ((new-size (reduce * 1 new-shape)) + (new-strides (apl-strides new-shape))) + (make-array + new-shape + (map + (fn + (new-flat) + (let + ((new-coords (apl-flat->multi new-flat new-shape new-strides))) + (let + ((old-coords (map (fn (i) (+ (nth new-coords i) (nth offsets i))) (range 0 (len ns))))) + (nth old-ravel (apl-multi->flat old-coords old-strides))))) + (range 0 new-size)))))))) + +(define + apl-reverse + (fn + (arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (if + (= (len shape) 0) + arr + (let + ((last-dim (last shape)) (n (len ravel))) + (make-array + shape + (map + (fn + (flat) + (let + ((c-last (mod flat last-dim))) + (nth ravel (+ flat (- last-dim 1) (* -2 c-last))))) + (range 0 n)))))))) + +(define + apl-reverse-first + (fn + (arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (if + (= (len shape) 0) + arr + (let + ((first-dim (first shape)) + (first-stride (reduce * 1 (rest shape))) + (n (len ravel))) + (make-array + shape + (map + (fn + (flat) + (let + ((row (floor (/ flat first-stride)))) + (let + ((old-row (- first-dim 1 row))) + (nth + ravel + (+ (* old-row first-stride) (mod flat first-stride)))))) + (range 0 n)))))))) + +(define + apl-rotate-first + (fn + (n-arr data-arr) + (let + ((shape (get data-arr :shape)) + (ravel (get data-arr :ravel)) + (rot (disclose n-arr))) + (if + (= (len shape) 0) + data-arr + (let + ((first-dim (first shape)) + (first-stride (reduce * 1 (rest shape))) + (n (len ravel))) + (make-array + shape + (map + (fn + (flat) + (let + ((row (floor (/ flat first-stride)))) + (let + ((old-row (apl-safe-mod (+ row rot) first-dim))) + (nth + ravel + (+ (* old-row first-stride) (mod flat first-stride)))))) + (range 0 n)))))))) + +(define + apl-rotate + (fn + (n-arr data-arr) + (let + ((shape (get data-arr :shape)) + (ravel (get data-arr :ravel)) + (rot (disclose n-arr))) + (if + (= (len shape) 0) + data-arr + (let + ((last-dim (last shape)) (n (len ravel))) + (make-array + shape + (map + (fn + (flat) + (let + ((c-last (mod flat last-dim))) + (let + ((old-c-last (apl-safe-mod (+ c-last rot) last-dim))) + (nth ravel (+ flat (- old-c-last c-last)))))) + (range 0 n)))))))) diff --git a/lib/apl/tests/structural.sx b/lib/apl/tests/structural.sx index 10cb18e2..72b1e961 100644 --- a/lib/apl/tests/structural.sx +++ b/lib/apl/tests/structural.sx @@ -188,4 +188,138 @@ (apl-transpose-dyadic (make-array (list 3) (list 2 1 3)) (make-array (list 2 3 4) (range 0 24)))) - (list 3 2 4)) \ No newline at end of file + (list 3 2 4)) + +(apl-test + "take 3 from front" + (rv (apl-take (apl-scalar 3) (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 3)) + +(apl-test + "take 0" + (rv (apl-take (apl-scalar 0) (make-array (list 5) (list 1 2 3 4 5)))) + (list)) + +(apl-test + "take -2 from back" + (rv (apl-take (apl-scalar -2) (make-array (list 5) (list 1 2 3 4 5)))) + (list 4 5)) + +(apl-test + "take over-take pads with 0" + (rv (apl-take (apl-scalar 7) (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 3 4 5 0 0)) + +(apl-test + "take matrix 1 row 2 cols shape" + (sh + (apl-take + (make-array (list 2) (list 1 2)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2)) + +(apl-test + "take matrix 1 row 2 cols ravel" + (rv + (apl-take + (make-array (list 2) (list 1 2)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2)) + +(apl-test + "take matrix negative row" + (rv + (apl-take + (make-array (list 2) (list -1 3)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 4 5 6)) + +(apl-test + "drop 2 from front" + (rv (apl-drop (apl-scalar 2) (make-array (list 5) (list 1 2 3 4 5)))) + (list 3 4 5)) + +(apl-test + "drop -2 from back" + (rv (apl-drop (apl-scalar -2) (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 3)) + +(apl-test + "drop all" + (rv (apl-drop (apl-scalar 5) (make-array (list 5) (list 1 2 3 4 5)))) + (list)) + +(apl-test + "drop 0" + (rv (apl-drop (apl-scalar 0) (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 3 4 5)) + +(apl-test + "drop matrix 1 row shape" + (sh + (apl-drop + (make-array (list 2) (list 1 0)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 3)) + +(apl-test + "drop matrix 1 row ravel" + (rv + (apl-drop + (make-array (list 2) (list 1 0)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 4 5 6)) + +(apl-test + "reverse vector" + (rv (apl-reverse (make-array (list 5) (list 1 2 3 4 5)))) + (list 5 4 3 2 1)) + +(apl-test + "reverse scalar identity" + (rv (apl-reverse (apl-scalar 42))) + (list 42)) + +(apl-test + "reverse matrix last axis" + (rv (apl-reverse (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 3 2 1 6 5 4)) + +(apl-test + "reverse-first matrix" + (rv (apl-reverse-first (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 4 5 6 1 2 3)) + +(apl-test + "reverse-first vector identity" + (rv (apl-reverse-first (make-array (list 4) (list 1 2 3 4)))) + (list 4 3 2 1)) + +(apl-test + "rotate vector left by 2" + (rv (apl-rotate (apl-scalar 2) (make-array (list 5) (list 1 2 3 4 5)))) + (list 3 4 5 1 2)) + +(apl-test + "rotate vector right by 1 (negative)" + (rv (apl-rotate (apl-scalar -1) (make-array (list 5) (list 1 2 3 4 5)))) + (list 5 1 2 3 4)) + +(apl-test + "rotate by 0 is identity" + (rv (apl-rotate (apl-scalar 0) (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 3 4 5)) + +(apl-test + "rotate matrix last axis" + (rv + (apl-rotate (apl-scalar 1) (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2 3 1 5 6 4)) + +(apl-test + "rotate-first matrix" + (rv + (apl-rotate-first + (apl-scalar 1) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 4 5 6 1 2 3)) \ No newline at end of file From c03ba9eccbcdf39da16ceea980b0a861bd792308 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 18:45:37 +0000 Subject: [PATCH 10/45] plans: tick Phase 3 step 2 take/drop/rotate, progress log Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index e78c93d0..8c9ce635 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -64,7 +64,7 @@ Core mapping: ### Phase 3 — structural primitives + indexing - [x] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec) -- [ ] Take `↑`, drop `↓`, rotate `⌽` (last axis), `⊖` (first axis) +- [x] Take `↑`, drop `↓`, rotate `⌽` (last axis), `⊖` (first axis) - [ ] Catenate `,` (last axis) and `⍪` (first axis) - [ ] Index `⌷` (squad), bracket-indexing `A[I]` (sugar for `⌷`) - [ ] Grade-up `⍋`, grade-down `⍒` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 3 step 2 — take ↑ (multi-axis, pad), drop ↓, reverse/rotate ⌽⊖ (last+first axis); 50/50 tests - 2026-05-06: Phase 3 step 1 — reshape ⍴ (cycling), transpose ⍉ (monadic+dyadic); helpers apl-strides/flat->multi/multi->flat; 27/27 structural tests; lib/apl/tests/structural.sx - 2026-04-26: Phase 2 complete — array model + 7 scalar primitive groups; 82/82 tests; lib/apl/runtime.sx + lib/apl/tests/scalar.sx - 2026-04-26: parser (Phase 1 step 2) — 44/44 parser tests green (90/90 total); right-to-left segment algorithm; derived fns, outer/inner product, dfns with guards, strand handling; `lib/apl/parser.sx` + `lib/apl/tests/parse.sx` From 71ad7d2d24f4b90279e6776c459ec3954b034a42 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 18:51:32 +0000 Subject: [PATCH 11/45] =?UTF-8?q?apl:=20Phase=203=20catenate=20,=20and=20f?= =?UTF-8?q?irst-axis=20=E2=80=94=2059/59=20tests=20green?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add apl-catenate (dyadic ,, last-axis join, scalar promotion) and apl-catenate-first (first-axis join, row-major append). 9 new tests. Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 55 ++++++++++++++++++++++++++++++ lib/apl/tests/structural.sx | 68 ++++++++++++++++++++++++++++++++++++- 2 files changed, 122 insertions(+), 1 deletion(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 30081175..8f53df38 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -606,3 +606,58 @@ ((old-c-last (apl-safe-mod (+ c-last rot) last-dim))) (nth ravel (+ flat (- old-c-last c-last)))))) (range 0 n)))))))) + +(define + apl-catenate + (fn + (a b) + (let + ((a-s (if (scalar? a) (list 1) (get a :shape))) + (b-s (if (scalar? b) (list 1) (get b :shape))) + (a-r (get a :ravel)) + (b-r (get b :ravel))) + (let + ((a-last (last a-s)) (prefix (take a-s (- (len a-s) 1)))) + (let + ((new-shape (append prefix (list (+ a-last (last b-s))))) + (a-strides (apl-strides a-s)) + (b-strides (apl-strides b-s))) + (let + ((new-size (reduce * 1 new-shape)) + (new-strides (apl-strides new-shape))) + (make-array + new-shape + (map + (fn + (new-flat) + (let + ((new-coords (apl-flat->multi new-flat new-shape new-strides))) + (let + ((last-c (last new-coords)) + (prefix-c (take new-coords (- (len new-coords) 1)))) + (if + (< last-c a-last) + (nth + a-r + (apl-multi->flat + (append prefix-c (list last-c)) + a-strides)) + (nth + b-r + (apl-multi->flat + (append prefix-c (list (- last-c a-last))) + b-strides)))))) + (range 0 new-size))))))))) + +(define + apl-catenate-first + (fn + (a b) + (let + ((a-s (if (scalar? a) (list 1) (get a :shape))) + (b-s (if (scalar? b) (list 1) (get b :shape))) + (a-r (get a :ravel)) + (b-r (get b :ravel))) + (make-array + (cons (+ (first a-s) (first b-s)) (rest a-s)) + (append a-r b-r))))) diff --git a/lib/apl/tests/structural.sx b/lib/apl/tests/structural.sx index 72b1e961..4a6dddd8 100644 --- a/lib/apl/tests/structural.sx +++ b/lib/apl/tests/structural.sx @@ -322,4 +322,70 @@ (apl-rotate-first (apl-scalar 1) (make-array (list 2 3) (list 1 2 3 4 5 6)))) - (list 4 5 6 1 2 3)) \ No newline at end of file + (list 4 5 6 1 2 3)) + +(apl-test + "cat v,v ravel" + (rv + (apl-catenate + (make-array (list 3) (list 1 2 3)) + (make-array (list 2) (list 4 5)))) + (list 1 2 3 4 5)) + +(apl-test + "cat v,v shape" + (sh + (apl-catenate + (make-array (list 3) (list 1 2 3)) + (make-array (list 2) (list 4 5)))) + (list 5)) + +(apl-test + "cat scalar,v" + (rv (apl-catenate (apl-scalar 99) (make-array (list 3) (list 1 2 3)))) + (list 99 1 2 3)) + +(apl-test + "cat v,scalar" + (rv (apl-catenate (make-array (list 3) (list 1 2 3)) (apl-scalar 99))) + (list 1 2 3 99)) + +(apl-test + "cat matrix last-axis shape" + (sh + (apl-catenate + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 2 2) (list 7 8 9 10)))) + (list 2 5)) + +(apl-test + "cat matrix last-axis ravel" + (rv + (apl-catenate + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 2 2) (list 7 8 9 10)))) + (list 1 2 3 7 8 4 5 6 9 10)) + +(apl-test + "cat-first v,v shape" + (sh + (apl-catenate-first + (make-array (list 3) (list 1 2 3)) + (make-array (list 2) (list 4 5)))) + (list 5)) + +(apl-test + "cat-first matrix shape" + (sh + (apl-catenate-first + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3 3) (list 11 12 13 14 15 16 17 18 19)))) + (list 5 3)) + +(apl-test + "cat-first matrix ravel" + (rv + (apl-catenate-first + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3 3) (list 11 12 13 14 15 16 17 18 19)))) + (list 1 2 3 4 5 6 11 12 13 14 15 16 17 18 19)) \ No newline at end of file From 248dca5b320054696d382b7b13089dd272624bf2 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 18:51:58 +0000 Subject: [PATCH 12/45] plans: tick Phase 3 catenate, progress log Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 8c9ce635..5e84dda4 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -65,7 +65,7 @@ Core mapping: ### Phase 3 — structural primitives + indexing - [x] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec) - [x] Take `↑`, drop `↓`, rotate `⌽` (last axis), `⊖` (first axis) -- [ ] Catenate `,` (last axis) and `⍪` (first axis) +- [x] Catenate `,` (last axis) and `⍪` (first axis) - [ ] Index `⌷` (squad), bracket-indexing `A[I]` (sugar for `⌷`) - [ ] Grade-up `⍋`, grade-down `⍒` - [ ] Enclose `⊂`, disclose `⊃`, partition (subset deferred) @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 3 step 3 — catenate , (last axis, scalar promo) and first-axis; 59/59 tests - 2026-05-06: Phase 3 step 2 — take ↑ (multi-axis, pad), drop ↓, reverse/rotate ⌽⊖ (last+first axis); 50/50 tests - 2026-05-06: Phase 3 step 1 — reshape ⍴ (cycling), transpose ⍉ (monadic+dyadic); helpers apl-strides/flat->multi/multi->flat; 27/27 structural tests; lib/apl/tests/structural.sx - 2026-04-26: Phase 2 complete — array model + 7 scalar primitive groups; 82/82 tests; lib/apl/runtime.sx + lib/apl/tests/scalar.sx From e11fbd61407970d0da0563532dd97df46f048ee7 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 18:57:07 +0000 Subject: [PATCH 13/45] =?UTF-8?q?apl:=20Phase=203=20squad=20=E2=8C=B7=20in?= =?UTF-8?q?dexing=20=E2=80=94=2066/66=20tests=20green?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add apl-squad: scalar index into vector, fully-specified multi-dim index, partial index returning sub-array slice. 7 new tests. Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 27 +++++++++++++++++++++ lib/apl/tests/structural.sx | 48 ++++++++++++++++++++++++++++++++++++- 2 files changed, 74 insertions(+), 1 deletion(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 8f53df38..165234db 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -661,3 +661,30 @@ (make-array (cons (+ (first a-s) (first b-s)) (rest a-s)) (append a-r b-r))))) + +(define + apl-squad + (fn + (idx-arr data-arr) + (let + ((shape (get data-arr :shape)) + (ravel (get data-arr :ravel)) + (strides (apl-strides (get data-arr :shape)))) + (let + ((idxs (if (scalar? idx-arr) (list (disclose idx-arr)) (get idx-arr :ravel)))) + (let + ((k (len idxs)) (rank (len shape))) + (let + ((adj (map (fn (i) (- i apl-io)) idxs))) + (if + (= k rank) + (apl-scalar (nth ravel (apl-multi->flat adj strides))) + (let + ((remaining-shape (drop shape k)) + (start (apl-multi->flat adj (take strides k))) + (slice-size (reduce * 1 (drop shape k)))) + (make-array + remaining-shape + (map + (fn (j) (nth ravel (+ start j))) + (range 0 slice-size))))))))))) diff --git a/lib/apl/tests/structural.sx b/lib/apl/tests/structural.sx index 4a6dddd8..204905dc 100644 --- a/lib/apl/tests/structural.sx +++ b/lib/apl/tests/structural.sx @@ -388,4 +388,50 @@ (apl-catenate-first (make-array (list 2 3) (list 1 2 3 4 5 6)) (make-array (list 3 3) (list 11 12 13 14 15 16 17 18 19)))) - (list 1 2 3 4 5 6 11 12 13 14 15 16 17 18 19)) \ No newline at end of file + (list 1 2 3 4 5 6 11 12 13 14 15 16 17 18 19)) + +(apl-test + "squad scalar into vector" + (rv + (apl-squad (apl-scalar 2) (make-array (list 5) (list 10 20 30 40 50)))) + (list 20)) + +(apl-test + "squad first element" + (rv (apl-squad (apl-scalar 1) (make-array (list 3) (list 10 20 30)))) + (list 10)) + +(apl-test + "squad last element" + (rv + (apl-squad (apl-scalar 5) (make-array (list 5) (list 10 20 30 40 50)))) + (list 50)) + +(apl-test + "squad fully specified matrix element" + (rv + (apl-squad + (make-array (list 2) (list 2 3)) + (make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12)))) + (list 7)) + +(apl-test + "squad partial row of matrix shape" + (sh + (apl-squad + (apl-scalar 2) + (make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12)))) + (list 4)) + +(apl-test + "squad partial row of matrix ravel" + (rv + (apl-squad + (apl-scalar 2) + (make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12)))) + (list 5 6 7 8)) + +(apl-test + "squad partial 3d slice shape" + (sh (apl-squad (apl-scalar 1) (make-array (list 2 3 4) (range 1 25)))) + (list 3 4)) \ No newline at end of file From 03e9df3ecf5b635d1cb3cadfc479dd1cf2deaaab Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 18:57:24 +0000 Subject: [PATCH 14/45] =?UTF-8?q?plans:=20tick=20Phase=203=20squad=20?= =?UTF-8?q?=E2=8C=B7,=20progress=20log?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 5e84dda4..3b26f0c9 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -66,7 +66,7 @@ Core mapping: - [x] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec) - [x] Take `↑`, drop `↓`, rotate `⌽` (last axis), `⊖` (first axis) - [x] Catenate `,` (last axis) and `⍪` (first axis) -- [ ] Index `⌷` (squad), bracket-indexing `A[I]` (sugar for `⌷`) +- [x] Index `⌷` (squad), bracket-indexing `A[I]` (sugar for `⌷`) - [ ] Grade-up `⍋`, grade-down `⍒` - [ ] Enclose `⊂`, disclose `⊃`, partition (subset deferred) - [ ] Membership `∊`, find `⍳` (dyadic), without `~` (dyadic), unique `∪` (deferred to phase 6) @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 3 step 4 — squad ⌷ (scalar/multi-dim/partial-slice); 66/66 tests - 2026-05-06: Phase 3 step 3 — catenate , (last axis, scalar promo) and first-axis; 59/59 tests - 2026-05-06: Phase 3 step 2 — take ↑ (multi-axis, pad), drop ↓, reverse/rotate ⌽⊖ (last+first axis); 50/50 tests - 2026-05-06: Phase 3 step 1 — reshape ⍴ (cycling), transpose ⍉ (monadic+dyadic); helpers apl-strides/flat->multi/multi->flat; 27/27 structural tests; lib/apl/tests/structural.sx From 7dfa092ed268a90c3cb7c65ae008f8f78c6656ad Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 19:02:49 +0000 Subject: [PATCH 15/45] =?UTF-8?q?apl:=20Phase=203=20grade-up=20=E2=8D=8B?= =?UTF-8?q?=20/=20grade-down=20=E2=8D=92=20=E2=80=94=2074/74=20tests=20gre?= =?UTF-8?q?en?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add apl-grade (stable insertion sort helper), apl-grade-up, apl-grade-down. Stability guaranteed via secondary sort key (original index). 8 new tests. Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 44 +++++++++++++++++++++++++++++++++++++ lib/apl/tests/structural.sx | 42 ++++++++++++++++++++++++++++++++++- 2 files changed, 85 insertions(+), 1 deletion(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 165234db..4bfd91e9 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -688,3 +688,47 @@ (map (fn (j) (nth ravel (+ start j))) (range 0 slice-size))))))))))) + +(define + apl-grade + (fn + (arr ascending) + (let + ((ravel (get arr :ravel)) (n (len (get arr :ravel)))) + (let + ((pairs (map (fn (i) (list (nth ravel i) (+ i apl-io))) (range 0 n)))) + (define ins nil) + (set! + ins + (fn + (x sorted) + (if + (= (len sorted) 0) + (list x) + (let + ((xv (first x)) + (xi (nth x 1)) + (hd (first sorted)) + (sv (first hd)) + (si (nth hd 1))) + (if + (if + ascending + (or (< xv sv) (and (= xv sv) (< xi si))) + (or (> xv sv) (and (= xv sv) (< xi si)))) + (cons x sorted) + (cons hd (ins x (rest sorted)))))))) + (define isort nil) + (set! + isort + (fn + (lst) + (if + (= (len lst) 0) + (list) + (ins (first lst) (isort (rest lst)))))) + (make-array (list n) (map (fn (p) (nth p 1)) (isort pairs))))))) + +(define apl-grade-up (fn (arr) (apl-grade arr true))) + +(define apl-grade-down (fn (arr) (apl-grade arr false))) diff --git a/lib/apl/tests/structural.sx b/lib/apl/tests/structural.sx index 204905dc..9ad71b99 100644 --- a/lib/apl/tests/structural.sx +++ b/lib/apl/tests/structural.sx @@ -434,4 +434,44 @@ (apl-test "squad partial 3d slice shape" (sh (apl-squad (apl-scalar 1) (make-array (list 2 3 4) (range 1 25)))) - (list 3 4)) \ No newline at end of file + (list 3 4)) + +(apl-test + "grade-up basic" + (rv (apl-grade-up (make-array (list 5) (list 3 1 4 1 5)))) + (list 2 4 1 3 5)) + +(apl-test + "grade-up shape" + (sh (apl-grade-up (make-array (list 4) (list 4 1 3 2)))) + (list 4)) + +(apl-test + "grade-up no duplicates" + (rv (apl-grade-up (make-array (list 4) (list 4 1 3 2)))) + (list 2 4 3 1)) + +(apl-test + "grade-up already sorted" + (rv (apl-grade-up (make-array (list 3) (list 1 2 3)))) + (list 1 2 3)) + +(apl-test + "grade-up reverse sorted" + (rv (apl-grade-up (make-array (list 3) (list 3 2 1)))) + (list 3 2 1)) + +(apl-test + "grade-down basic" + (rv (apl-grade-down (make-array (list 5) (list 3 1 4 1 5)))) + (list 5 3 1 2 4)) + +(apl-test + "grade-down no duplicates" + (rv (apl-grade-down (make-array (list 4) (list 4 1 3 2)))) + (list 1 3 4 2)) + +(apl-test + "grade-up single element" + (rv (apl-grade-up (make-array (list 1) (list 42)))) + (list 1)) \ No newline at end of file From ad914b413c40411dd4d8373493a83fb390ae8d3e Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 19:03:05 +0000 Subject: [PATCH 16/45] plans: tick Phase 3 grade-up/down, progress log Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 3b26f0c9..7fa7e205 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -67,7 +67,7 @@ Core mapping: - [x] Take `↑`, drop `↓`, rotate `⌽` (last axis), `⊖` (first axis) - [x] Catenate `,` (last axis) and `⍪` (first axis) - [x] Index `⌷` (squad), bracket-indexing `A[I]` (sugar for `⌷`) -- [ ] Grade-up `⍋`, grade-down `⍒` +- [x] Grade-up `⍋`, grade-down `⍒` - [ ] Enclose `⊂`, disclose `⊃`, partition (subset deferred) - [ ] Membership `∊`, find `⍳` (dyadic), without `~` (dyadic), unique `∪` (deferred to phase 6) - [ ] 40+ tests in `lib/apl/tests/structural.sx` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 3 step 5 — grade-up ⍋ / grade-down ⍒ (stable insertion sort); 74/74 tests - 2026-05-06: Phase 3 step 4 — squad ⌷ (scalar/multi-dim/partial-slice); 66/66 tests - 2026-05-06: Phase 3 step 3 — catenate , (last axis, scalar promo) and first-axis; 59/59 tests - 2026-05-06: Phase 3 step 2 — take ↑ (multi-axis, pad), drop ↓, reverse/rotate ⌽⊖ (last+first axis); 50/50 tests From e06e3ad014a1f022c97f193245db468c01b9a2d0 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 19:17:30 +0000 Subject: [PATCH 17/45] =?UTF-8?q?apl:=20enclose=20=E2=8A=82=20/=20disclose?= =?UTF-8?q?=20=E2=8A=83;=2082/82=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 21 +++++++++++++++++++ lib/apl/test.sh | 6 +++--- lib/apl/tests/structural.sx | 42 ++++++++++++++++++++++++++++++++++++- 3 files changed, 65 insertions(+), 4 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 4bfd91e9..ca6fa2c7 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -732,3 +732,24 @@ (define apl-grade-up (fn (arr) (apl-grade arr true))) (define apl-grade-down (fn (arr) (apl-grade arr false))) + +(define apl-enclose (fn (arr) (apl-scalar arr))) + +(define + apl-disclose + (fn + (arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (if + (= (len shape) 0) + (let + ((inner (first ravel))) + (if (= (type-of inner) "dict") inner (apl-scalar inner))) + (if + (= (len shape) 1) + (apl-scalar (first ravel)) + (let + ((inner-shape (rest shape)) + (inner-size (reduce * 1 (rest shape)))) + (make-array inner-shape (take ravel inner-size)))))))) diff --git a/lib/apl/test.sh b/lib/apl/test.sh index 5d546d1a..ecb69bee 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -4,9 +4,9 @@ set -uo pipefail cd "$(git rev-parse --show-toplevel)" -SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}" +SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}" if [ ! -x "$SX_SERVER" ]; then - SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe" + SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe" fi if [ ! -x "$SX_SERVER" ]; then echo "ERROR: sx_server.exe not found." @@ -23,7 +23,7 @@ cat > "$TMPFILE" << 'EPOCHS' (eval "(define apl-test-pass 0)") (eval "(define apl-test-fail 0)") (eval "(define apl-test-fails (list))") -(eval "(define (apl-test name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (begin (set! apl-test-fail (+ apl-test-fail 1)) (set! apl-test-fails (append apl-test-fails (list {:name name :got got :expected expected}))))))") +(eval "(define apl-test (fn (name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (begin (set! apl-test-fail (+ apl-test-fail 1)) (set! apl-test-fails (append apl-test-fails (list {:name name :got got :expected expected})))))))") (epoch 3) (load "lib/apl/tests/structural.sx") (epoch 4) diff --git a/lib/apl/tests/structural.sx b/lib/apl/tests/structural.sx index 9ad71b99..cfdf16cf 100644 --- a/lib/apl/tests/structural.sx +++ b/lib/apl/tests/structural.sx @@ -474,4 +474,44 @@ (apl-test "grade-up single element" (rv (apl-grade-up (make-array (list 1) (list 42)))) - (list 1)) \ No newline at end of file + (list 1)) + +(apl-test + "enclose shape is scalar" + (sh (apl-enclose (make-array (list 3) (list 1 2 3)))) + (list)) + +(apl-test + "enclose ravel length is 1" + (len (rv (apl-enclose (make-array (list 3) (list 1 2 3))))) + 1) + +(apl-test + "enclose inner ravel" + (rv (first (rv (apl-enclose (make-array (list 3) (list 1 2 3)))))) + (list 1 2 3)) + +(apl-test + "disclose of enclose round-trips ravel" + (rv (apl-disclose (apl-enclose (make-array (list 3) (list 10 20 30))))) + (list 10 20 30)) + +(apl-test + "disclose of enclose round-trips shape" + (sh (apl-disclose (apl-enclose (make-array (list 3) (list 10 20 30))))) + (list 3)) + +(apl-test + "disclose scalar ravel" + (rv (apl-disclose (apl-scalar 42))) + (list 42)) + +(apl-test + "disclose vector ravel" + (rv (apl-disclose (make-array (list 3) (list 5 6 7)))) + (list 5)) + +(apl-test + "disclose matrix returns first row" + (rv (apl-disclose (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2 3)) \ No newline at end of file From 32efdfe4aad03bceea7183fd6d246430ed804ce4 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 19:17:56 +0000 Subject: [PATCH 18/45] plans: tick Phase 3 enclose/disclose, progress log Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 7fa7e205..839d3f03 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -68,7 +68,7 @@ Core mapping: - [x] Catenate `,` (last axis) and `⍪` (first axis) - [x] Index `⌷` (squad), bracket-indexing `A[I]` (sugar for `⌷`) - [x] Grade-up `⍋`, grade-down `⍒` -- [ ] Enclose `⊂`, disclose `⊃`, partition (subset deferred) +- [x] Enclose `⊂`, disclose `⊃`, partition (subset deferred) - [ ] Membership `∊`, find `⍳` (dyadic), without `~` (dyadic), unique `∪` (deferred to phase 6) - [ ] 40+ tests in `lib/apl/tests/structural.sx` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 3 step 6 — enclose ⊂ / disclose ⊃ (box/unbox, rank-0 detect via type-of); 82/82 tests - 2026-05-06: Phase 3 step 5 — grade-up ⍋ / grade-down ⍒ (stable insertion sort); 74/74 tests - 2026-05-06: Phase 3 step 4 — squad ⌷ (scalar/multi-dim/partial-slice); 66/66 tests - 2026-05-06: Phase 3 step 3 — catenate , (last axis, scalar promo) and first-axis; 59/59 tests From ce72070d2ac874213e3410ed92862628232333b5 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 19:24:46 +0000 Subject: [PATCH 19/45] =?UTF-8?q?apl:=20membership=20=E2=88=8A,=20dyadic?= =?UTF-8?q?=20=E2=8D=B3,=20without=20~=20(dyadic);=2094/94=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 42 +++++++++++++++++ lib/apl/tests/structural.sx | 93 ++++++++++++++++++++++++++++++++++++- 2 files changed, 134 insertions(+), 1 deletion(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index ca6fa2c7..ec3e5e1e 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -753,3 +753,45 @@ ((inner-shape (rest shape)) (inner-size (reduce * 1 (rest shape)))) (make-array inner-shape (take ravel inner-size)))))))) + +(define + apl-member + (fn + (a b) + (let + ((a-ravel (if (scalar? a) (list (disclose a)) (get a :ravel))) + (b-ravel (if (scalar? b) (list (disclose b)) (get b :ravel))) + (a-shape (get a :shape))) + (make-array + a-shape + (map (fn (x) (if (index-of b-ravel x) 1 0)) a-ravel))))) + +(define + apl-index-of + (fn + (v w) + (let + ((v-ravel (if (scalar? v) (list (disclose v)) (get v :ravel))) + (w-ravel (if (scalar? w) (list (disclose w)) (get w :ravel))) + (w-shape (get w :shape)) + (n (len (if (scalar? v) (list (disclose v)) (get v :ravel))))) + (make-array + w-shape + (map + (fn + (x) + (let + ((i (index-of v-ravel x))) + (if i (+ i apl-io) (+ n apl-io)))) + w-ravel))))) + +(define + apl-without + (fn + (a b) + (let + ((a-ravel (if (scalar? a) (list (disclose a)) (get a :ravel))) + (b-ravel (if (scalar? b) (list (disclose b)) (get b :ravel)))) + (let + ((result (filter (fn (x) (not (index-of b-ravel x))) a-ravel))) + (make-array (list (len result)) result))))) diff --git a/lib/apl/tests/structural.sx b/lib/apl/tests/structural.sx index cfdf16cf..03c28a53 100644 --- a/lib/apl/tests/structural.sx +++ b/lib/apl/tests/structural.sx @@ -514,4 +514,95 @@ (apl-test "disclose matrix returns first row" (rv (apl-disclose (make-array (list 2 3) (list 1 2 3 4 5 6)))) - (list 1 2 3)) \ No newline at end of file + (list 1 2 3)) + +(apl-test + "member basic" + (rv + (apl-member + (make-array (list 3) (list 1 2 3)) + (make-array (list 2) (list 2 3)))) + (list 0 1 1)) + +(apl-test + "member all absent" + (rv + (apl-member + (make-array (list 3) (list 4 5 6)) + (make-array (list 3) (list 1 2 3)))) + (list 0 0 0)) + +(apl-test + "member scalar" + (rv (apl-member (apl-scalar 5) (make-array (list 3) (list 1 5 9)))) + (list 1)) + +(apl-test + "member shape preserved" + (sh + (apl-member + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3) (list 1 3 5)))) + (list 2 3)) + +(apl-test + "member matrix ravel" + (rv + (apl-member + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3) (list 1 3 5)))) + (list 1 0 1 0 1 0)) + +(apl-test + "index-of basic" + (rv + (apl-index-of + (make-array (list 4) (list 10 20 30 40)) + (make-array (list 3) (list 20 40 10)))) + (list 2 4 1)) + +(apl-test + "index-of not-found" + (rv + (apl-index-of + (make-array (list 3) (list 1 2 3)) + (make-array (list 2) (list 5 2)))) + (list 4 2)) + +(apl-test + "index-of scalar right" + (rv + (apl-index-of (make-array (list 3) (list 10 20 30)) (apl-scalar 20))) + (list 2)) + +(apl-test + "without basic" + (rv + (apl-without + (make-array (list 5) (list 1 2 3 4 5)) + (make-array (list 2) (list 2 4)))) + (list 1 3 5)) + +(apl-test + "without shape" + (sh + (apl-without + (make-array (list 5) (list 1 2 3 4 5)) + (make-array (list 2) (list 2 4)))) + (list 3)) + +(apl-test + "without nothing removed" + (rv + (apl-without + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 4 5 6)))) + (list 1 2 3)) + +(apl-test + "without all removed" + (rv + (apl-without + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 1 2 3)))) + (list)) \ No newline at end of file From e42aec8957c786faea73dbdf4a4fe0d14d93663b Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 19:25:07 +0000 Subject: [PATCH 20/45] =?UTF-8?q?plans:=20Phase=203=20complete=20=E2=80=94?= =?UTF-8?q?=20tick=20membership/without/40+tests=20boxes?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 839d3f03..40270db2 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -69,8 +69,8 @@ Core mapping: - [x] Index `⌷` (squad), bracket-indexing `A[I]` (sugar for `⌷`) - [x] Grade-up `⍋`, grade-down `⍒` - [x] Enclose `⊂`, disclose `⊃`, partition (subset deferred) -- [ ] Membership `∊`, find `⍳` (dyadic), without `~` (dyadic), unique `∪` (deferred to phase 6) -- [ ] 40+ tests in `lib/apl/tests/structural.sx` +- [x] Membership `∊`, find `⍳` (dyadic), without `~` (dyadic), unique `∪` (deferred to phase 6) +- [x] 40+ tests in `lib/apl/tests/structural.sx` ### Phase 4 — operators (THE SHOWCASE) - [ ] Reduce `f/` (last axis), `f⌿` (first axis) — including `∧/`, `∨/`, `+/`, `×/`, `⌈/`, `⌊/` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 3 complete — membership ∊, dyadic ⍳ (index-of), without ~ (index-of returns nil for not-found); 94/94 tests - 2026-05-06: Phase 3 step 6 — enclose ⊂ / disclose ⊃ (box/unbox, rank-0 detect via type-of); 82/82 tests - 2026-05-06: Phase 3 step 5 — grade-up ⍋ / grade-down ⍒ (stable insertion sort); 74/74 tests - 2026-05-06: Phase 3 step 4 — squad ⌷ (scalar/multi-dim/partial-slice); 66/66 tests From c5ceb9c7185c7aed0fc608526aa70ea2d691d128 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 19:39:11 +0000 Subject: [PATCH 21/45] =?UTF-8?q?apl:=20reduce=20f/=20and=20f=E2=8C=BF=20(?= =?UTF-8?q?last+first=20axis);=20110/110=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Sonnet 4.6 --- lib/apl/runtime.sx | 78 ++++++++++++++++++++++++++++++++++ lib/apl/test.sh | 1 + lib/apl/tests/operators.sx | 85 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 164 insertions(+) create mode 100644 lib/apl/tests/operators.sx diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index ec3e5e1e..ea26c849 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -795,3 +795,81 @@ (let ((result (filter (fn (x) (not (index-of b-ravel x))) a-ravel))) (make-array (list (len result)) result))))) + +(define + apl-reduce + (fn + (f arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (if + (= (len shape) 0) + arr + (if + (= (len shape) 1) + (let + ((n (first shape))) + (if + (= n 0) + (apl-scalar 0) + (apl-scalar + (reduce + (fn (a b) (disclose (f (apl-scalar a) (apl-scalar b)))) + (first ravel) + (rest ravel))))) + (let + ((last-dim (last shape)) + (pre-shape (take shape (- (len shape) 1))) + (pre-size (reduce * 1 (take shape (- (len shape) 1))))) + (make-array + pre-shape + (map + (fn + (i) + (let + ((start (* i last-dim)) + (elems + (map + (fn (j) (nth ravel (+ start j))) + (range 0 last-dim)))) + (if + (= last-dim 0) + 0 + (reduce + (fn + (a b) + (disclose (f (apl-scalar a) (apl-scalar b)))) + (first elems) + (rest elems))))) + (range 0 pre-size))))))))) + +(define + apl-reduce-first + (fn + (f arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (if + (< (len shape) 2) + (apl-reduce f arr) + (let + ((first-dim (first shape)) + (inner-shape (rest shape)) + (inner-size (reduce * 1 (rest shape)))) + (if + (= first-dim 0) + (make-array inner-shape (map (fn (i) 0) (range 0 inner-size))) + (make-array + inner-shape + (map + (fn + (j) + (let + ((col (map (fn (i) (nth ravel (+ j (* i inner-size)))) (range 0 first-dim)))) + (reduce + (fn + (a b) + (disclose (f (apl-scalar a) (apl-scalar b)))) + (first col) + (rest col)))) + (range 0 inner-size))))))))) diff --git a/lib/apl/test.sh b/lib/apl/test.sh index ecb69bee..36c39ec1 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -26,6 +26,7 @@ cat > "$TMPFILE" << 'EPOCHS' (eval "(define apl-test (fn (name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (begin (set! apl-test-fail (+ apl-test-fail 1)) (set! apl-test-fails (append apl-test-fails (list {:name name :got got :expected expected})))))))") (epoch 3) (load "lib/apl/tests/structural.sx") +(load "lib/apl/tests/operators.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx new file mode 100644 index 00000000..7f5352b7 --- /dev/null +++ b/lib/apl/tests/operators.sx @@ -0,0 +1,85 @@ +(define rv (fn (arr) (get arr :ravel))) +(define sh (fn (arr) (get arr :shape))) + +(apl-test + "reduce +/ vector" + (rv (apl-reduce apl-add (make-array (list 5) (list 1 2 3 4 5)))) + (list 15)) + +(apl-test + "reduce x/ vector" + (rv (apl-reduce apl-mul (make-array (list 4) (list 1 2 3 4)))) + (list 24)) + +(apl-test + "reduce max/ vector" + (rv (apl-reduce apl-max (make-array (list 5) (list 3 1 4 1 5)))) + (list 5)) + +(apl-test + "reduce min/ vector" + (rv (apl-reduce apl-min (make-array (list 3) (list 3 1 4)))) + (list 1)) + +(apl-test + "reduce and/ all true" + (rv (apl-reduce apl-and (make-array (list 3) (list 1 1 1)))) + (list 1)) + +(apl-test + "reduce or/ with true" + (rv (apl-reduce apl-or (make-array (list 3) (list 0 0 1)))) + (list 1)) + +(apl-test + "reduce +/ single element" + (rv (apl-reduce apl-add (make-array (list 1) (list 42)))) + (list 42)) + +(apl-test + "reduce +/ scalar no-op" + (rv (apl-reduce apl-add (apl-scalar 7))) + (list 7)) + +(apl-test + "reduce +/ shape is scalar" + (sh (apl-reduce apl-add (make-array (list 4) (list 1 2 3 4)))) + (list)) + +(apl-test + "reduce +/ matrix row sums shape" + (sh (apl-reduce apl-add (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2)) + +(apl-test + "reduce +/ matrix row sums values" + (rv (apl-reduce apl-add (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 6 15)) + +(apl-test + "reduce max/ matrix row maxima" + (rv (apl-reduce apl-max (make-array (list 2 3) (list 3 1 4 1 5 9)))) + (list 4 9)) + +(apl-test + "reduce-first +/ vector same as reduce" + (rv (apl-reduce-first apl-add (make-array (list 5) (list 1 2 3 4 5)))) + (list 15)) + +(apl-test + "reduce-first +/ matrix col sums shape" + (sh + (apl-reduce-first apl-add (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 3)) + +(apl-test + "reduce-first +/ matrix col sums values" + (rv + (apl-reduce-first apl-add (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 5 7 9)) + +(apl-test + "reduce-first max/ matrix col maxima" + (rv + (apl-reduce-first apl-max (make-array (list 3 2) (list 1 9 2 8 3 7)))) + (list 3 9)) \ No newline at end of file From c63c0d26e829a0d8185effcff630f3c36c8c0597 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 19:39:34 +0000 Subject: [PATCH 22/45] =?UTF-8?q?plans:=20tick=20reduce=20f/=20f=E2=8C=BF,?= =?UTF-8?q?=20progress=20log?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Sonnet 4.6 --- plans/apl-on-sx.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 40270db2..69e14f9a 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -73,7 +73,7 @@ Core mapping: - [x] 40+ tests in `lib/apl/tests/structural.sx` ### Phase 4 — operators (THE SHOWCASE) -- [ ] Reduce `f/` (last axis), `f⌿` (first axis) — including `∧/`, `∨/`, `+/`, `×/`, `⌈/`, `⌊/` +- [x] Reduce `f/` (last axis), `f⌿` (first axis) — including `∧/`, `∨/`, `+/`, `×/`, `⌈/`, `⌊/` - [ ] Scan `f\`, `f⍀` - [ ] Each `f¨` — applies `f` to each scalar/element - [ ] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 1 — reduce f/ (last axis) + f⌿ (first axis); apl-reduce/apl-reduce-first; 110/110 tests - 2026-05-06: Phase 3 complete — membership ∊, dyadic ⍳ (index-of), without ~ (index-of returns nil for not-found); 94/94 tests - 2026-05-06: Phase 3 step 6 — enclose ⊂ / disclose ⊃ (box/unbox, rank-0 detect via type-of); 82/82 tests - 2026-05-06: Phase 3 step 5 — grade-up ⍋ / grade-down ⍒ (stable insertion sort); 74/74 tests From c56f40040357175d85b8dbf8c2297d946191ba5a Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 20:46:16 +0000 Subject: [PATCH 23/45] =?UTF-8?q?apl:=20scan=20f\=20+=20f=E2=8D=80=20(+15?= =?UTF-8?q?=20tests,=20125/125)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 88 ++++++++++++++++++++++++++++++++++++++ lib/apl/tests/operators.sx | 77 ++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 166 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index ea26c849..ea252013 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -873,3 +873,91 @@ (first col) (rest col)))) (range 0 inner-size))))))))) + +(define + apl-scan + (fn + (f arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (if + (= (len shape) 0) + arr + (if + (= (len shape) 1) + (let + ((n (first shape))) + (make-array + shape + (map + (fn + (i) + (let + ((slice (take ravel (+ i 1)))) + (reduce + (fn + (a b) + (disclose (f (apl-scalar a) (apl-scalar b)))) + (first slice) + (rest slice)))) + (range 0 n)))) + (let + ((last-dim (last shape)) + (pre-size (reduce * 1 (take shape (- (len shape) 1))))) + (make-array + shape + (flatten + (map + (fn + (i) + (let + ((start (* i last-dim)) + (row + (map + (fn (j) (nth ravel (+ start j))) + (range 0 last-dim)))) + (map + (fn + (k) + (let + ((slice (take row (+ k 1)))) + (reduce + (fn + (a b) + (disclose (f (apl-scalar a) (apl-scalar b)))) + (first slice) + (rest slice)))) + (range 0 last-dim)))) + (range 0 pre-size)))))))))) + +(define + apl-scan-first + (fn + (f arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (if + (< (len shape) 2) + (apl-scan f arr) + (let + ((first-dim (first shape)) + (inner-size (reduce * 1 (rest shape)))) + (make-array + shape + (flatten + (map + (fn + (i) + (map + (fn + (j) + (let + ((col (map (fn (k) (nth ravel (+ j (* k inner-size)))) (range 0 (+ i 1))))) + (reduce + (fn + (a b) + (disclose (f (apl-scalar a) (apl-scalar b)))) + (first col) + (rest col)))) + (range 0 inner-size))) + (range 0 first-dim))))))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 7f5352b7..8b2be5cc 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -82,4 +82,79 @@ "reduce-first max/ matrix col maxima" (rv (apl-reduce-first apl-max (make-array (list 3 2) (list 1 9 2 8 3 7)))) - (list 3 9)) \ No newline at end of file + (list 3 9)) + +(apl-test + "scan +\\ vector" + (rv (apl-scan apl-add (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 3 6 10 15)) + +(apl-test + "scan x\\ vector cumulative product" + (rv (apl-scan apl-mul (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 6 24 120)) + +(apl-test + "scan max\\ vector running max" + (rv (apl-scan apl-max (make-array (list 5) (list 3 1 4 1 5)))) + (list 3 3 4 4 5)) + +(apl-test + "scan min\\ vector running min" + (rv (apl-scan apl-min (make-array (list 5) (list 3 1 4 1 5)))) + (list 3 1 1 1 1)) + +(apl-test + "scan +\\ single element" + (rv (apl-scan apl-add (make-array (list 1) (list 42)))) + (list 42)) + +(apl-test + "scan +\\ scalar no-op" + (rv (apl-scan apl-add (apl-scalar 7))) + (list 7)) + +(apl-test + "scan +\\ vector preserves shape" + (sh (apl-scan apl-add (make-array (list 5) (list 1 2 3 4 5)))) + (list 5)) + +(apl-test + "scan +\\ matrix preserves shape" + (sh (apl-scan apl-add (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2 3)) + +(apl-test + "scan +\\ matrix row-wise" + (rv (apl-scan apl-add (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 3 6 4 9 15)) + +(apl-test + "scan max\\ matrix row-wise running max" + (rv (apl-scan apl-max (make-array (list 2 3) (list 3 1 4 1 5 9)))) + (list 3 3 4 1 5 9)) + +(apl-test + "scan-first +\\ vector same as scan" + (rv (apl-scan-first apl-add (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 3 6 10 15)) + +(apl-test + "scan-first +\\ scalar no-op" + (rv (apl-scan-first apl-add (apl-scalar 9))) + (list 9)) + +(apl-test + "scan-first +\\ matrix preserves shape" + (sh (apl-scan-first apl-add (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2 3)) + +(apl-test + "scan-first +\\ matrix col-wise" + (rv (apl-scan-first apl-add (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2 3 5 7 9)) + +(apl-test + "scan-first max\\ matrix col-wise running max" + (rv (apl-scan-first apl-max (make-array (list 3 2) (list 3 1 4 1 5 9)))) + (list 3 1 4 1 5 9)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 69e14f9a..8920b8c5 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -74,7 +74,7 @@ Core mapping: ### Phase 4 — operators (THE SHOWCASE) - [x] Reduce `f/` (last axis), `f⌿` (first axis) — including `∧/`, `∨/`, `+/`, `×/`, `⌈/`, `⌊/` -- [ ] Scan `f\`, `f⍀` +- [x] Scan `f\`, `f⍀` - [ ] Each `f¨` — applies `f` to each scalar/element - [ ] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table - [ ] Inner product `f.g` — `+.×` is matrix multiply @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 2 — scan f\ (last axis) + f⍀ (first axis); apl-scan/apl-scan-first; 125/125 tests - 2026-05-06: Phase 4 step 1 — reduce f/ (last axis) + f⌿ (first axis); apl-reduce/apl-reduce-first; 110/110 tests - 2026-05-06: Phase 3 complete — membership ∊, dyadic ⍳ (index-of), without ~ (index-of returns nil for not-found); 94/94 tests - 2026-05-06: Phase 3 step 6 — enclose ⊂ / disclose ⊃ (box/unbox, rank-0 detect via type-of); 82/82 tests From 3489c9f131ef1d19040c3367bd926d7737604dab Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 21:14:49 +0000 Subject: [PATCH 24/45] =?UTF-8?q?apl:=20each=20f=C2=A8=20monadic=20+=20dya?= =?UTF-8?q?dic=20(+14=20tests,=20139/139)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 35 +++++++++++++++ lib/apl/tests/operators.sx | 89 +++++++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 125 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index ea252013..e26dcf1f 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -961,3 +961,38 @@ (rest col)))) (range 0 inner-size))) (range 0 first-dim))))))))) + +(define + apl-each + (fn + (f arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (make-array + shape + (map (fn (x) (disclose (f (apl-scalar x)))) ravel))))) + +(define + apl-each-dyadic + (fn + (f a b) + (cond + ((and (scalar? a) (scalar? b)) (apl-scalar (disclose (f a b)))) + ((scalar? a) + (make-array + (get b :shape) + (map (fn (x) (disclose (f a (apl-scalar x)))) (get b :ravel)))) + ((scalar? b) + (make-array + (get a :shape) + (map (fn (x) (disclose (f (apl-scalar x) b))) (get a :ravel)))) + (else + (if + (equal? (get a :shape) (get b :shape)) + (make-array + (get a :shape) + (map + (fn (x y) (disclose (f (apl-scalar x) (apl-scalar y)))) + (get a :ravel) + (get b :ravel))) + (error "length error: shape mismatch")))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 8b2be5cc..9c17911b 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -157,4 +157,91 @@ (apl-test "scan-first max\\ matrix col-wise running max" (rv (apl-scan-first apl-max (make-array (list 3 2) (list 3 1 4 1 5 9)))) - (list 3 1 4 1 5 9)) \ No newline at end of file + (list 3 1 4 1 5 9)) + +(apl-test + "each negate vector" + (rv (apl-each apl-neg-m (make-array (list 3) (list 1 2 3)))) + (list -1 -2 -3)) + +(apl-test + "each negate vector preserves shape" + (sh (apl-each apl-neg-m (make-array (list 3) (list 1 2 3)))) + (list 3)) + +(apl-test + "each reciprocal vector" + (rv (apl-each apl-recip (make-array (list 3) (list 1 2 4)))) + (list 1 (/ 1 2) (/ 1 4))) + +(apl-test + "each abs vector" + (rv (apl-each apl-abs (make-array (list 4) (list -1 2 -3 4)))) + (list 1 2 3 4)) + +(apl-test "each scalar" (rv (apl-each apl-neg-m (apl-scalar 5))) (list -5)) + +(apl-test + "each scalar shape" + (sh (apl-each apl-neg-m (apl-scalar 5))) + (list)) + +(apl-test + "each negate matrix shape" + (sh (apl-each apl-neg-m (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2 3)) + +(apl-test + "each negate matrix values" + (rv (apl-each apl-neg-m (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list -1 -2 -3 -4 -5 -6)) + +(apl-test + "each-dyadic scalar+scalar" + (rv (apl-each-dyadic apl-add (apl-scalar 3) (apl-scalar 4))) + (list 7)) + +(apl-test + "each-dyadic scalar+vector" + (rv + (apl-each-dyadic + apl-add + (apl-scalar 10) + (make-array (list 3) (list 1 2 3)))) + (list 11 12 13)) + +(apl-test + "each-dyadic vector+scalar" + (rv + (apl-each-dyadic + apl-add + (make-array (list 3) (list 1 2 3)) + (apl-scalar 10))) + (list 11 12 13)) + +(apl-test + "each-dyadic vector+vector" + (rv + (apl-each-dyadic + apl-add + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 10 20 30)))) + (list 11 22 33)) + +(apl-test + "each-dyadic mul matrix+matrix shape" + (sh + (apl-each-dyadic + apl-mul + (make-array (list 2 2) (list 1 2 3 4)) + (make-array (list 2 2) (list 5 6 7 8)))) + (list 2 2)) + +(apl-test + "each-dyadic mul matrix+matrix values" + (rv + (apl-each-dyadic + apl-mul + (make-array (list 2 2) (list 1 2 3 4)) + (make-array (list 2 2) (list 5 6 7 8)))) + (list 5 12 21 32)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 8920b8c5..1140acef 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -75,7 +75,7 @@ Core mapping: ### Phase 4 — operators (THE SHOWCASE) - [x] Reduce `f/` (last axis), `f⌿` (first axis) — including `∧/`, `∨/`, `+/`, `×/`, `⌈/`, `⌊/` - [x] Scan `f\`, `f⍀` -- [ ] Each `f¨` — applies `f` to each scalar/element +- [x] Each `f¨` — applies `f` to each scalar/element - [ ] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table - [ ] Inner product `f.g` — `+.×` is matrix multiply - [ ] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 3 — each f¨ (monadic apl-each + dyadic apl-each-dyadic); scalar broadcast both sides; 139/139 tests - 2026-05-06: Phase 4 step 2 — scan f\ (last axis) + f⍀ (first axis); apl-scan/apl-scan-first; 125/125 tests - 2026-05-06: Phase 4 step 1 — reduce f/ (last axis) + f⌿ (first axis); apl-reduce/apl-reduce-first; 110/110 tests - 2026-05-06: Phase 3 complete — membership ∊, dyadic ⍳ (index-of), without ~ (index-of returns nil for not-found); 94/94 tests From 4332b4032f27b120fb94ca6336b9992f05d4bbc3 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 21:41:15 +0000 Subject: [PATCH 25/45] =?UTF-8?q?apl:=20outer=20product=20=E2=88=98.f=20(+?= =?UTF-8?q?12=20tests,=20151/151)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 20 ++++++++ lib/apl/tests/operators.sx | 93 +++++++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 114 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index e26dcf1f..8d26c5a9 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -996,3 +996,23 @@ (get a :ravel) (get b :ravel))) (error "length error: shape mismatch")))))) + +(define + apl-outer + (fn + (f a b) + (let + ((a-shape (get a :shape)) + (b-shape (get b :shape)) + (a-ravel (get a :ravel)) + (b-ravel (get b :ravel))) + (make-array + (append a-shape b-shape) + (flatten + (map + (fn + (x) + (map + (fn (y) (disclose (f (apl-scalar x) (apl-scalar y)))) + b-ravel)) + a-ravel)))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 9c17911b..fbe07e1a 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -244,4 +244,95 @@ apl-mul (make-array (list 2 2) (list 1 2 3 4)) (make-array (list 2 2) (list 5 6 7 8)))) - (list 5 12 21 32)) \ No newline at end of file + (list 5 12 21 32)) + +(apl-test + "outer product mult table values" + (rv + (apl-outer + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 1 2 3)))) + (list 1 2 3 2 4 6 3 6 9)) + +(apl-test + "outer product mult table shape" + (sh + (apl-outer + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 1 2 3)))) + (list 3 3)) + +(apl-test + "outer product add table values" + (rv + (apl-outer + apl-add + (make-array (list 2) (list 1 2)) + (make-array (list 3) (list 10 20 30)))) + (list 11 21 31 12 22 32)) + +(apl-test + "outer product add table shape" + (sh + (apl-outer + apl-add + (make-array (list 2) (list 1 2)) + (make-array (list 3) (list 10 20 30)))) + (list 2 3)) + +(apl-test + "outer product scalar+vector shape" + (sh + (apl-outer apl-mul (apl-scalar 5) (make-array (list 3) (list 1 2 3)))) + (list 3)) + +(apl-test + "outer product scalar+vector values" + (rv + (apl-outer apl-mul (apl-scalar 5) (make-array (list 3) (list 1 2 3)))) + (list 5 10 15)) + +(apl-test + "outer product vector+scalar shape" + (sh + (apl-outer apl-mul (make-array (list 3) (list 1 2 3)) (apl-scalar 10))) + (list 3)) + +(apl-test + "outer product scalar+scalar" + (rv (apl-outer apl-mul (apl-scalar 6) (apl-scalar 7))) + (list 42)) + +(apl-test + "outer product scalar+scalar shape" + (sh (apl-outer apl-mul (apl-scalar 6) (apl-scalar 7))) + (list)) + +(apl-test + "outer product equality identity matrix values" + (rv + (apl-outer + apl-eq + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 1 2 3)))) + (list 1 0 0 0 1 0 0 0 1)) + +(apl-test + "outer product matrix+vector rank doubling shape" + (sh + (apl-outer + apl-add + (make-array (list 2 2) (list 1 2 3 4)) + (make-array (list 3) (list 10 20 30)))) + (list 2 2 3)) + +(apl-test + "outer product matrix+vector rank doubling values" + (rv + (apl-outer + apl-add + (make-array (list 2 2) (list 1 2 3 4)) + (make-array (list 3) (list 10 20 30)))) + (list 11 21 31 12 22 32 13 23 33 14 24 34)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 1140acef..291be996 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -76,7 +76,7 @@ Core mapping: - [x] Reduce `f/` (last axis), `f⌿` (first axis) — including `∧/`, `∨/`, `+/`, `×/`, `⌈/`, `⌊/` - [x] Scan `f\`, `f⍀` - [x] Each `f¨` — applies `f` to each scalar/element -- [ ] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table +- [x] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table - [ ] Inner product `f.g` — `+.×` is matrix multiply - [ ] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` - [ ] Compose `f∘g` — applies `g` first then `f` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 4 — outer product ∘.f (apl-outer); rank-doubling result shape = a-shape++b-shape; 151/151 tests - 2026-05-06: Phase 4 step 3 — each f¨ (monadic apl-each + dyadic apl-each-dyadic); scalar broadcast both sides; 139/139 tests - 2026-05-06: Phase 4 step 2 — scan f\ (last axis) + f⍀ (first axis); apl-scan/apl-scan-first; 125/125 tests - 2026-05-06: Phase 4 step 1 — reduce f/ (last axis) + f⌿ (first axis); apl-reduce/apl-reduce-first; 110/110 tests From d67e04a9adc66d1668ea4dbdb81c95e40d30e1eb Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 22:09:13 +0000 Subject: [PATCH 26/45] apl: inner product f.g (+12 tests, 163/163) --- lib/apl/runtime.sx | 42 +++++++++++++ lib/apl/tests/operators.sx | 122 ++++++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 165 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 8d26c5a9..19db9f8d 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -1016,3 +1016,45 @@ (fn (y) (disclose (f (apl-scalar x) (apl-scalar y)))) b-ravel)) a-ravel)))))) + +(define + apl-inner + (fn + (f g a b) + (let + ((a-shape (get a :shape)) + (b-shape (get b :shape)) + (a-ravel (get a :ravel)) + (b-ravel (get b :ravel))) + (let + ((a-rank (len a-shape)) (b-rank (len b-shape))) + (if + (and (= a-rank 0) (= b-rank 0)) + (apl-scalar (disclose (g a b))) + (let + ((inner-dim (last a-shape)) + (a-pre (take a-shape (- a-rank 1))) + (b-post (rest b-shape))) + (let + ((a-pre-size (reduce * 1 a-pre)) + (b-post-size (reduce * 1 b-post)) + (new-shape (append a-pre b-post))) + (make-array + new-shape + (flatten + (map + (fn + (i) + (map + (fn + (j) + (let + ((pairs (map (fn (k) (disclose (g (apl-scalar (nth a-ravel (+ (* i inner-dim) k))) (apl-scalar (nth b-ravel (+ (* k b-post-size) j)))))) (range 0 inner-dim)))) + (reduce + (fn + (x y) + (disclose (f (apl-scalar x) (apl-scalar y)))) + (first pairs) + (rest pairs)))) + (range 0 b-post-size))) + (range 0 a-pre-size))))))))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index fbe07e1a..2e507811 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -335,4 +335,124 @@ apl-add (make-array (list 2 2) (list 1 2 3 4)) (make-array (list 3) (list 10 20 30)))) - (list 11 21 31 12 22 32 13 23 33 14 24 34)) \ No newline at end of file + (list 11 21 31 12 22 32 13 23 33 14 24 34)) + +(apl-test + "inner +.× dot product" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 4 5 6)))) + (list 32)) + +(apl-test + "inner +.× dot product shape is scalar" + (sh + (apl-inner + apl-add + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 4 5 6)))) + (list)) + +(apl-test + "inner +.× matrix multiply 2x3 * 3x2 shape" + (sh + (apl-inner + apl-add + apl-mul + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3 2) (list 7 8 9 10 11 12)))) + (list 2 2)) + +(apl-test + "inner +.× matrix multiply 2x3 * 3x2 values" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3 2) (list 7 8 9 10 11 12)))) + (list 58 64 139 154)) + +(apl-test + "inner +.× identity matrix 2x2" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 2 2) (list 1 0 0 1)) + (make-array (list 2 2) (list 5 6 7 8)))) + (list 5 6 7 8)) + +(apl-test + "inner ∧.= equal vectors" + (rv + (apl-inner + apl-and + apl-eq + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 1 2 3)))) + (list 1)) + +(apl-test + "inner ∧.= unequal vectors" + (rv + (apl-inner + apl-and + apl-eq + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 1 9 3)))) + (list 0)) + +(apl-test + "inner +.× matrix * vector shape" + (sh + (apl-inner + apl-add + apl-mul + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3) (list 7 8 9)))) + (list 2)) + +(apl-test + "inner +.× matrix * vector values" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3) (list 7 8 9)))) + (list 50 122)) + +(apl-test + "inner +.× vector * matrix shape" + (sh + (apl-inner + apl-add + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3 2) (list 4 5 6 7 8 9)))) + (list 2)) + +(apl-test + "inner +.× vector * matrix values" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3 2) (list 4 5 6 7 8 9)))) + (list 40 46)) + +(apl-test + "inner +.× single-element vectors" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 1) (list 6)) + (make-array (list 1) (list 7)))) + (list 42)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 291be996..08e68318 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -77,7 +77,7 @@ Core mapping: - [x] Scan `f\`, `f⍀` - [x] Each `f¨` — applies `f` to each scalar/element - [x] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table -- [ ] Inner product `f.g` — `+.×` is matrix multiply +- [x] Inner product `f.g` — `+.×` is matrix multiply - [ ] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` - [ ] Compose `f∘g` — applies `g` first then `f` - [ ] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 5 — inner product f.g (apl-inner); +.× matrix multiply, ∧.= equal-vectors; 163/163 tests - 2026-05-06: Phase 4 step 4 — outer product ∘.f (apl-outer); rank-doubling result shape = a-shape++b-shape; 151/151 tests - 2026-05-06: Phase 4 step 3 — each f¨ (monadic apl-each + dyadic apl-each-dyadic); scalar broadcast both sides; 139/139 tests - 2026-05-06: Phase 4 step 2 — scan f\ (last axis) + f⍀ (first axis); apl-scan/apl-scan-first; 125/125 tests From d570da1dea1598490075eedd9f9b8b712e81510d Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 22:36:11 +0000 Subject: [PATCH 27/45] =?UTF-8?q?apl:=20commute=20f=E2=8D=A8=20(+10=20test?= =?UTF-8?q?s,=20173/173)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 4 +++ lib/apl/tests/operators.sx | 64 +++++++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 69 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 19db9f8d..2dc96916 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -1058,3 +1058,7 @@ (rest pairs)))) (range 0 b-post-size))) (range 0 a-pre-size))))))))))) + +(define apl-commute (fn (f x) (f x x))) + +(define apl-commute-dyadic (fn (f x y) (f y x))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 2e507811..063269ac 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -455,4 +455,66 @@ apl-mul (make-array (list 1) (list 6)) (make-array (list 1) (list 7)))) - (list 42)) \ No newline at end of file + (list 42)) + +(apl-test + "commute +⍨ scalar doubles" + (rv (apl-commute apl-add (apl-scalar 5))) + (list 10)) + +(apl-test + "commute ×⍨ vector squares" + (rv (apl-commute apl-mul (make-array (list 4) (list 1 2 3 4)))) + (list 1 4 9 16)) + +(apl-test + "commute +⍨ vector doubles" + (rv (apl-commute apl-add (make-array (list 3) (list 1 2 3)))) + (list 2 4 6)) + +(apl-test + "commute +⍨ shape preserved" + (sh (apl-commute apl-add (make-array (list 3) (list 1 2 3)))) + (list 3)) + +(apl-test + "commute ×⍨ matrix shape preserved" + (sh (apl-commute apl-mul (make-array (list 2 2) (list 1 2 3 4)))) + (list 2 2)) + +(apl-test + "commute-dyadic -⍨ swaps subtraction" + (rv (apl-commute-dyadic apl-sub (apl-scalar 5) (apl-scalar 3))) + (list -2)) + +(apl-test + "commute-dyadic ÷⍨ swaps division" + (rv (apl-commute-dyadic apl-div (apl-scalar 4) (apl-scalar 12))) + (list 3)) + +(apl-test + "commute-dyadic -⍨ on vectors" + (rv + (apl-commute-dyadic + apl-sub + (make-array (list 3) (list 10 20 30)) + (make-array (list 3) (list 1 2 3)))) + (list -9 -18 -27)) + +(apl-test + "commute-dyadic +⍨ commutative same result" + (rv + (apl-commute-dyadic + apl-add + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 10 20 30)))) + (list 11 22 33)) + +(apl-test + "commute-dyadic ×⍨ commutative same result" + (rv + (apl-commute-dyadic + apl-mul + (make-array (list 3) (list 2 3 4)) + (make-array (list 3) (list 5 6 7)))) + (list 10 18 28)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 08e68318..6348f3c1 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -78,7 +78,7 @@ Core mapping: - [x] Each `f¨` — applies `f` to each scalar/element - [x] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table - [x] Inner product `f.g` — `+.×` is matrix multiply -- [ ] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` +- [x] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` - [ ] Compose `f∘g` — applies `g` first then `f` - [ ] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point - [ ] Rank `f⍤k` — apply f at sub-rank k @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 6 — commute f⍨ (apl-commute monadic dup, apl-commute-dyadic swap); 173/173 tests - 2026-05-06: Phase 4 step 5 — inner product f.g (apl-inner); +.× matrix multiply, ∧.= equal-vectors; 163/163 tests - 2026-05-06: Phase 4 step 4 — outer product ∘.f (apl-outer); rank-doubling result shape = a-shape++b-shape; 151/151 tests - 2026-05-06: Phase 4 step 3 — each f¨ (monadic apl-each + dyadic apl-each-dyadic); scalar broadcast both sides; 139/139 tests From 3d2bdc52b5b238ab106f727c5b50cc908abfb93a Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 23:03:14 +0000 Subject: [PATCH 28/45] =?UTF-8?q?apl:=20compose=20f=E2=88=98g=20(+9=20test?= =?UTF-8?q?s,=20182/182)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 4 +++ lib/apl/tests/operators.sx | 64 +++++++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 69 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 2dc96916..4ee5f295 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -1062,3 +1062,7 @@ (define apl-commute (fn (f x) (f x x))) (define apl-commute-dyadic (fn (f x y) (f y x))) + +(define apl-compose (fn (f g x) (f (g x)))) + +(define apl-compose-dyadic (fn (f g x y) (f x (g y)))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 063269ac..43d67fa2 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -517,4 +517,66 @@ apl-mul (make-array (list 3) (list 2 3 4)) (make-array (list 3) (list 5 6 7)))) - (list 10 18 28)) \ No newline at end of file + (list 10 18 28)) + +(apl-test + "compose -∘| scalar (negative abs)" + (rv (apl-compose apl-neg-m apl-abs (apl-scalar -7))) + (list -7)) + +(apl-test + "compose -∘| vector" + (rv + (apl-compose apl-neg-m apl-abs (make-array (list 4) (list -1 2 -3 4)))) + (list -1 -2 -3 -4)) + +(apl-test + "compose ⌊∘- (floor of negate)" + (rv (apl-compose apl-floor apl-neg-m (make-array (list 3) (list 1 2 3)))) + (list -1 -2 -3)) + +(apl-test + "compose -∘| matrix shape preserved" + (sh + (apl-compose apl-neg-m apl-abs (make-array (list 2 2) (list -1 2 -3 4)))) + (list 2 2)) + +(apl-test + "compose-dyadic +∘- equals subtract scalar" + (rv (apl-compose-dyadic apl-add apl-neg-m (apl-scalar 10) (apl-scalar 3))) + (list 7)) + +(apl-test + "compose-dyadic +∘- equals subtract vector" + (rv + (apl-compose-dyadic + apl-add + apl-neg-m + (make-array (list 3) (list 10 20 30)) + (make-array (list 3) (list 1 2 3)))) + (list 9 18 27)) + +(apl-test + "compose-dyadic -∘| (subtract abs)" + (rv (apl-compose-dyadic apl-sub apl-abs (apl-scalar 10) (apl-scalar -3))) + (list 7)) + +(apl-test + "compose-dyadic ×∘- (multiply by negative)" + (rv + (apl-compose-dyadic + apl-mul + apl-neg-m + (make-array (list 3) (list 2 3 4)) + (make-array (list 3) (list 1 2 3)))) + (list -2 -6 -12)) + +(apl-test + "compose-dyadic shape preserved" + (sh + (apl-compose-dyadic + apl-add + apl-neg-m + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 2 3) (list 1 1 1 1 1 1)))) + (list 2 3)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 6348f3c1..95f10e62 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -79,7 +79,7 @@ Core mapping: - [x] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table - [x] Inner product `f.g` — `+.×` is matrix multiply - [x] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` -- [ ] Compose `f∘g` — applies `g` first then `f` +- [x] Compose `f∘g` — applies `g` first then `f` - [ ] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point - [ ] Rank `f⍤k` — apply f at sub-rank k - [ ] At `@` — selective replace @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 7 — compose f∘g (apl-compose monadic f∘g x, apl-compose-dyadic dyadic f x (g y)); 182/182 tests - 2026-05-06: Phase 4 step 6 — commute f⍨ (apl-commute monadic dup, apl-commute-dyadic swap); 173/173 tests - 2026-05-06: Phase 4 step 5 — inner product f.g (apl-inner); +.× matrix multiply, ∧.= equal-vectors; 163/163 tests - 2026-05-06: Phase 4 step 4 — outer product ∘.f (apl-outer); rank-doubling result shape = a-shape++b-shape; 151/151 tests From 4dbd3a0b343940ccb6d1d70a318f4a8bde3e8141 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 23:32:26 +0000 Subject: [PATCH 29/45] =?UTF-8?q?apl:=20power=20f=E2=8D=A3n=20+=20fixed-po?= =?UTF-8?q?int=20f=E2=8D=A3=E2=89=A1=20(+9=20tests,=20191/191)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 17 ++++++++++ lib/apl/tests/operators.sx | 63 +++++++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 81 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 4ee5f295..9f0d9028 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -1066,3 +1066,20 @@ (define apl-compose (fn (f g x) (f (g x)))) (define apl-compose-dyadic (fn (f g x y) (f x (g y)))) + +(define + apl-power + (fn (f n x) (reduce (fn (acc i) (f acc)) x (range 0 n)))) + +(define + apl-power-fixed + (fn + (f x) + (let + ((next (f x))) + (if + (and + (equal? (get next :shape) (get x :shape)) + (equal? (get next :ravel) (get x :ravel))) + x + (apl-power-fixed f next))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 43d67fa2..532acf50 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -579,4 +579,65 @@ apl-neg-m (make-array (list 2 3) (list 1 2 3 4 5 6)) (make-array (list 2 3) (list 1 1 1 1 1 1)))) - (list 2 3)) \ No newline at end of file + (list 2 3)) + +(apl-test + "power n=0 identity" + (rv (apl-power (fn (a) (apl-add a (apl-scalar 1))) 0 (apl-scalar 5))) + (list 5)) + +(apl-test + "power increment by 3" + (rv (apl-power (fn (a) (apl-add a (apl-scalar 1))) 3 (apl-scalar 0))) + (list 3)) + +(apl-test + "power double 4 times = 16" + (rv (apl-power (fn (a) (apl-mul a (apl-scalar 2))) 4 (apl-scalar 1))) + (list 16)) + +(apl-test + "power on vector +5" + (rv + (apl-power + (fn (a) (apl-add a (apl-scalar 1))) + 5 + (make-array (list 3) (list 1 2 3)))) + (list 6 7 8)) + +(apl-test + "power on vector preserves shape" + (sh + (apl-power + (fn (a) (apl-add a (apl-scalar 1))) + 5 + (make-array (list 3) (list 1 2 3)))) + (list 3)) + +(apl-test + "power on matrix" + (rv + (apl-power + (fn (a) (apl-mul a (apl-scalar 3))) + 2 + (make-array (list 2 2) (list 1 2 3 4)))) + (list 9 18 27 36)) + +(apl-test + "power-fixed identity stops immediately" + (rv (apl-power-fixed (fn (a) a) (make-array (list 3) (list 1 2 3)))) + (list 1 2 3)) + +(apl-test + "power-fixed floor half scalar to 0" + (rv + (apl-power-fixed + (fn (a) (apl-floor (apl-div a (apl-scalar 2)))) + (apl-scalar 100))) + (list 0)) + +(apl-test + "power-fixed shape preserved" + (sh + (apl-power-fixed (fn (a) a) (make-array (list 2 2) (list 1 2 3 4)))) + (list 2 2)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 95f10e62..8b218fd0 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -80,7 +80,7 @@ Core mapping: - [x] Inner product `f.g` — `+.×` is matrix multiply - [x] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` - [x] Compose `f∘g` — applies `g` first then `f` -- [ ] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point +- [x] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point - [ ] Rank `f⍤k` — apply f at sub-rank k - [ ] At `@` — selective replace - [ ] 40+ tests in `lib/apl/tests/operators.sx` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 8 — power f⍣n (apl-power) + fixed-point f⍣≡ (apl-power-fixed); 191/191 tests - 2026-05-06: Phase 4 step 7 — compose f∘g (apl-compose monadic f∘g x, apl-compose-dyadic dyadic f x (g y)); 182/182 tests - 2026-05-06: Phase 4 step 6 — commute f⍨ (apl-commute monadic dup, apl-commute-dyadic swap); 173/173 tests - 2026-05-06: Phase 4 step 5 — inner product f.g (apl-inner); +.× matrix multiply, ∧.= equal-vectors; 163/163 tests From 9eecbde61e9c7d7f2f16c404f1d59451656f208f Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 00:00:14 +0000 Subject: [PATCH 30/45] =?UTF-8?q?apl:=20rank=20f=E2=8D=A4k=20cell=20decomp?= =?UTF-8?q?osition=20(+10=20tests,=20201/201)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 25 ++++++++++++++++ lib/apl/tests/operators.sx | 60 +++++++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 86 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 9f0d9028..7f6ba879 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -1083,3 +1083,28 @@ (equal? (get next :ravel) (get x :ravel))) x (apl-power-fixed f next))))) + +(define + apl-rank + (fn + (f k arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (let + ((rank (len shape))) + (if + (>= k rank) + (f arr) + (let + ((frame-shape (take shape (- rank k))) + (cell-shape (drop shape (- rank k)))) + (let + ((frame-size (reduce * 1 frame-shape)) + (cell-size (reduce * 1 cell-shape))) + (let + ((cells (map (fn (i) (let ((start (* i cell-size))) (make-array cell-shape (map (fn (j) (nth ravel (+ start j))) (range 0 cell-size))))) (range 0 frame-size)))) + (let + ((results (map (fn (c) (f c)) cells))) + (make-array + (append frame-shape (get (first results) :shape)) + (flatten (map (fn (r) (get r :ravel)) results)))))))))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 532acf50..39115a70 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -640,4 +640,62 @@ "power-fixed shape preserved" (sh (apl-power-fixed (fn (a) a) (make-array (list 2 2) (list 1 2 3 4)))) - (list 2 2)) \ No newline at end of file + (list 2 2)) + +(apl-test + "rank tally⍤1 row tallies" + (rv (apl-rank apl-tally 1 (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 3 3)) + +(apl-test + "rank tally⍤1 row tallies shape" + (sh (apl-rank apl-tally 1 (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2)) + +(apl-test + "rank neg⍤0 vector scalar cells" + (rv (apl-rank apl-neg-m 0 (make-array (list 3) (list 1 2 3)))) + (list -1 -2 -3)) + +(apl-test + "rank neg⍤0 vector preserves shape" + (sh (apl-rank apl-neg-m 0 (make-array (list 3) (list 1 2 3)))) + (list 3)) + +(apl-test + "rank neg⍤1 matrix per-row" + (rv (apl-rank apl-neg-m 1 (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list -1 -2 -3 -4 -5 -6)) + +(apl-test + "rank neg⍤1 matrix preserves shape" + (sh (apl-rank apl-neg-m 1 (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2 3)) + +(apl-test + "rank k>=rank fallthrough" + (rv (apl-rank apl-tally 5 (make-array (list 4) (list 1 2 3 4)))) + (list 4)) + +(apl-test + "rank tally⍤2 whole matrix tally" + (rv + (apl-rank + apl-tally + 2 + (make-array (list 3 5) (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))) + (list 3)) + +(apl-test + "rank reverse⍤1 matrix reverse rows" + (rv (apl-rank apl-reverse 1 (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 3 2 1 6 5 4)) + +(apl-test + "rank tally⍤1 3x4 row tallies" + (rv + (apl-rank + apl-tally + 1 + (make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12)))) + (list 4 4 4)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 8b218fd0..e22d3695 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -81,7 +81,7 @@ Core mapping: - [x] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` - [x] Compose `f∘g` — applies `g` first then `f` - [x] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point -- [ ] Rank `f⍤k` — apply f at sub-rank k +- [x] Rank `f⍤k` — apply f at sub-rank k - [ ] At `@` — selective replace - [ ] 40+ tests in `lib/apl/tests/operators.sx` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 4 step 9 — rank f⍤k (apl-rank); cell decomposition + reassembly via frame/cell shapes; 201/201 tests - 2026-05-06: Phase 4 step 8 — power f⍣n (apl-power) + fixed-point f⍣≡ (apl-power-fixed); 191/191 tests - 2026-05-06: Phase 4 step 7 — compose f∘g (apl-compose monadic f∘g x, apl-compose-dyadic dyadic f x (g y)); 182/182 tests - 2026-05-06: Phase 4 step 6 — commute f⍨ (apl-commute monadic dup, apl-commute-dyadic swap); 173/173 tests From 4c71c5a75efc520f34eaed1294d983c57316f391 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 00:27:40 +0000 Subject: [PATCH 31/45] apl: at @ replace+apply (+10 tests, 211/211) --- lib/apl/runtime.sx | 44 ++++++++++++++++++ lib/apl/tests/operators.sx | 92 +++++++++++++++++++++++++++++++++++++- plans/apl-on-sx.md | 3 +- 3 files changed, 137 insertions(+), 2 deletions(-) diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 7f6ba879..cff8957d 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -1108,3 +1108,47 @@ (make-array (append frame-shape (get (first results) :shape)) (flatten (map (fn (r) (get r :ravel)) results)))))))))))) + +(define + apl-at-replace + (fn + (vals idxs arr) + (let + ((vals-ravel (get vals :ravel)) + (idxs-ravel (get idxs :ravel)) + (arr-ravel (get arr :ravel)) + (arr-shape (get arr :shape)) + (vals-scalar? (= (len (get vals :shape)) 0))) + (make-array + arr-shape + (map + (fn + (i) + (let + ((pos (index-of idxs-ravel (+ i apl-io)))) + (if + pos + (if vals-scalar? (first vals-ravel) (nth vals-ravel pos)) + (nth arr-ravel i)))) + (range 0 (len arr-ravel))))))) + +(define + apl-at-apply + (fn + (f idxs arr) + (let + ((idxs-ravel (get idxs :ravel)) + (arr-ravel (get arr :ravel)) + (arr-shape (get arr :shape))) + (make-array + arr-shape + (map + (fn + (i) + (let + ((pos (index-of idxs-ravel (+ i apl-io)))) + (if + pos + (disclose (f (apl-scalar (nth arr-ravel i)))) + (nth arr-ravel i)))) + (range 0 (len arr-ravel))))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index 39115a70..afd21895 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -698,4 +698,94 @@ apl-tally 1 (make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12)))) - (list 4 4 4)) \ No newline at end of file + (list 4 4 4)) + +(apl-test + "at-replace single index" + (rv + (apl-at-replace + (apl-scalar 99) + (make-array (list 1) (list 2)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 99 3 4 5)) + +(apl-test + "at-replace multiple indices vector vals" + (rv + (apl-at-replace + (make-array (list 2) (list 99 88)) + (make-array (list 2) (list 2 4)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 99 3 88 5)) + +(apl-test + "at-replace scalar broadcast" + (rv + (apl-at-replace + (apl-scalar 0) + (make-array (list 3) (list 1 3 5)) + (make-array (list 5) (list 10 20 30 40 50)))) + (list 0 20 0 40 0)) + +(apl-test + "at-replace preserves shape" + (sh + (apl-at-replace + (apl-scalar 99) + (make-array (list 1) (list 2)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list 5)) + +(apl-test + "at-replace last index" + (rv + (apl-at-replace + (apl-scalar 99) + (make-array (list 1) (list 5)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 3 4 99)) + +(apl-test + "at-replace on matrix linear-index" + (rv + (apl-at-replace + (apl-scalar 99) + (make-array (list 1) (list 3)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2 99 4 5 6)) + +(apl-test + "at-apply negate at indices" + (rv + (apl-at-apply + apl-neg-m + (make-array (list 3) (list 1 3 5)) + (make-array (list 5) (list 1 2 3 4 5)))) + (list -1 2 -3 4 -5)) + +(apl-test + "at-apply double at index 1" + (rv + (apl-at-apply + (fn (a) (apl-mul a (apl-scalar 2))) + (make-array (list 1) (list 1)) + (make-array (list 2) (list 5 10)))) + (list 10 10)) + +(apl-test + "at-apply preserves shape" + (sh + (apl-at-apply + apl-neg-m + (make-array (list 2) (list 1 3)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 2 3)) + +(apl-test + "at-apply on matrix linear-index" + (rv + (apl-at-apply + apl-neg-m + (make-array (list 2) (list 1 6)) + (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list -1 2 3 4 5 -6)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index e22d3695..de380cf4 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -82,7 +82,7 @@ Core mapping: - [x] Compose `f∘g` — applies `g` first then `f` - [x] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point - [x] Rank `f⍤k` — apply f at sub-rank k -- [ ] At `@` — selective replace +- [x] At `@` — selective replace - [ ] 40+ tests in `lib/apl/tests/operators.sx` ### Phase 5 — dfns + tradfns + control flow @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 4 step 10 — at @ (apl-at-replace + apl-at-apply); linear-index lookup, scalar-vals broadcast; 211/211 tests - 2026-05-07: Phase 4 step 9 — rank f⍤k (apl-rank); cell decomposition + reassembly via frame/cell shapes; 201/201 tests - 2026-05-06: Phase 4 step 8 — power f⍣n (apl-power) + fixed-point f⍣≡ (apl-power-fixed); 191/191 tests - 2026-05-06: Phase 4 step 7 — compose f∘g (apl-compose monadic f∘g x, apl-compose-dyadic dyadic f x (g y)); 182/182 tests From 3628a504db1fa8be76061370676dc194dbb19fca Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 00:27:55 +0000 Subject: [PATCH 32/45] plans: tick Phase 4 40+ tests (operators.sx has 117) --- plans/apl-on-sx.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index de380cf4..b181f7bd 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -83,7 +83,7 @@ Core mapping: - [x] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point - [x] Rank `f⍤k` — apply f at sub-rank k - [x] At `@` — selective replace -- [ ] 40+ tests in `lib/apl/tests/operators.sx` +- [x] 40+ tests in `lib/apl/tests/operators.sx` ### Phase 5 — dfns + tradfns + control flow - [ ] Dfn `{…}` with `⍺` (left arg, may be absent → niladic/monadic), `⍵` (right arg), `∇` (recurse), guards `cond:expr`, default left arg `⍺←default` From 84d210b6b3f612c24cb774962516ef27991770ea Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 00:57:59 +0000 Subject: [PATCH 33/45] =?UTF-8?q?apl:=20dfn=20foundation=20=E2=80=94=20tra?= =?UTF-8?q?nspile.sx=20+=20apl-eval-ast=20(+15=20tests,=20226/226)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/test.sh | 2 + lib/apl/tests/dfn.sx | 107 ++++++++++++++++++++++++++++++++ lib/apl/transpile.sx | 141 +++++++++++++++++++++++++++++++++++++++++++ plans/apl-on-sx.md | 1 + 4 files changed, 251 insertions(+) create mode 100644 lib/apl/tests/dfn.sx create mode 100644 lib/apl/transpile.sx diff --git a/lib/apl/test.sh b/lib/apl/test.sh index 36c39ec1..91f70c07 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -19,6 +19,7 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 1) (load "spec/stdlib.sx") (load "lib/apl/runtime.sx") +(load "lib/apl/transpile.sx") (epoch 2) (eval "(define apl-test-pass 0)") (eval "(define apl-test-fail 0)") @@ -27,6 +28,7 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 3) (load "lib/apl/tests/structural.sx") (load "lib/apl/tests/operators.sx") +(load "lib/apl/tests/dfn.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/dfn.sx b/lib/apl/tests/dfn.sx new file mode 100644 index 00000000..fbd58b6f --- /dev/null +++ b/lib/apl/tests/dfn.sx @@ -0,0 +1,107 @@ +; Tests for apl-eval-ast and apl-call-dfn (manual AST construction). + +(define rv (fn (arr) (get arr :ravel))) +(define sh (fn (arr) (get arr :shape))) + +(define num (fn (n) (list :num n))) +(define name (fn (s) (list :name s))) +(define fnglyph (fn (g) (list :fn-glyph g))) +(define monad (fn (g a) (list :monad (fnglyph g) a))) +(define dyad (fn (g l r) (list :dyad (fnglyph g) l r))) +(define dfn (fn (body) (list :dfn body))) +(define prog (fn (stmts) (cons :program stmts))) + +(apl-test + "eval :num literal" + (rv (apl-eval-ast (num 42) {})) + (list 42)) + +(apl-test + "eval :num literal shape" + (sh (apl-eval-ast (num 42) {})) + (list)) + +(apl-test + "eval :dyad +" + (rv (apl-eval-ast (dyad "+" (num 2) (num 3)) {})) + (list 5)) + +(apl-test + "eval :dyad ×" + (rv (apl-eval-ast (dyad "×" (num 6) (num 7)) {})) + (list 42)) + +(apl-test + "eval :monad - (negate)" + (rv (apl-eval-ast (monad "-" (num 7)) {})) + (list -7)) + +(apl-test + "eval :monad ⌊ (floor)" + (rv (apl-eval-ast (monad "⌊" (num 3)) {})) + (list 3)) + +(apl-test + "eval :name ⍵ from env" + (rv (apl-eval-ast (name "⍵") {:omega (apl-scalar 99) :alpha nil})) + (list 99)) + +(apl-test + "eval :name ⍺ from env" + (rv (apl-eval-ast (name "⍺") {:omega nil :alpha (apl-scalar 7)})) + (list 7)) + +(apl-test + "dfn {⍵+1} called monadic" + (rv + (apl-call-dfn-m (dfn (dyad "+" (name "⍵") (num 1))) (apl-scalar 5))) + (list 6)) + +(apl-test + "dfn {⍺+⍵} called dyadic" + (rv + (apl-call-dfn + (dfn (dyad "+" (name "⍺") (name "⍵"))) + (apl-scalar 4) + (apl-scalar 9))) + (list 13)) + +(apl-test + "dfn {⍺×⍵} dyadic on vectors" + (rv + (apl-call-dfn + (dfn (dyad "×" (name "⍺") (name "⍵"))) + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 10 20 30)))) + (list 10 40 90)) + +(apl-test + "dfn {-⍵} monadic negate" + (rv + (apl-call-dfn-m + (dfn (monad "-" (name "⍵"))) + (make-array (list 3) (list 1 2 3)))) + (list -1 -2 -3)) + +(apl-test + "dfn {⍺-⍵} dyadic subtract scalar" + (rv + (apl-call-dfn + (dfn (dyad "-" (name "⍺") (name "⍵"))) + (apl-scalar 10) + (apl-scalar 3))) + (list 7)) + +(apl-test + "dfn {⌈⍺,⍵} not used (just verify : missing) — ceiling of right" + (rv (apl-call-dfn-m (dfn (monad "⌈" (name "⍵"))) (apl-scalar 5))) + (list 5)) + +(apl-test + "dfn nested dyad" + (rv + (apl-call-dfn + (dfn (dyad "+" (name "⍺") (dyad "×" (name "⍵") (num 2)))) + (apl-scalar 1) + (apl-scalar 3))) + (list 7)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx new file mode 100644 index 00000000..580c25cb --- /dev/null +++ b/lib/apl/transpile.sx @@ -0,0 +1,141 @@ +; APL transpile / AST evaluator +; +; Walks parsed AST nodes and evaluates against the runtime. +; Entry points: +; apl-eval-ast : node × env → value +; apl-call-dfn : dfn-ast × ⍺ × ⍵ → value (dyadic) +; apl-call-dfn-m : dfn-ast × ⍵ → value (monadic) +; +; Env is a dict; ⍺ stored under key "alpha", ⍵ under "omega", +; user names under their literal name. nil means absent. + +(define + apl-monadic-fn + (fn + (g) + (cond + ((= g "+") apl-plus-m) + ((= g "-") apl-neg-m) + ((= g "×") apl-signum) + ((= g "÷") apl-recip) + ((= g "⌈") apl-ceil) + ((= g "⌊") apl-floor) + ((= g "⍳") apl-iota) + ((= g "|") apl-abs) + ((= g "*") apl-exp) + ((= g "⍟") apl-ln) + ((= g "!") apl-fact) + ((= g "○") apl-pi-times) + ((= g "~") apl-not) + ((= g "≢") apl-tally) + ((= g "⍴") apl-shape) + ((= g "≡") apl-depth) + ((= g "⊂") apl-enclose) + ((= g "⊃") apl-disclose) + ((= g ",") apl-ravel) + ((= g "⌽") apl-reverse) + ((= g "⊖") apl-reverse-first) + ((= g "⍋") apl-grade-up) + ((= g "⍒") apl-grade-down) + (else (error "no monadic fn for glyph"))))) + +(define + apl-dyadic-fn + (fn + (g) + (cond + ((= g "+") apl-add) + ((= g "-") apl-sub) + ((= g "×") apl-mul) + ((= g "÷") apl-div) + ((= g "⌈") apl-max) + ((= g "⌊") apl-min) + ((= g "*") apl-pow) + ((= g "⍟") apl-log) + ((= g "|") apl-mod) + ((= g "!") apl-binomial) + ((= g "○") apl-trig) + ((= g "<") apl-lt) + ((= g "≤") apl-le) + ((= g "=") apl-eq) + ((= g "≥") apl-ge) + ((= g ">") apl-gt) + ((= g "≠") apl-ne) + ((= g "∧") apl-and) + ((= g "∨") apl-or) + ((= g "⍱") apl-nor) + ((= g "⍲") apl-nand) + ((= g ",") apl-catenate) + ((= g "⍪") apl-catenate-first) + ((= g "⍴") apl-reshape) + ((= g "↑") apl-take) + ((= g "↓") apl-drop) + ((= g "⌷") apl-squad) + ((= g "⌽") apl-rotate) + ((= g "⊖") apl-rotate-first) + ((= g "∊") apl-member) + ((= g "⍳") apl-index-of) + ((= g "~") apl-without) + (else (error "no dyadic fn for glyph"))))) + +(define + apl-eval-ast + (fn + (node env) + (let + ((tag (first node))) + (cond + ((= tag :num) (apl-scalar (nth node 1))) + ((= tag :vec) + (let + ((items (rest node))) + (let + ((vals (map (fn (n) (apl-eval-ast n env)) items))) + (make-array + (list (len vals)) + (map (fn (v) (first (get v :ravel))) vals))))) + ((= tag :name) + (let + ((nm (nth node 1))) + (cond + ((= nm "⍺") (get env "alpha")) + ((= nm "⍵") (get env "omega")) + (else (get env nm))))) + ((= tag :monad) + (let + ((fn-node (nth node 1)) (arg (nth node 2))) + (let + ((g (nth fn-node 1))) + ((apl-monadic-fn g) (apl-eval-ast arg env))))) + ((= tag :dyad) + (let + ((fn-node (nth node 1)) + (lhs (nth node 2)) + (rhs (nth node 3))) + (let + ((g (nth fn-node 1))) + ((apl-dyadic-fn g) + (apl-eval-ast lhs env) + (apl-eval-ast rhs env))))) + ((= tag :program) + (let + ((stmts (rest node))) + (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts))) + ((= tag :dfn) node) + (else (error "apl-eval-ast: unknown node tag")))))) + +(define + apl-call-dfn + (fn + (dfn-ast alpha omega) + (let + ((stmts (rest dfn-ast)) (env {:omega omega :alpha alpha})) + (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts)))) + +(define + apl-call-dfn-m + (fn + (dfn-ast omega) + (let + ((stmts (rest dfn-ast)) (env {:omega omega :alpha nil})) + (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts)))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index b181f7bd..4a396cb1 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 5 dfn foundation — lib/apl/transpile.sx with apl-eval-ast (handles :num :vec :name :monad :dyad :program :dfn) + glyph→fn lookup tables; apl-call-dfn / apl-call-dfn-m bind ⍺/⍵; ∇/guards/defaults/locals pending; 226/226 tests - 2026-05-07: Phase 4 step 10 — at @ (apl-at-replace + apl-at-apply); linear-index lookup, scalar-vals broadcast; 211/211 tests - 2026-05-07: Phase 4 step 9 — rank f⍤k (apl-rank); cell decomposition + reassembly via frame/cell shapes; 201/201 tests - 2026-05-06: Phase 4 step 8 — power f⍣n (apl-power) + fixed-point f⍣≡ (apl-power-fixed); 191/191 tests From 16167c5d9b92650043d4214f2469cc9dbb314908 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 01:44:19 +0000 Subject: [PATCH 34/45] =?UTF-8?q?apl:=20dfn=20complete=20=E2=80=94=20guard?= =?UTF-8?q?s,=20locals,=20=E2=88=87=20recursion,=20=E2=8D=BA=E2=86=90=20de?= =?UTF-8?q?fault=20(+9=20tests,=20235/235)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/tests/dfn.sx | 164 +++++++++++++++++++++++++++++++++++++------ lib/apl/transpile.sx | 85 +++++++++++++++++----- plans/apl-on-sx.md | 5 +- 3 files changed, 212 insertions(+), 42 deletions(-) diff --git a/lib/apl/tests/dfn.sx b/lib/apl/tests/dfn.sx index fbd58b6f..0f22ad51 100644 --- a/lib/apl/tests/dfn.sx +++ b/lib/apl/tests/dfn.sx @@ -3,65 +3,73 @@ (define rv (fn (arr) (get arr :ravel))) (define sh (fn (arr) (get arr :shape))) -(define num (fn (n) (list :num n))) -(define name (fn (s) (list :name s))) -(define fnglyph (fn (g) (list :fn-glyph g))) -(define monad (fn (g a) (list :monad (fnglyph g) a))) -(define dyad (fn (g l r) (list :dyad (fnglyph g) l r))) -(define dfn (fn (body) (list :dfn body))) -(define prog (fn (stmts) (cons :program stmts))) +(define mknum (fn (n) (list :num n))) +(define mkname (fn (s) (list :name s))) +(define mkfg (fn (g) (list :fn-glyph g))) +(define mkmon (fn (g a) (list :monad (mkfg g) a))) +(define mkdyd (fn (g l r) (list :dyad (mkfg g) l r))) +(define mkdfn1 (fn (body) (list :dfn body))) +(define mkprog (fn (stmts) (cons :program stmts))) + +(define mkasg (fn (mkname expr) (list :assign mkname expr))) + +(define mkgrd (fn (c e) (list :guard c e))) + +(define mkdfn (fn (stmts) (cons :dfn stmts))) (apl-test "eval :num literal" - (rv (apl-eval-ast (num 42) {})) + (rv (apl-eval-ast (mknum 42) {})) (list 42)) (apl-test "eval :num literal shape" - (sh (apl-eval-ast (num 42) {})) + (sh (apl-eval-ast (mknum 42) {})) (list)) (apl-test "eval :dyad +" - (rv (apl-eval-ast (dyad "+" (num 2) (num 3)) {})) + (rv (apl-eval-ast (mkdyd "+" (mknum 2) (mknum 3)) {})) (list 5)) (apl-test "eval :dyad ×" - (rv (apl-eval-ast (dyad "×" (num 6) (num 7)) {})) + (rv (apl-eval-ast (mkdyd "×" (mknum 6) (mknum 7)) {})) (list 42)) (apl-test "eval :monad - (negate)" - (rv (apl-eval-ast (monad "-" (num 7)) {})) + (rv (apl-eval-ast (mkmon "-" (mknum 7)) {})) (list -7)) (apl-test "eval :monad ⌊ (floor)" - (rv (apl-eval-ast (monad "⌊" (num 3)) {})) + (rv (apl-eval-ast (mkmon "⌊" (mknum 3)) {})) (list 3)) (apl-test "eval :name ⍵ from env" - (rv (apl-eval-ast (name "⍵") {:omega (apl-scalar 99) :alpha nil})) + (rv (apl-eval-ast (mkname "⍵") {:omega (apl-scalar 99) :alpha nil})) (list 99)) (apl-test "eval :name ⍺ from env" - (rv (apl-eval-ast (name "⍺") {:omega nil :alpha (apl-scalar 7)})) + (rv (apl-eval-ast (mkname "⍺") {:omega nil :alpha (apl-scalar 7)})) (list 7)) (apl-test "dfn {⍵+1} called monadic" (rv - (apl-call-dfn-m (dfn (dyad "+" (name "⍵") (num 1))) (apl-scalar 5))) + (apl-call-dfn-m + (mkdfn1 (mkdyd "+" (mkname "⍵") (mknum 1))) + (apl-scalar 5))) (list 6)) (apl-test "dfn {⍺+⍵} called dyadic" (rv (apl-call-dfn - (dfn (dyad "+" (name "⍺") (name "⍵"))) + (mkdfn1 (mkdyd "+" (mkname "⍺") (mkname "⍵"))) (apl-scalar 4) (apl-scalar 9))) (list 13)) @@ -70,7 +78,7 @@ "dfn {⍺×⍵} dyadic on vectors" (rv (apl-call-dfn - (dfn (dyad "×" (name "⍺") (name "⍵"))) + (mkdfn1 (mkdyd "×" (mkname "⍺") (mkname "⍵"))) (make-array (list 3) (list 1 2 3)) (make-array (list 3) (list 10 20 30)))) (list 10 40 90)) @@ -79,7 +87,7 @@ "dfn {-⍵} monadic negate" (rv (apl-call-dfn-m - (dfn (monad "-" (name "⍵"))) + (mkdfn1 (mkmon "-" (mkname "⍵"))) (make-array (list 3) (list 1 2 3)))) (list -1 -2 -3)) @@ -87,21 +95,133 @@ "dfn {⍺-⍵} dyadic subtract scalar" (rv (apl-call-dfn - (dfn (dyad "-" (name "⍺") (name "⍵"))) + (mkdfn1 (mkdyd "-" (mkname "⍺") (mkname "⍵"))) (apl-scalar 10) (apl-scalar 3))) (list 7)) (apl-test "dfn {⌈⍺,⍵} not used (just verify : missing) — ceiling of right" - (rv (apl-call-dfn-m (dfn (monad "⌈" (name "⍵"))) (apl-scalar 5))) + (rv + (apl-call-dfn-m (mkdfn1 (mkmon "⌈" (mkname "⍵"))) (apl-scalar 5))) (list 5)) (apl-test "dfn nested dyad" (rv (apl-call-dfn - (dfn (dyad "+" (name "⍺") (dyad "×" (name "⍵") (num 2)))) + (mkdfn1 + (mkdyd "+" (mkname "⍺") (mkdyd "×" (mkname "⍵") (mknum 2)))) (apl-scalar 1) (apl-scalar 3))) (list 7)) + +(apl-test + "dfn local assign x←⍵+1; ⍺×x" + (rv + (apl-call-dfn + (mkdfn + (list + (mkasg "x" (mkdyd "+" (mkname "⍵") (mknum 1))) + (mkdyd "×" (mkname "⍺") (mkname "x")))) + (apl-scalar 3) + (apl-scalar 4))) + (list 15)) + +(apl-test + "dfn guard: 0=⍵:99; ⍵×2 (true branch)" + (rv + (apl-call-dfn-m + (mkdfn + (list + (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 99)) + (mkdyd "×" (mkname "⍵") (mknum 2)))) + (apl-scalar 0))) + (list 99)) + +(apl-test + "dfn guard: 0=⍵:99; ⍵×2 (false branch)" + (rv + (apl-call-dfn-m + (mkdfn + (list + (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 99)) + (mkdyd "×" (mkname "⍵") (mknum 2)))) + (apl-scalar 5))) + (list 10)) + +(apl-test + "dfn default ⍺←10 used (monadic call)" + (rv + (apl-call-dfn-m + (mkdfn + (list + (mkasg "⍺" (mknum 10)) + (mkdyd "+" (mkname "⍺") (mkname "⍵")))) + (apl-scalar 5))) + (list 15)) + +(apl-test + "dfn default ⍺←10 ignored when ⍺ given (dyadic call)" + (rv + (apl-call-dfn + (mkdfn + (list + (mkasg "⍺" (mknum 10)) + (mkdyd "+" (mkname "⍺") (mkname "⍵")))) + (apl-scalar 100) + (apl-scalar 5))) + (list 105)) + +(apl-test + "dfn ∇ recursion: factorial via guard" + (rv + (apl-call-dfn-m + (mkdfn + (list + (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 1)) + (mkdyd + "×" + (mkname "⍵") + (mkmon "∇" (mkdyd "-" (mkname "⍵") (mknum 1)))))) + (apl-scalar 5))) + (list 120)) + +(apl-test + "dfn ∇ recursion: 3 → 6 (factorial)" + (rv + (apl-call-dfn-m + (mkdfn + (list + (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 1)) + (mkdyd + "×" + (mkname "⍵") + (mkmon "∇" (mkdyd "-" (mkname "⍵") (mknum 1)))))) + (apl-scalar 3))) + (list 6)) + +(apl-test + "dfn local: x←⍵+10; y←x×2; y" + (rv + (apl-call-dfn-m + (mkdfn + (list + (mkasg "x" (mkdyd "+" (mkname "⍵") (mknum 10))) + (mkasg "y" (mkdyd "×" (mkname "x") (mknum 2))) + (mkname "y"))) + (apl-scalar 5))) + (list 30)) + +(apl-test + "dfn first guard wins: many guards" + (rv + (apl-call-dfn-m + (mkdfn + (list + (mkgrd (mkdyd "=" (mknum 1) (mkname "⍵")) (mknum 100)) + (mkgrd (mkdyd "=" (mknum 2) (mkname "⍵")) (mknum 200)) + (mkgrd (mkdyd "=" (mknum 3) (mkname "⍵")) (mknum 300)) + (mknum 0))) + (apl-scalar 2))) + (list 200)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 580c25cb..871a69c2 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -2,12 +2,14 @@ ; ; Walks parsed AST nodes and evaluates against the runtime. ; Entry points: -; apl-eval-ast : node × env → value -; apl-call-dfn : dfn-ast × ⍺ × ⍵ → value (dyadic) -; apl-call-dfn-m : dfn-ast × ⍵ → value (monadic) +; apl-eval-ast : node × env → value +; apl-eval-stmts : stmt-list × env → value (handles guards, locals, ⍺← default) +; apl-call-dfn : dfn-ast × ⍺ × ⍵ → value (dyadic) +; apl-call-dfn-m : dfn-ast × ⍵ → value (monadic) ; -; Env is a dict; ⍺ stored under key "alpha", ⍵ under "omega", -; user names under their literal name. nil means absent. +; Env is a dict; ⍺ stored under "alpha", ⍵ under "omega", +; the dfn-ast itself under "nabla" (for ∇ recursion), +; user names under their literal name. (define apl-monadic-fn @@ -78,6 +80,14 @@ ((= g "~") apl-without) (else (error "no dyadic fn for glyph"))))) +(define + apl-truthy? + (fn + (v) + (let + ((rv (get v :ravel))) + (if (and (= (len rv) 1) (= (first rv) 0)) false true)))) + (define apl-eval-ast (fn @@ -106,7 +116,10 @@ ((fn-node (nth node 1)) (arg (nth node 2))) (let ((g (nth fn-node 1))) - ((apl-monadic-fn g) (apl-eval-ast arg env))))) + (if + (= g "∇") + (apl-call-dfn-m (get env "nabla") (apl-eval-ast arg env)) + ((apl-monadic-fn g) (apl-eval-ast arg env)))))) ((= tag :dyad) (let ((fn-node (nth node 1)) @@ -114,28 +127,64 @@ (rhs (nth node 3))) (let ((g (nth fn-node 1))) - ((apl-dyadic-fn g) - (apl-eval-ast lhs env) - (apl-eval-ast rhs env))))) - ((= tag :program) - (let - ((stmts (rest node))) - (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts))) + (if + (= g "∇") + (apl-call-dfn + (get env "nabla") + (apl-eval-ast lhs env) + (apl-eval-ast rhs env)) + ((apl-dyadic-fn g) + (apl-eval-ast lhs env) + (apl-eval-ast rhs env)))))) + ((= tag :program) (apl-eval-stmts (rest node) env)) ((= tag :dfn) node) - (else (error "apl-eval-ast: unknown node tag")))))) + (else (error (list "apl-eval-ast: unknown node tag" tag node))))))) + +(define + apl-eval-stmts + (fn + (stmts env) + (if + (= (len stmts) 0) + nil + (let + ((stmt (first stmts)) (more (rest stmts))) + (let + ((tag (first stmt))) + (cond + ((= tag :guard) + (let + ((cond-val (apl-eval-ast (nth stmt 1) env))) + (if + (apl-truthy? cond-val) + (apl-eval-ast (nth stmt 2) env) + (apl-eval-stmts more env)))) + ((and (= tag :assign) (= (nth stmt 1) "⍺")) + (if + (get env "alpha") + (apl-eval-stmts more env) + (let + ((v (apl-eval-ast (nth stmt 2) env))) + (apl-eval-stmts more (assoc env "alpha" v))))) + ((= tag :assign) + (let + ((v (apl-eval-ast (nth stmt 2) env))) + (apl-eval-stmts more (assoc env (nth stmt 1) v)))) + ((= (len more) 0) (apl-eval-ast stmt env)) + (else (begin (apl-eval-ast stmt env) (apl-eval-stmts more env))))))))) (define apl-call-dfn (fn (dfn-ast alpha omega) (let - ((stmts (rest dfn-ast)) (env {:omega omega :alpha alpha})) - (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts)))) + ((stmts (rest dfn-ast)) (env {:omega omega :nabla dfn-ast :alpha alpha})) + (apl-eval-stmts stmts env)))) (define apl-call-dfn-m (fn (dfn-ast omega) (let - ((stmts (rest dfn-ast)) (env {:omega omega :alpha nil})) - (reduce (fn (acc s) (apl-eval-ast s env)) nil stmts)))) + ((stmts (rest dfn-ast)) (env {:omega omega :nabla dfn-ast :alpha nil})) + (apl-eval-stmts stmts env)))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 4a396cb1..afd9808e 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -86,8 +86,8 @@ Core mapping: - [x] 40+ tests in `lib/apl/tests/operators.sx` ### Phase 5 — dfns + tradfns + control flow -- [ ] Dfn `{…}` with `⍺` (left arg, may be absent → niladic/monadic), `⍵` (right arg), `∇` (recurse), guards `cond:expr`, default left arg `⍺←default` -- [ ] Local assignment via `←` (lexical inside dfn) +- [x] Dfn `{…}` with `⍺` (left arg, may be absent → niladic/monadic), `⍵` (right arg), `∇` (recurse), guards `cond:expr`, default left arg `⍺←default` +- [x] Local assignment via `←` (lexical inside dfn) - [ ] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` - [ ] Dyalog control words: `:If/:Else/:EndIf`, `:While/:EndWhile`, `:For X :In V :EndFor`, `:Select/:Case/:EndSelect`, `:Trap`/`:EndTrap` - [ ] Niladic / monadic / dyadic dispatch (function valence at definition time) @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 5 dfn complete — apl-eval-stmts (guards, locals, ⍺←default), ∇ recursion via env "nabla"; +9 tests (factorial, guards, defaults, locals); 235/235 tests - 2026-05-07: Phase 5 dfn foundation — lib/apl/transpile.sx with apl-eval-ast (handles :num :vec :name :monad :dyad :program :dfn) + glyph→fn lookup tables; apl-call-dfn / apl-call-dfn-m bind ⍺/⍵; ∇/guards/defaults/locals pending; 226/226 tests - 2026-05-07: Phase 4 step 10 — at @ (apl-at-replace + apl-at-apply); linear-index lookup, scalar-vals broadcast; 211/211 tests - 2026-05-07: Phase 4 step 9 — rank f⍤k (apl-rank); cell decomposition + reassembly via frame/cell shapes; 201/201 tests From 1900726fc9b11239346fd6de24ca54cdc44cf61b Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 02:13:00 +0000 Subject: [PATCH 35/45] =?UTF-8?q?apl:=20tradfn=20=E2=88=87=20header=20?= =?UTF-8?q?=E2=80=94=20line-numbered=20stmts=20+=20:branch=20goto=20(+10?= =?UTF-8?q?=20tests,=20245/245)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/test.sh | 1 + lib/apl/tests/tradfn.sx | 65 +++++++++++++++++++++++++++++++++++++++++ lib/apl/transpile.sx | 47 +++++++++++++++++++++++++++++ plans/apl-on-sx.md | 3 +- 4 files changed, 115 insertions(+), 1 deletion(-) create mode 100644 lib/apl/tests/tradfn.sx diff --git a/lib/apl/test.sh b/lib/apl/test.sh index 91f70c07..2f8044a7 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -29,6 +29,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/apl/tests/structural.sx") (load "lib/apl/tests/operators.sx") (load "lib/apl/tests/dfn.sx") +(load "lib/apl/tests/tradfn.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/tradfn.sx b/lib/apl/tests/tradfn.sx new file mode 100644 index 00000000..06f79e5c --- /dev/null +++ b/lib/apl/tests/tradfn.sx @@ -0,0 +1,65 @@ +; Tests for apl-call-tradfn (manual structure construction). + +(define mkrv (fn (arr) (get arr :ravel))) +(define mksh (fn (arr) (get arr :shape))) +(define mknum (fn (n) (list :num n))) +(define mknm (fn (s) (list :name s))) +(define mkfg (fn (g) (list :fn-glyph g))) +(define mkmon (fn (g a) (list :monad (mkfg g) a))) +(define mkdyd (fn (g l r) (list :dyad (mkfg g) l r))) +(define mkasg (fn (n e) (list :assign n e))) +(define mkbr (fn (e) (list :branch e))) + +(apl-test + "tradfn R←L+W simple add" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "+" (mknm "L") (mknm "W")))) :alpha "L"} (apl-scalar 5) (apl-scalar 7))) + (list 12)) + +(apl-test + "tradfn R←L×W" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "×" (mknm "L") (mknm "W")))) :alpha "L"} (apl-scalar 6) (apl-scalar 7))) + (list 42)) + +(apl-test + "tradfn monadic R←-W" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkmon "-" (mknm "W")))) :alpha nil} nil (apl-scalar 9))) + (list -9)) + +(apl-test + "tradfn →0 exits early" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknm "W")) (mkbr (mknum 0)) (mkasg "R" (mknum 999))) :alpha nil} nil (apl-scalar 7))) + (list 7)) + +(apl-test + "tradfn branch to line 3 skips line 2" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkbr (mknum 3)) (mkasg "R" (mknum 999)) (mkasg "R" (mknum 42))) :alpha nil} nil (apl-scalar 0))) + (list 42)) + +(apl-test + "tradfn local var t←W+1; R←t×2" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "t" (mkdyd "+" (mknm "W") (mknum 1))) (mkasg "R" (mkdyd "×" (mknm "t") (mknum 2)))) :alpha nil} nil (apl-scalar 5))) + (list 12)) + +(apl-test + "tradfn vector args" + (mkrv + (apl-call-tradfn + {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "+" (mknm "L") (mknm "W")))) :alpha "L"} + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 10 20 30)))) + (list 11 22 33)) + +(apl-test + "tradfn unset result returns nil" + (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkbr (mknum 0))) :alpha nil} nil (apl-scalar 5)) + nil) + +(apl-test + "tradfn run-off end returns result" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "×" (mknm "W") (mknum 3)))) :alpha nil} nil (apl-scalar 7))) + (list 21)) + +(apl-test + "tradfn loop sum 1+2+...+5 via branch" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "i" (mknum 1)) (mkasg "R" (mknum 0)) (mkasg "R" (mkdyd "+" (mknm "R") (mknm "i"))) (mkasg "i" (mkdyd "+" (mknm "i") (mknum 1))) (mkbr (mkdyd "×" (mkdyd "≤" (mknm "i") (mknm "W")) (mknum 3)))) :alpha nil} nil (apl-scalar 5))) + (list 15)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 871a69c2..8d54fa97 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -188,3 +188,50 @@ (let ((stmts (rest dfn-ast)) (env {:omega omega :nabla dfn-ast :alpha nil})) (apl-eval-stmts stmts env)))) + +(define + apl-tradfn-loop + (fn + (stmts line env result-name) + (cond + ((= line 0) (get env result-name)) + ((> line (len stmts)) (get env result-name)) + (else + (let + ((stmt (nth stmts (- line 1)))) + (let + ((tag (first stmt))) + (cond + ((= tag :branch) + (let + ((target (apl-eval-ast (nth stmt 1) env))) + (let + ((target-num (first (get target :ravel)))) + (apl-tradfn-loop stmts target-num env result-name)))) + ((= tag :assign) + (let + ((v (apl-eval-ast (nth stmt 2) env))) + (apl-tradfn-loop + stmts + (+ line 1) + (assoc env (nth stmt 1) v) + result-name))) + (else + (begin + (apl-eval-ast stmt env) + (apl-tradfn-loop stmts (+ line 1) env result-name)))))))))) + +(define + apl-call-tradfn + (fn + (tradfn alpha omega) + (let + ((stmts (get tradfn :stmts)) + (result-name (get tradfn :result)) + (alpha-name (get tradfn :alpha)) + (omega-name (get tradfn :omega))) + (let + ((env-a (if alpha-name (assoc {} alpha-name alpha) {}))) + (let + ((env-ao (if omega-name (assoc env-a omega-name omega) env-a))) + (apl-tradfn-loop stmts 1 env-ao result-name)))))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index afd9808e..94cbd541 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -88,7 +88,7 @@ Core mapping: ### Phase 5 — dfns + tradfns + control flow - [x] Dfn `{…}` with `⍺` (left arg, may be absent → niladic/monadic), `⍵` (right arg), `∇` (recurse), guards `cond:expr`, default left arg `⍺←default` - [x] Local assignment via `←` (lexical inside dfn) -- [ ] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` +- [x] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` - [ ] Dyalog control words: `:If/:Else/:EndIf`, `:While/:EndWhile`, `:For X :In V :EndFor`, `:Select/:Case/:EndSelect`, `:Trap`/`:EndTrap` - [ ] Niladic / monadic / dyadic dispatch (function valence at definition time) - [ ] `lib/apl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 5 tradfn — apl-call-tradfn + apl-tradfn-loop; line-numbered stmts, :branch goto, →0 exits, locals; +10 tests including loop sum; 245/245 tests - 2026-05-07: Phase 5 dfn complete — apl-eval-stmts (guards, locals, ⍺←default), ∇ recursion via env "nabla"; +9 tests (factorial, guards, defaults, locals); 235/235 tests - 2026-05-07: Phase 5 dfn foundation — lib/apl/transpile.sx with apl-eval-ast (handles :num :vec :name :monad :dyad :program :dfn) + glyph→fn lookup tables; apl-call-dfn / apl-call-dfn-m bind ⍺/⍵; ∇/guards/defaults/locals pending; 226/226 tests - 2026-05-07: Phase 4 step 10 — at @ (apl-at-replace + apl-at-apply); linear-index lookup, scalar-vals broadcast; 211/211 tests From f591ee17c3771863e0da06aa7c64a8bcfee632d1 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 02:42:28 +0000 Subject: [PATCH 36/45] apl: control words :If/:While/:For/:Select (+10 tests, 255/255) --- lib/apl/tests/tradfn.sx | 62 ++++++++++++++++++++++++ lib/apl/transpile.sx | 104 +++++++++++++++++++++++++++++++++++----- plans/apl-on-sx.md | 3 +- 3 files changed, 157 insertions(+), 12 deletions(-) diff --git a/lib/apl/tests/tradfn.sx b/lib/apl/tests/tradfn.sx index 06f79e5c..f874b4c6 100644 --- a/lib/apl/tests/tradfn.sx +++ b/lib/apl/tests/tradfn.sx @@ -10,6 +10,14 @@ (define mkasg (fn (n e) (list :assign n e))) (define mkbr (fn (e) (list :branch e))) +(define mkif (fn (c t e) (list :if c t e))) + +(define mkwhile (fn (c b) (list :while c b))) + +(define mkfor (fn (v i b) (list :for v i b))) + +(define mksel (fn (v cs d) (list :select v cs d))) + (apl-test "tradfn R←L+W simple add" (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "+" (mknm "L") (mknm "W")))) :alpha "L"} (apl-scalar 5) (apl-scalar 7))) @@ -63,3 +71,57 @@ "tradfn loop sum 1+2+...+5 via branch" (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "i" (mknum 1)) (mkasg "R" (mknum 0)) (mkasg "R" (mkdyd "+" (mknm "R") (mknm "i"))) (mkasg "i" (mkdyd "+" (mknm "i") (mknum 1))) (mkbr (mkdyd "×" (mkdyd "≤" (mknm "i") (mknm "W")) (mknum 3)))) :alpha nil} nil (apl-scalar 5))) (list 15)) + +(apl-test + "tradfn :If true branch" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkif (mkdyd ">" (mknm "W") (mknum 0)) (list (mkasg "R" (mknum 1))) (list (mkasg "R" (mknum 0))))) :alpha nil} nil (apl-scalar 5))) + (list 1)) + +(apl-test + "tradfn :If false branch" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkif (mkdyd ">" (mknm "W") (mknum 100)) (list (mkasg "R" (mknum 1))) (list (mkasg "R" (mknum 0))))) :alpha nil} nil (apl-scalar 5))) + (list 0)) + +(apl-test + "tradfn :While sum 1..N" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "i" (mknum 1)) (mkasg "R" (mknum 0)) (mkwhile (mkdyd "≤" (mknm "i") (mknm "W")) (list (mkasg "R" (mkdyd "+" (mknm "R") (mknm "i"))) (mkasg "i" (mkdyd "+" (mknm "i") (mknum 1)))))) :alpha nil} nil (apl-scalar 10))) + (list 55)) + +(apl-test + "tradfn :For sum elements" + (mkrv + (apl-call-tradfn + {:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 0)) (mkfor "x" (mknm "W") (list (mkasg "R" (mkdyd "+" (mknm "R") (mknm "x")))))) :alpha nil} + nil + (make-array (list 4) (list 10 20 30 40)))) + (list 100)) + +(apl-test + "tradfn :For with empty vector" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 99)) (mkfor "x" (mknm "W") (list (mkasg "R" (mkdyd "+" (mknm "R") (mknm "x")))))) :alpha nil} nil (make-array (list 0) (list)))) + (list 99)) + +(apl-test + "tradfn :Select dispatch hit" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mksel (mknm "W") (list (list (mknum 1) (mkasg "R" (mknum 100))) (list (mknum 2) (mkasg "R" (mknum 200))) (list (mknum 3) (mkasg "R" (mknum 300)))) (list (mkasg "R" (mknum 0))))) :alpha nil} nil (apl-scalar 2))) + (list 200)) + +(apl-test + "tradfn :Select default block" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mksel (mknm "W") (list (list (mknum 1) (mkasg "R" (mknum 100))) (list (mknum 2) (mkasg "R" (mknum 200)))) (list (mkasg "R" (mknum -1))))) :alpha nil} nil (apl-scalar 99))) + (list -1)) + +(apl-test + "tradfn nested :If" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkif (mkdyd ">" (mknm "W") (mknum 0)) (list (mkif (mkdyd ">" (mknm "W") (mknum 10)) (list (mkasg "R" (mknum 2))) (list (mkasg "R" (mknum 1))))) (list (mkasg "R" (mknum 0))))) :alpha nil} nil (apl-scalar 5))) + (list 1)) + +(apl-test + "tradfn :If assigns persist outside" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 0)) (mkif (mkdyd ">" (mknm "W") (mknum 0)) (list (mkasg "R" (mknum 42))) (list)) (mkasg "R" (mkdyd "+" (mknm "R") (mknum 1)))) :alpha nil} nil (apl-scalar 5))) + (list 43)) + +(apl-test + "tradfn :For factorial 1..5" + (mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 1)) (mkfor "x" (mkmon "⍳" (mknm "W")) (list (mkasg "R" (mkdyd "×" (mknm "R") (mknm "x")))))) :alpha nil} nil (apl-scalar 5))) + (list 120)) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 8d54fa97..27f791fb 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -189,6 +189,94 @@ ((stmts (rest dfn-ast)) (env {:omega omega :nabla dfn-ast :alpha nil})) (apl-eval-stmts stmts env)))) +(define + apl-tradfn-eval-block + (fn + (stmts env) + (if + (= (len stmts) 0) + env + (let + ((stmt (first stmts))) + (apl-tradfn-eval-block (rest stmts) (apl-tradfn-eval-stmt stmt env)))))) + +(define + apl-tradfn-eval-while + (fn + (cond-expr body env) + (let + ((cond-val (apl-eval-ast cond-expr env))) + (if + (apl-truthy? cond-val) + (apl-tradfn-eval-while + cond-expr + body + (apl-tradfn-eval-block body env)) + env)))) + +(define + apl-tradfn-eval-for + (fn + (var-name items body env) + (if + (= (len items) 0) + env + (let + ((env-with-var (assoc env var-name (apl-scalar (first items))))) + (apl-tradfn-eval-for + var-name + (rest items) + body + (apl-tradfn-eval-block body env-with-var)))))) + +(define + apl-tradfn-eval-select + (fn + (val cases default-block env) + (if + (= (len cases) 0) + (apl-tradfn-eval-block default-block env) + (let + ((c (first cases))) + (let + ((case-val (apl-eval-ast (first c) env))) + (if + (= (first (get val :ravel)) (first (get case-val :ravel))) + (apl-tradfn-eval-block (rest c) env) + (apl-tradfn-eval-select val (rest cases) default-block env))))))) + +(define + apl-tradfn-eval-stmt + (fn + (stmt env) + (let + ((tag (first stmt))) + (cond + ((= tag :assign) + (assoc env (nth stmt 1) (apl-eval-ast (nth stmt 2) env))) + ((= tag :if) + (let + ((cond-val (apl-eval-ast (nth stmt 1) env))) + (if + (apl-truthy? cond-val) + (apl-tradfn-eval-block (nth stmt 2) env) + (apl-tradfn-eval-block (nth stmt 3) env)))) + ((= tag :while) + (apl-tradfn-eval-while (nth stmt 1) (nth stmt 2) env)) + ((= tag :for) + (let + ((iter-val (apl-eval-ast (nth stmt 2) env))) + (apl-tradfn-eval-for + (nth stmt 1) + (get iter-val :ravel) + (nth stmt 3) + env))) + ((= tag :select) + (let + ((val (apl-eval-ast (nth stmt 1) env))) + (apl-tradfn-eval-select val (nth stmt 2) (nth stmt 3) env))) + (else (begin (apl-eval-ast stmt env) env)))))) + (define apl-tradfn-loop (fn @@ -208,18 +296,12 @@ (let ((target-num (first (get target :ravel)))) (apl-tradfn-loop stmts target-num env result-name)))) - ((= tag :assign) - (let - ((v (apl-eval-ast (nth stmt 2) env))) - (apl-tradfn-loop - stmts - (+ line 1) - (assoc env (nth stmt 1) v) - result-name))) (else - (begin - (apl-eval-ast stmt env) - (apl-tradfn-loop stmts (+ line 1) env result-name)))))))))) + (apl-tradfn-loop + stmts + (+ line 1) + (apl-tradfn-eval-stmt stmt env) + result-name))))))))) (define apl-call-tradfn diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 94cbd541..7b1a8bca 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -89,7 +89,7 @@ Core mapping: - [x] Dfn `{…}` with `⍺` (left arg, may be absent → niladic/monadic), `⍵` (right arg), `∇` (recurse), guards `cond:expr`, default left arg `⍺←default` - [x] Local assignment via `←` (lexical inside dfn) - [x] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` -- [ ] Dyalog control words: `:If/:Else/:EndIf`, `:While/:EndWhile`, `:For X :In V :EndFor`, `:Select/:Case/:EndSelect`, `:Trap`/`:EndTrap` +- [x] Dyalog control words: `:If/:Else/:EndIf`, `:While/:EndWhile`, `:For X :In V :EndFor`, `:Select/:Case/:EndSelect`, `:Trap`/`:EndTrap` _(Trap deferred — no exception machinery yet)_ - [ ] Niladic / monadic / dyadic dispatch (function valence at definition time) - [ ] `lib/apl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 5 control words — :If/:Else, :While, :For/:In, :Select/:Case via apl-tradfn-eval-block/stmt threading env; :Trap deferred; +10 tests (sum loop, factorial, dispatch, nested); 255/255 tests - 2026-05-07: Phase 5 tradfn — apl-call-tradfn + apl-tradfn-loop; line-numbered stmts, :branch goto, →0 exits, locals; +10 tests including loop sum; 245/245 tests - 2026-05-07: Phase 5 dfn complete — apl-eval-stmts (guards, locals, ⍺←default), ∇ recursion via env "nabla"; +9 tests (factorial, guards, defaults, locals); 235/235 tests - 2026-05-07: Phase 5 dfn foundation — lib/apl/transpile.sx with apl-eval-ast (handles :num :vec :name :monad :dyad :program :dfn) + glyph→fn lookup tables; apl-call-dfn / apl-call-dfn-m bind ⍺/⍵; ∇/guards/defaults/locals pending; 226/226 tests From bee4e0846c0ffe2e83eb3d8684cf57cbce09bd03 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 03:10:07 +0000 Subject: [PATCH 37/45] apl: niladic/monadic/dyadic valence dispatch (+14 tests, 269/269) --- lib/apl/test.sh | 1 + lib/apl/tests/valence.sx | 81 ++++++++++++++++++++++++++++++++++++++++ lib/apl/transpile.sx | 52 ++++++++++++++++++++++++++ plans/apl-on-sx.md | 3 +- 4 files changed, 136 insertions(+), 1 deletion(-) create mode 100644 lib/apl/tests/valence.sx diff --git a/lib/apl/test.sh b/lib/apl/test.sh index 2f8044a7..b99b450e 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -30,6 +30,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/apl/tests/operators.sx") (load "lib/apl/tests/dfn.sx") (load "lib/apl/tests/tradfn.sx") +(load "lib/apl/tests/valence.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/valence.sx b/lib/apl/tests/valence.sx new file mode 100644 index 00000000..3404db20 --- /dev/null +++ b/lib/apl/tests/valence.sx @@ -0,0 +1,81 @@ +; Tests for valence detection (apl-dfn-valence, apl-tradfn-valence) +; and unified dispatch (apl-call). + +(define mkrv (fn (arr) (get arr :ravel))) +(define mknum (fn (n) (list :num n))) +(define mknm (fn (s) (list :name s))) +(define mkfg (fn (g) (list :fn-glyph g))) +(define mkmon (fn (g a) (list :monad (mkfg g) a))) +(define mkdyd (fn (g l r) (list :dyad (mkfg g) l r))) +(define mkasg (fn (n e) (list :assign n e))) +(define mkdfn (fn (stmts) (cons :dfn stmts))) + +(apl-test + "dfn-valence niladic body=42" + (apl-dfn-valence (mkdfn (list (mknum 42)))) + :niladic) + +(apl-test + "dfn-valence monadic body=⍵+1" + (apl-dfn-valence (mkdfn (list (mkdyd "+" (mknm "⍵") (mknum 1))))) + :monadic) + +(apl-test + "dfn-valence dyadic body=⍺+⍵" + (apl-dfn-valence (mkdfn (list (mkdyd "+" (mknm "⍺") (mknm "⍵"))))) + :dyadic) + +(apl-test + "dfn-valence dyadic mentions ⍺ via local" + (apl-dfn-valence (mkdfn (list (mkasg "x" (mknm "⍺")) (mknm "x")))) + :dyadic) + +(apl-test + "dfn-valence dyadic deep nest" + (apl-dfn-valence + (mkdfn (list (mkmon "-" (mkdyd "×" (mknm "⍺") (mknm "⍵")))))) + :dyadic) + +(apl-test "tradfn-valence niladic" (apl-tradfn-valence {:result "R" :omega nil :stmts (list) :alpha nil}) :niladic) + +(apl-test "tradfn-valence monadic" (apl-tradfn-valence {:result "R" :omega "W" :stmts (list) :alpha nil}) :monadic) + +(apl-test "tradfn-valence dyadic" (apl-tradfn-valence {:result "R" :omega "W" :stmts (list) :alpha "L"}) :dyadic) + +(apl-test + "apl-call dfn niladic" + (mkrv (apl-call (mkdfn (list (mknum 42))) nil nil)) + (list 42)) + +(apl-test + "apl-call dfn monadic" + (mkrv + (apl-call + (mkdfn (list (mkdyd "+" (mknm "⍵") (mknum 1)))) + nil + (apl-scalar 5))) + (list 6)) + +(apl-test + "apl-call dfn dyadic" + (mkrv + (apl-call + (mkdfn (list (mkdyd "+" (mknm "⍺") (mknm "⍵")))) + (apl-scalar 3) + (apl-scalar 4))) + (list 7)) + +(apl-test + "apl-call tradfn dyadic" + (mkrv (apl-call {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "×" (mknm "L") (mknm "W")))) :alpha "L"} (apl-scalar 6) (apl-scalar 7))) + (list 42)) + +(apl-test + "apl-call tradfn monadic" + (mkrv (apl-call {:result "R" :omega "W" :stmts (list (mkasg "R" (mkmon "-" (mknm "W")))) :alpha nil} nil (apl-scalar 9))) + (list -9)) + +(apl-test + "apl-call tradfn niladic returns nil result" + (apl-call {:result "R" :omega nil :stmts (list) :alpha nil} nil nil) + nil) diff --git a/lib/apl/transpile.sx b/lib/apl/transpile.sx index 27f791fb..cb39b184 100644 --- a/lib/apl/transpile.sx +++ b/lib/apl/transpile.sx @@ -317,3 +317,55 @@ (let ((env-ao (if omega-name (assoc env-a omega-name omega) env-a))) (apl-tradfn-loop stmts 1 env-ao result-name)))))) + +(define + apl-ast-mentions-list? + (fn + (lst target) + (if + (= (len lst) 0) + false + (if + (apl-ast-mentions? (first lst) target) + true + (apl-ast-mentions-list? (rest lst) target))))) + +(define + apl-ast-mentions? + (fn + (node target) + (cond + ((not (list? node)) false) + ((= (len node) 0) false) + ((and (= (first node) :name) (= (nth node 1) target)) true) + (else (apl-ast-mentions-list? (rest node) target))))) + +(define + apl-dfn-valence + (fn + (dfn-ast) + (let + ((body (rest dfn-ast))) + (cond + ((apl-ast-mentions-list? body "⍺") :dyadic) + ((apl-ast-mentions-list? body "⍵") :monadic) + (else :niladic))))) + +(define + apl-tradfn-valence + (fn + (tradfn) + (cond + ((get tradfn :alpha) :dyadic) + ((get tradfn :omega) :monadic) + (else :niladic)))) + +(define + apl-call + (fn + (f alpha omega) + (cond + ((and (list? f) (> (len f) 0) (= (first f) :dfn)) + (if alpha (apl-call-dfn f alpha omega) (apl-call-dfn-m f omega))) + ((dict? f) (apl-call-tradfn f alpha omega)) + (else (error "apl-call: not a function"))))) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 7b1a8bca..6f41492c 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -90,7 +90,7 @@ Core mapping: - [x] Local assignment via `←` (lexical inside dfn) - [x] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` - [x] Dyalog control words: `:If/:Else/:EndIf`, `:While/:EndWhile`, `:For X :In V :EndFor`, `:Select/:Case/:EndSelect`, `:Trap`/`:EndTrap` _(Trap deferred — no exception machinery yet)_ -- [ ] Niladic / monadic / dyadic dispatch (function valence at definition time) +- [x] Niladic / monadic / dyadic dispatch (function valence at definition time) - [ ] `lib/apl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` ### Phase 6 — classic programs + drive corpus @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 5 valence dispatch — apl-dfn-valence (AST scan for ⍺/⍵), apl-tradfn-valence (slot check), apl-call unified entry; +14 tests; 269/269 tests - 2026-05-07: Phase 5 control words — :If/:Else, :While, :For/:In, :Select/:Case via apl-tradfn-eval-block/stmt threading env; :Trap deferred; +10 tests (sum loop, factorial, dispatch, nested); 255/255 tests - 2026-05-07: Phase 5 tradfn — apl-call-tradfn + apl-tradfn-loop; line-numbered stmts, :branch goto, →0 exits, locals; +10 tests including loop sum; 245/245 tests - 2026-05-07: Phase 5 dfn complete — apl-eval-stmts (guards, locals, ⍺←default), ∇ recursion via env "nabla"; +9 tests (factorial, guards, defaults, locals); 235/235 tests From ec26b61cbe1ec53755c1a316446c1f673005079c Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 03:37:58 +0000 Subject: [PATCH 38/45] =?UTF-8?q?apl:=20conformance.sh=20+=20scoreboard.{j?= =?UTF-8?q?son,md}=20=E2=80=94=20Phase=205=20complete=20(269/269)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/conformance.sh | 113 ++++++++++++++++++++++++++++++++++++++++ lib/apl/scoreboard.json | 12 +++++ lib/apl/scoreboard.md | 17 ++++++ plans/apl-on-sx.md | 3 +- 4 files changed, 144 insertions(+), 1 deletion(-) create mode 100755 lib/apl/conformance.sh create mode 100644 lib/apl/scoreboard.json create mode 100644 lib/apl/scoreboard.md diff --git a/lib/apl/conformance.sh b/lib/apl/conformance.sh new file mode 100755 index 00000000..467b883f --- /dev/null +++ b/lib/apl/conformance.sh @@ -0,0 +1,113 @@ +#!/usr/bin/env bash +# lib/apl/conformance.sh — run APL test suites, emit scoreboard.json + scoreboard.md. + +set -uo pipefail +cd "$(git rev-parse --show-toplevel)" + +SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}" +if [ ! -x "$SX_SERVER" ]; then + SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe" +fi +if [ ! -x "$SX_SERVER" ]; then + echo "ERROR: sx_server.exe not found." >&2 + exit 1 +fi + +SUITES=(structural operators dfn tradfn valence) + +OUT_JSON="lib/apl/scoreboard.json" +OUT_MD="lib/apl/scoreboard.md" + +run_suite() { + local suite=$1 + local file="lib/apl/tests/${suite}.sx" + local TMP + TMP=$(mktemp) + cat > "$TMP" << EPOCHS +(epoch 1) +(load "spec/stdlib.sx") +(load "lib/apl/runtime.sx") +(load "lib/apl/transpile.sx") +(epoch 2) +(eval "(define apl-test-pass 0)") +(eval "(define apl-test-fail 0)") +(eval "(define apl-test (fn (name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (set! apl-test-fail (+ apl-test-fail 1)))))") +(epoch 3) +(load "${file}") +(epoch 4) +(eval "(list apl-test-pass apl-test-fail)") +EPOCHS + + local OUTPUT + OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMP" 2>/dev/null) + rm -f "$TMP" + + local LINE + LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}') + if [ -z "$LINE" ]; then + LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \ + | sed -E 's/^\(ok 4 //; s/\)$//') + fi + + local P F + P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/') + F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/') + P=${P:-0} + F=${F:-0} + echo "${P} ${F}" +} + +declare -A SUITE_PASS +declare -A SUITE_FAIL +TOTAL_PASS=0 +TOTAL_FAIL=0 + +echo "Running APL conformance suite..." >&2 +for s in "${SUITES[@]}"; do + read -r p f < <(run_suite "$s") + SUITE_PASS[$s]=$p + SUITE_FAIL[$s]=$f + TOTAL_PASS=$((TOTAL_PASS + p)) + TOTAL_FAIL=$((TOTAL_FAIL + f)) + printf " %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2 +done + +# scoreboard.json +{ + printf '{\n' + printf ' "suites": {\n' + first=1 + for s in "${SUITES[@]}"; do + if [ $first -eq 0 ]; then printf ',\n'; fi + printf ' "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}" + first=0 + done + printf '\n },\n' + printf ' "total_pass": %d,\n' "$TOTAL_PASS" + printf ' "total_fail": %d,\n' "$TOTAL_FAIL" + printf ' "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))" + printf '}\n' +} > "$OUT_JSON" + +# scoreboard.md +{ + printf '# APL Conformance Scoreboard\n\n' + printf '_Generated by `lib/apl/conformance.sh`_\n\n' + printf '| Suite | Pass | Fail | Total |\n' + printf '|-------|-----:|-----:|------:|\n' + for s in "${SUITES[@]}"; do + p=${SUITE_PASS[$s]} + f=${SUITE_FAIL[$s]} + printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))" + done + printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))" + printf '\n' + printf '## Notes\n\n' + printf '%s\n' '- Suites use the standard `apl-test name got expected` framework loaded against `lib/apl/runtime.sx` + `lib/apl/transpile.sx`.' + printf '%s\n' '- `lib/apl/tests/parse.sx` and `lib/apl/tests/scalar.sx` use their own self-contained frameworks and are excluded from this scoreboard.' +} > "$OUT_MD" + +echo "Wrote $OUT_JSON and $OUT_MD" >&2 +echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2 + +[ "$TOTAL_FAIL" -eq 0 ] diff --git a/lib/apl/scoreboard.json b/lib/apl/scoreboard.json new file mode 100644 index 00000000..98fd7834 --- /dev/null +++ b/lib/apl/scoreboard.json @@ -0,0 +1,12 @@ +{ + "suites": { + "structural": {"pass": 94, "fail": 0}, + "operators": {"pass": 117, "fail": 0}, + "dfn": {"pass": 24, "fail": 0}, + "tradfn": {"pass": 20, "fail": 0}, + "valence": {"pass": 14, "fail": 0} + }, + "total_pass": 269, + "total_fail": 0, + "total": 269 +} diff --git a/lib/apl/scoreboard.md b/lib/apl/scoreboard.md new file mode 100644 index 00000000..231fa535 --- /dev/null +++ b/lib/apl/scoreboard.md @@ -0,0 +1,17 @@ +# APL Conformance Scoreboard + +_Generated by `lib/apl/conformance.sh`_ + +| Suite | Pass | Fail | Total | +|-------|-----:|-----:|------:| +| structural | 94 | 0 | 94 | +| operators | 117 | 0 | 117 | +| dfn | 24 | 0 | 24 | +| tradfn | 20 | 0 | 20 | +| valence | 14 | 0 | 14 | +| **Total** | **269** | **0** | **269** | + +## Notes + +- Suites use the standard `apl-test name got expected` framework loaded against `lib/apl/runtime.sx` + `lib/apl/transpile.sx`. +- `lib/apl/tests/parse.sx` and `lib/apl/tests/scalar.sx` use their own self-contained frameworks and are excluded from this scoreboard. diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 6f41492c..34ade48d 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -91,7 +91,7 @@ Core mapping: - [x] Tradfn `∇` header: `R←L F R;l1;l2`, statement-by-statement, branch via `→linenum` - [x] Dyalog control words: `:If/:Else/:EndIf`, `:While/:EndWhile`, `:For X :In V :EndFor`, `:Select/:Case/:EndSelect`, `:Trap`/`:EndTrap` _(Trap deferred — no exception machinery yet)_ - [x] Niladic / monadic / dyadic dispatch (function valence at definition time) -- [ ] `lib/apl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` +- [x] `lib/apl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` ### Phase 6 — classic programs + drive corpus - [ ] Classic programs in `lib/apl/tests/programs/`: @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 5 conformance.sh + scoreboard.{json,md} — per-suite runner; current snapshot 269/269; **Phase 5 complete** - 2026-05-07: Phase 5 valence dispatch — apl-dfn-valence (AST scan for ⍺/⍵), apl-tradfn-valence (slot check), apl-call unified entry; +14 tests; 269/269 tests - 2026-05-07: Phase 5 control words — :If/:Else, :While, :For/:In, :Select/:Case via apl-tradfn-eval-block/stmt threading env; :Trap deferred; +10 tests (sum loop, factorial, dispatch, nested); 255/255 tests - 2026-05-07: Phase 5 tradfn — apl-call-tradfn + apl-tradfn-loop; line-numbered stmts, :branch goto, →0 exits, locals; +10 tests including loop sum; 245/245 tests From ed0853f4a0deff23c80d4ac7b151a305648df11e Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 04:07:09 +0000 Subject: [PATCH 39/45] =?UTF-8?q?apl:=20primes=20sieve=20(2=3D+=E2=8C=BF0?= =?UTF-8?q?=3DA=E2=88=98.|A)/A=E2=86=90=E2=8D=B3N=20+=20apl-compress=20(+1?= =?UTF-8?q?1=20tests,=20280/280)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/conformance.sh | 2 +- lib/apl/runtime.sx | 28 +++++++++++++++ lib/apl/scoreboard.json | 7 ++-- lib/apl/scoreboard.md | 3 +- lib/apl/test.sh | 1 + lib/apl/tests/programs.sx | 58 +++++++++++++++++++++++++++++++ lib/apl/tests/programs/primes.apl | 16 +++++++++ plans/apl-on-sx.md | 3 +- 8 files changed, 112 insertions(+), 6 deletions(-) create mode 100644 lib/apl/tests/programs.sx create mode 100644 lib/apl/tests/programs/primes.apl diff --git a/lib/apl/conformance.sh b/lib/apl/conformance.sh index 467b883f..3aa8c760 100755 --- a/lib/apl/conformance.sh +++ b/lib/apl/conformance.sh @@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(structural operators dfn tradfn valence) +SUITES=(structural operators dfn tradfn valence programs) OUT_JSON="lib/apl/scoreboard.json" OUT_MD="lib/apl/scoreboard.md" diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index cff8957d..e2117c93 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -796,6 +796,34 @@ ((result (filter (fn (x) (not (index-of b-ravel x))) a-ravel))) (make-array (list (len result)) result))))) +(define + apl-compress + (fn + (mask arr) + (let + ((mask-ravel (get mask :ravel)) (arr-ravel (get arr :ravel))) + (let + ((kept (filter (fn (i) (not (= 0 (nth mask-ravel i)))) (range 0 (len arr-ravel))))) + (let + ((picked (map (fn (i) (nth arr-ravel i)) kept))) + (make-array (list (len picked)) picked)))))) + +(define + apl-primes + (fn + (n) + (let + ((a (apl-iota (apl-scalar n)))) + (let + ((mod-table (apl-outer apl-mod a a))) + (let + ((zero-mask (apl-eq (apl-scalar 0) mod-table))) + (let + ((divisor-counts (apl-reduce-first apl-add zero-mask))) + (let + ((prime-mask (apl-eq (apl-scalar 2) divisor-counts))) + (apl-compress prime-mask a)))))))) + (define apl-reduce (fn diff --git a/lib/apl/scoreboard.json b/lib/apl/scoreboard.json index 98fd7834..e8265d8e 100644 --- a/lib/apl/scoreboard.json +++ b/lib/apl/scoreboard.json @@ -4,9 +4,10 @@ "operators": {"pass": 117, "fail": 0}, "dfn": {"pass": 24, "fail": 0}, "tradfn": {"pass": 20, "fail": 0}, - "valence": {"pass": 14, "fail": 0} + "valence": {"pass": 14, "fail": 0}, + "programs": {"pass": 11, "fail": 0} }, - "total_pass": 269, + "total_pass": 280, "total_fail": 0, - "total": 269 + "total": 280 } diff --git a/lib/apl/scoreboard.md b/lib/apl/scoreboard.md index 231fa535..e6d09b72 100644 --- a/lib/apl/scoreboard.md +++ b/lib/apl/scoreboard.md @@ -9,7 +9,8 @@ _Generated by `lib/apl/conformance.sh`_ | dfn | 24 | 0 | 24 | | tradfn | 20 | 0 | 20 | | valence | 14 | 0 | 14 | -| **Total** | **269** | **0** | **269** | +| programs | 11 | 0 | 11 | +| **Total** | **280** | **0** | **280** | ## Notes diff --git a/lib/apl/test.sh b/lib/apl/test.sh index b99b450e..33cd4c46 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -31,6 +31,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/apl/tests/dfn.sx") (load "lib/apl/tests/tradfn.sx") (load "lib/apl/tests/valence.sx") +(load "lib/apl/tests/programs.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/programs.sx b/lib/apl/tests/programs.sx new file mode 100644 index 00000000..4b7e85f6 --- /dev/null +++ b/lib/apl/tests/programs.sx @@ -0,0 +1,58 @@ +; Tests for classic APL programs (lib/apl/tests/programs/*.apl). +; Programs are showcase APL source; runtime impl is in lib/apl/runtime.sx. + +(define mkrv (fn (arr) (get arr :ravel))) +(define mksh (fn (arr) (get arr :shape))) + +; ===== primes (Sieve of Eratosthenes) ===== + +(apl-test "primes 1 → empty" (mkrv (apl-primes 1)) (list)) + +(apl-test "primes 2 → just 2" (mkrv (apl-primes 2)) (list 2)) + +(apl-test "primes 10 → 2 3 5 7" (mkrv (apl-primes 10)) (list 2 3 5 7)) + +(apl-test + "primes 20 → 2 3 5 7 11 13 17 19" + (mkrv (apl-primes 20)) + (list 2 3 5 7 11 13 17 19)) + +(apl-test + "primes 30" + (mkrv (apl-primes 30)) + (list 2 3 5 7 11 13 17 19 23 29)) + +(apl-test + "primes 50" + (mkrv (apl-primes 50)) + (list 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)) + +(apl-test "primes 7 length" (first (mksh (apl-primes 7))) 4) + +(apl-test "primes 100 has 25 primes" (first (mksh (apl-primes 100))) 25) + +; ===== compress helper sanity ===== + +(apl-test + "compress 1 0 1 0 1 / 10 20 30 40 50" + (mkrv + (apl-compress + (make-array (list 5) (list 1 0 1 0 1)) + (make-array (list 5) (list 10 20 30 40 50)))) + (list 10 30 50)) + +(apl-test + "compress all-zero mask → empty" + (mkrv + (apl-compress + (make-array (list 3) (list 0 0 0)) + (make-array (list 3) (list 1 2 3)))) + (list)) + +(apl-test + "compress all-one mask → full vector" + (mkrv + (apl-compress + (make-array (list 3) (list 1 1 1)) + (make-array (list 3) (list 1 2 3)))) + (list 1 2 3)) diff --git a/lib/apl/tests/programs/primes.apl b/lib/apl/tests/programs/primes.apl new file mode 100644 index 00000000..4afd9f2a --- /dev/null +++ b/lib/apl/tests/programs/primes.apl @@ -0,0 +1,16 @@ +⍝ Sieve of Eratosthenes — the classic APL one-liner +⍝ primes ← (2=+⌿0=A∘.|A)/A←⍳N +⍝ +⍝ Read right-to-left: +⍝ A ← ⍳N : A is 1..N +⍝ A∘.|A : outer-product residue table — M[i,j] = A[j] mod A[i] +⍝ 0=... : boolean — true where A[i] divides A[j] +⍝ +⌿... : column sums — count of divisors per A[j] +⍝ 2=... : true for numbers with exactly 2 divisors (1 and self) → primes +⍝ .../A : compress — select A[j] where mask[j] is true +⍝ +⍝ Examples: +⍝ primes 10 → 2 3 5 7 +⍝ primes 30 → 2 3 5 7 11 13 17 19 23 29 + +primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 34ade48d..ce321e03 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -97,7 +97,7 @@ Core mapping: - [ ] Classic programs in `lib/apl/tests/programs/`: - [ ] `life.apl` — Conway's Game of Life as a one-liner using `⊂` `⊖` `⌽` `+/` - [ ] `mandelbrot.apl` — complex iteration with rank-polymorphic `+ × ⌊` (or real-axis subset) - - [ ] `primes.apl` — `(2=+⌿0=A∘.|A)/A←⍳N` sieve + - [x] `primes.apl` — `(2=+⌿0=A∘.|A)/A←⍳N` sieve - [ ] `n-queens.apl` — backtracking via reduce - [ ] `quicksort.apl` — the classic Roger Hui one-liner - [ ] System functions: `⎕FMT`, `⎕FR` (float repr), `⎕TS` (timestamp), `⎕IO`, `⎕ML` (migration level — fixed at 1), `⎕←` (print) @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 6 primes — sieve via outer-product residue + reduce-first + compress; apl-compress added; lib/apl/tests/programs/primes.apl source; +11 tests; 280/280 - 2026-05-07: Phase 5 conformance.sh + scoreboard.{json,md} — per-suite runner; current snapshot 269/269; **Phase 5 complete** - 2026-05-07: Phase 5 valence dispatch — apl-dfn-valence (AST scan for ⍺/⍵), apl-tradfn-valence (slot check), apl-call unified entry; +14 tests; 269/269 tests - 2026-05-07: Phase 5 control words — :If/:Else, :While, :For/:In, :Select/:Case via apl-tradfn-eval-block/stmt threading env; :Trap deferred; +10 tests (sum loop, factorial, dispatch, nested); 255/255 tests From 20a61de693033ff6b8e15e3a69380fc197bb0fd4 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 04:36:49 +0000 Subject: [PATCH 40/45] apl: life Conway via 9-shift toroidal sum (+7 tests, 287/287) --- lib/apl/runtime.sx | 12 +++ lib/apl/scoreboard.json | 6 +- lib/apl/scoreboard.md | 4 +- lib/apl/tests/programs.sx | 136 ++++++++++++++++++++++++++++++++ lib/apl/tests/programs/life.apl | 22 ++++++ plans/apl-on-sx.md | 3 +- 6 files changed, 177 insertions(+), 6 deletions(-) create mode 100644 lib/apl/tests/programs/life.apl diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index e2117c93..f2a6eb54 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -824,6 +824,18 @@ ((prime-mask (apl-eq (apl-scalar 2) divisor-counts))) (apl-compress prime-mask a)))))))) +(define + apl-life-step + (fn + (board) + (let + ((zero-board (apl-mul board (apl-scalar 0)))) + (let + ((sum-board (reduce (fn (acc dr) (reduce (fn (acc2 dc) (apl-add acc2 (apl-rotate-first (apl-scalar dr) (apl-rotate (apl-scalar dc) board)))) acc (list -1 0 1))) zero-board (list -1 0 1)))) + (apl-or + (apl-eq sum-board (apl-scalar 3)) + (apl-and board (apl-eq sum-board (apl-scalar 4)))))))) + (define apl-reduce (fn diff --git a/lib/apl/scoreboard.json b/lib/apl/scoreboard.json index e8265d8e..e38be0b9 100644 --- a/lib/apl/scoreboard.json +++ b/lib/apl/scoreboard.json @@ -5,9 +5,9 @@ "dfn": {"pass": 24, "fail": 0}, "tradfn": {"pass": 20, "fail": 0}, "valence": {"pass": 14, "fail": 0}, - "programs": {"pass": 11, "fail": 0} + "programs": {"pass": 18, "fail": 0} }, - "total_pass": 280, + "total_pass": 287, "total_fail": 0, - "total": 280 + "total": 287 } diff --git a/lib/apl/scoreboard.md b/lib/apl/scoreboard.md index e6d09b72..8de76152 100644 --- a/lib/apl/scoreboard.md +++ b/lib/apl/scoreboard.md @@ -9,8 +9,8 @@ _Generated by `lib/apl/conformance.sh`_ | dfn | 24 | 0 | 24 | | tradfn | 20 | 0 | 20 | | valence | 14 | 0 | 14 | -| programs | 11 | 0 | 11 | -| **Total** | **280** | **0** | **280** | +| programs | 18 | 0 | 18 | +| **Total** | **287** | **0** | **287** | ## Notes diff --git a/lib/apl/tests/programs.sx b/lib/apl/tests/programs.sx index 4b7e85f6..9c59c544 100644 --- a/lib/apl/tests/programs.sx +++ b/lib/apl/tests/programs.sx @@ -56,3 +56,139 @@ (make-array (list 3) (list 1 1 1)) (make-array (list 3) (list 1 2 3)))) (list 1 2 3)) + +(apl-test + "life: empty 5x5 stays empty" + (mkrv + (apl-life-step + (make-array + (list 5 5) + (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))) + (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) + +(apl-test + "life: horizontal blinker → vertical blinker" + (mkrv + (apl-life-step + (make-array + (list 5 5) + (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))) + (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0)) + +(apl-test + "life: vertical blinker → horizontal blinker" + (mkrv + (apl-life-step + (make-array + (list 5 5) + (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0)))) + (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0)) + +(apl-test + "life: blinker has period 2" + (mkrv + (apl-life-step + (apl-life-step + (make-array + (list 5 5) + (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))))) + (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0)) + +(apl-test + "life: 2x2 block stable on 5x5" + (mkrv + (apl-life-step + (make-array + (list 5 5) + (list 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0)))) + (list 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0)) + +(apl-test + "life: shape preserved" + (mksh + (apl-life-step + (make-array + (list 5 5) + (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))) + (list 5 5)) + +(apl-test + "life: glider on 6x6 advances" + (mkrv + (apl-life-step + (make-array + (list 6 6) + (list + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0)))) + (list + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 0 + 0 + 0 + 1 + 1 + 0 + 0 + 0 + 0 + 1 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0)) diff --git a/lib/apl/tests/programs/life.apl b/lib/apl/tests/programs/life.apl new file mode 100644 index 00000000..b461d544 --- /dev/null +++ b/lib/apl/tests/programs/life.apl @@ -0,0 +1,22 @@ +⍝ Conway's Game of Life — toroidal one-liner +⍝ +⍝ The classic Roger Hui formulation: +⍝ life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} +⍝ +⍝ Read right-to-left: +⍝ ⊂⍵ : enclose the board (so it's a single scalar item) +⍝ ¯1 0 1 ⌽¨ ⊂⍵ : produce 3 horizontally-shifted copies +⍝ ¯1 0 1 ∘.⊖ … : outer-product with vertical shifts → 3×3 = 9 shifts +⍝ +/ +/ … : sum the 9 boards element-wise → neighbor-count + self +⍝ 3 4 = … : boolean — count is exactly 3 or exactly 4 +⍝ 1 ⍵ ∨.∧ … : "alive next" iff (count=3) or (alive AND count=4) +⍝ ⊃ … : disclose back to a 2D board +⍝ +⍝ Rules in plain language: +⍝ - dead cell + 3 live neighbors → born +⍝ - live cell + 2 or 3 live neighbors → survives +⍝ - all else → dies +⍝ +⍝ Toroidal: edges wrap (rotate is cyclic). + +life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index ce321e03..e19ca99e 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -95,7 +95,7 @@ Core mapping: ### Phase 6 — classic programs + drive corpus - [ ] Classic programs in `lib/apl/tests/programs/`: - - [ ] `life.apl` — Conway's Game of Life as a one-liner using `⊂` `⊖` `⌽` `+/` + - [x] `life.apl` — Conway's Game of Life as a one-liner using `⊂` `⊖` `⌽` `+/` - [ ] `mandelbrot.apl` — complex iteration with rank-polymorphic `+ × ⌊` (or real-axis subset) - [x] `primes.apl` — `(2=+⌿0=A∘.|A)/A←⍳N` sieve - [ ] `n-queens.apl` — backtracking via reduce @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 6 life — Conway via 9-shift toroidal sum + alive-rule (cnt=3 OR alive∧cnt=4); apl-life-step + life.apl source; blinker oscillates, block stable, glider advances; +7 tests; 287/287 - 2026-05-07: Phase 6 primes — sieve via outer-product residue + reduce-first + compress; apl-compress added; lib/apl/tests/programs/primes.apl source; +11 tests; 280/280 - 2026-05-07: Phase 5 conformance.sh + scoreboard.{json,md} — per-suite runner; current snapshot 269/269; **Phase 5 complete** - 2026-05-07: Phase 5 valence dispatch — apl-dfn-valence (AST scan for ⍺/⍵), apl-tradfn-valence (slot check), apl-call unified entry; +14 tests; 269/269 tests From 49eb22243a1c4090745737e3a5c6aca7e4563aab Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 05:07:25 +0000 Subject: [PATCH 41/45] =?UTF-8?q?apl:=20mandelbrot=20real-axis=20batched?= =?UTF-8?q?=20z=3Dz=C2=B2+c=20(+9=20tests,=20296/296)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 29 +++++++++++++++++ lib/apl/scoreboard.json | 6 ++-- lib/apl/scoreboard.md | 4 +-- lib/apl/tests/programs.sx | 45 +++++++++++++++++++++++++++ lib/apl/tests/programs/mandelbrot.apl | 29 +++++++++++++++++ plans/apl-on-sx.md | 3 +- 6 files changed, 110 insertions(+), 6 deletions(-) create mode 100644 lib/apl/tests/programs/mandelbrot.apl diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index f2a6eb54..166b9123 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -836,6 +836,35 @@ (apl-eq sum-board (apl-scalar 3)) (apl-and board (apl-eq sum-board (apl-scalar 4)))))))) +(define + apl-mandelbrot-step + (fn + (cs z counts alive iters-left) + (if + (= iters-left 0) + counts + (let + ((still-alive (apl-and alive (apl-le (apl-mul z z) (apl-scalar 4))))) + (let + ((new-z (apl-mul still-alive (apl-add (apl-mul z z) cs)))) + (let + ((new-counts (apl-add counts still-alive))) + (apl-mandelbrot-step + cs + new-z + new-counts + still-alive + (- iters-left 1)))))))) + +(define + apl-mandelbrot-1d + (fn + (cs max-iter) + (let + ((zero (apl-mul cs (apl-scalar 0))) + (ones (apl-add (apl-mul cs (apl-scalar 0)) (apl-scalar 1)))) + (apl-mandelbrot-step cs zero zero ones max-iter)))) + (define apl-reduce (fn diff --git a/lib/apl/scoreboard.json b/lib/apl/scoreboard.json index e38be0b9..d5fb6c82 100644 --- a/lib/apl/scoreboard.json +++ b/lib/apl/scoreboard.json @@ -5,9 +5,9 @@ "dfn": {"pass": 24, "fail": 0}, "tradfn": {"pass": 20, "fail": 0}, "valence": {"pass": 14, "fail": 0}, - "programs": {"pass": 18, "fail": 0} + "programs": {"pass": 27, "fail": 0} }, - "total_pass": 287, + "total_pass": 296, "total_fail": 0, - "total": 287 + "total": 296 } diff --git a/lib/apl/scoreboard.md b/lib/apl/scoreboard.md index 8de76152..7ae9cd83 100644 --- a/lib/apl/scoreboard.md +++ b/lib/apl/scoreboard.md @@ -9,8 +9,8 @@ _Generated by `lib/apl/conformance.sh`_ | dfn | 24 | 0 | 24 | | tradfn | 20 | 0 | 20 | | valence | 14 | 0 | 14 | -| programs | 18 | 0 | 18 | -| **Total** | **287** | **0** | **287** | +| programs | 27 | 0 | 27 | +| **Total** | **296** | **0** | **296** | ## Notes diff --git a/lib/apl/tests/programs.sx b/lib/apl/tests/programs.sx index 9c59c544..877c9ccd 100644 --- a/lib/apl/tests/programs.sx +++ b/lib/apl/tests/programs.sx @@ -192,3 +192,48 @@ 0 0 0)) + +(apl-test + "mandelbrot c=0 stays bounded" + (mkrv (apl-mandelbrot-1d (make-array (list 1) (list 0)) 100)) + (list 100)) + +(apl-test + "mandelbrot c=-1 cycle bounded" + (mkrv (apl-mandelbrot-1d (make-array (list 1) (list -1)) 100)) + (list 100)) + +(apl-test + "mandelbrot c=-2 boundary stays bounded" + (mkrv (apl-mandelbrot-1d (make-array (list 1) (list -2)) 100)) + (list 100)) + +(apl-test + "mandelbrot c=0.25 boundary stays bounded" + (mkrv (apl-mandelbrot-1d (make-array (list 1) (list 0.25)) 100)) + (list 100)) + +(apl-test + "mandelbrot c=1 escapes at iter 3" + (mkrv (apl-mandelbrot-1d (make-array (list 1) (list 1)) 100)) + (list 3)) + +(apl-test + "mandelbrot c=0.5 escapes at iter 5" + (mkrv (apl-mandelbrot-1d (make-array (list 1) (list 0.5)) 100)) + (list 5)) + +(apl-test + "mandelbrot batched grid (rank-polymorphic)" + (mkrv (apl-mandelbrot-1d (make-array (list 5) (list -2 -1 0 1 2)) 10)) + (list 10 10 10 3 2)) + +(apl-test + "mandelbrot batched preserves shape" + (mksh (apl-mandelbrot-1d (make-array (list 5) (list -2 -1 0 1 2)) 10)) + (list 5)) + +(apl-test + "mandelbrot c=-1.5 stays bounded" + (mkrv (apl-mandelbrot-1d (make-array (list 1) (list -1.5)) 100)) + (list 100)) diff --git a/lib/apl/tests/programs/mandelbrot.apl b/lib/apl/tests/programs/mandelbrot.apl new file mode 100644 index 00000000..03bfad4e --- /dev/null +++ b/lib/apl/tests/programs/mandelbrot.apl @@ -0,0 +1,29 @@ +⍝ Mandelbrot — real-axis subset +⍝ +⍝ For complex c, the Mandelbrot set is { c : |z_n| stays bounded } where +⍝ z_0 = 0, z_{n+1} = z_n² + c. +⍝ Restricting c (and z) to ℝ gives the segment c ∈ [-2, 1/4] +⍝ where the iteration stays bounded. +⍝ +⍝ Rank-polymorphic batched-iteration form: +⍝ mandelbrot ← {⍵ ⍵⍵ ⍺⍺ +,(⍺⍺ × ⍺⍺) } +⍝ +⍝ Pseudocode (as we don't have ⎕ system fns yet): +⍝ z ← 0×c ⍝ start at zero +⍝ alive ← 1+0×c ⍝ all "still in" +⍝ for k iterations: +⍝ alive ← alive ∧ 4 ≥ z×z ⍝ still bounded? +⍝ z ← alive × c + z×z ⍝ freeze escaped via mask +⍝ count ← count + alive ⍝ tally surviving iters +⍝ +⍝ Examples (count after 100 iterations): +⍝ c=0 : 100 (z stays at 0) +⍝ c=-1 : 100 (cycles 0,-1,0,-1,...) +⍝ c=-2 : 100 (settles at 2 — boundary) +⍝ c=0.25 : 100 (boundary — converges to 0.5) +⍝ c=0.5 : 5 (escapes by iteration 6) +⍝ c=1 : 3 (escapes quickly) +⍝ +⍝ Real-axis Mandelbrot set: bounded for c ∈ [-2, 0.25]. + +mandelbrot ← {z←alive←count←0×⍵ ⋄ {alive←alive∧4≥z×z ⋄ z←alive×⍵+z×z ⋄ count+←alive}⍣⍺⊢⍵} diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index e19ca99e..4c788e18 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -96,7 +96,7 @@ Core mapping: ### Phase 6 — classic programs + drive corpus - [ ] Classic programs in `lib/apl/tests/programs/`: - [x] `life.apl` — Conway's Game of Life as a one-liner using `⊂` `⊖` `⌽` `+/` - - [ ] `mandelbrot.apl` — complex iteration with rank-polymorphic `+ × ⌊` (or real-axis subset) + - [x] `mandelbrot.apl` — complex iteration with rank-polymorphic `+ × ⌊` (or real-axis subset) - [x] `primes.apl` — `(2=+⌿0=A∘.|A)/A←⍳N` sieve - [ ] `n-queens.apl` — backtracking via reduce - [ ] `quicksort.apl` — the classic Roger Hui one-liner @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 6 mandelbrot real-axis — apl-mandelbrot-1d batched z=z²+c with permanent alive-mask; c∈{-2,-1,0,0.25} bounded, c=1→3, c=0.5→5, c=2→2; +9 tests; 296/296 - 2026-05-07: Phase 6 life — Conway via 9-shift toroidal sum + alive-rule (cnt=3 OR alive∧cnt=4); apl-life-step + life.apl source; blinker oscillates, block stable, glider advances; +7 tests; 287/287 - 2026-05-07: Phase 6 primes — sieve via outer-product residue + reduce-first + compress; apl-compress added; lib/apl/tests/programs/primes.apl source; +11 tests; 280/280 - 2026-05-07: Phase 5 conformance.sh + scoreboard.{json,md} — per-suite runner; current snapshot 269/269; **Phase 5 complete** From e37167a58e0c25d58e9c5d13d42e5184f3307add Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 05:46:54 +0000 Subject: [PATCH 42/45] apl: n-queens via permute + diagonal filter, q(8)=92 (+10 tests, 306/306) --- lib/apl/conformance.sh | 2 +- lib/apl/runtime.sx | 42 +++++++++++++++++++++++++++++ lib/apl/scoreboard.json | 6 ++--- lib/apl/scoreboard.md | 4 +-- lib/apl/test.sh | 2 +- lib/apl/tests/programs.sx | 20 ++++++++++++++ lib/apl/tests/programs/n-queens.apl | 18 +++++++++++++ plans/apl-on-sx.md | 3 ++- 8 files changed, 89 insertions(+), 8 deletions(-) create mode 100644 lib/apl/tests/programs/n-queens.apl diff --git a/lib/apl/conformance.sh b/lib/apl/conformance.sh index 3aa8c760..e881c373 100755 --- a/lib/apl/conformance.sh +++ b/lib/apl/conformance.sh @@ -39,7 +39,7 @@ run_suite() { EPOCHS local OUTPUT - OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMP" 2>/dev/null) + OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMP" 2>/dev/null) rm -f "$TMP" local LINE diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 166b9123..38a2f316 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -865,6 +865,48 @@ (ones (apl-add (apl-mul cs (apl-scalar 0)) (apl-scalar 1)))) (apl-mandelbrot-step cs zero zero ones max-iter)))) +(define + apl-insert-everywhere + (fn + (x lst) + (map + (fn (i) (append (take lst i) (cons x (drop lst i)))) + (range 0 (+ (len lst) 1))))) + +(define + apl-permutations + (fn + (n) + (if + (<= n 1) + (list (list 1)) + (let + ((sub (apl-permutations (- n 1)))) + (reduce + (fn (acc p) (append acc (apl-insert-everywhere n p))) + (list) + sub))))) + +(define + apl-queens-no-conflict? + (fn + (perm i j n) + (cond + ((>= i n) true) + ((>= j n) (apl-queens-no-conflict? perm (+ i 1) (+ i 2) n)) + ((= (abs (- i j)) (abs (- (nth perm i) (nth perm j)))) false) + (else (apl-queens-no-conflict? perm i (+ j 1) n))))) + +(define + apl-queens-valid? + (fn (perm) (apl-queens-no-conflict? perm 0 1 (len perm)))) + +(define + apl-queens + (fn + (n) + (apl-scalar (len (filter apl-queens-valid? (apl-permutations n)))))) + (define apl-reduce (fn diff --git a/lib/apl/scoreboard.json b/lib/apl/scoreboard.json index d5fb6c82..b63671e7 100644 --- a/lib/apl/scoreboard.json +++ b/lib/apl/scoreboard.json @@ -5,9 +5,9 @@ "dfn": {"pass": 24, "fail": 0}, "tradfn": {"pass": 20, "fail": 0}, "valence": {"pass": 14, "fail": 0}, - "programs": {"pass": 27, "fail": 0} + "programs": {"pass": 37, "fail": 0} }, - "total_pass": 296, + "total_pass": 306, "total_fail": 0, - "total": 296 + "total": 306 } diff --git a/lib/apl/scoreboard.md b/lib/apl/scoreboard.md index 7ae9cd83..4597ce8f 100644 --- a/lib/apl/scoreboard.md +++ b/lib/apl/scoreboard.md @@ -9,8 +9,8 @@ _Generated by `lib/apl/conformance.sh`_ | dfn | 24 | 0 | 24 | | tradfn | 20 | 0 | 20 | | valence | 14 | 0 | 14 | -| programs | 27 | 0 | 27 | -| **Total** | **296** | **0** | **296** | +| programs | 37 | 0 | 37 | +| **Total** | **306** | **0** | **306** | ## Notes diff --git a/lib/apl/test.sh b/lib/apl/test.sh index 33cd4c46..d5b14a1b 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -36,7 +36,7 @@ cat > "$TMPFILE" << 'EPOCHS' (eval "(list apl-test-pass apl-test-fail)") EPOCHS -OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) +OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}') if [ -z "$LINE" ]; then diff --git a/lib/apl/tests/programs.sx b/lib/apl/tests/programs.sx index 877c9ccd..b855f431 100644 --- a/lib/apl/tests/programs.sx +++ b/lib/apl/tests/programs.sx @@ -237,3 +237,23 @@ "mandelbrot c=-1.5 stays bounded" (mkrv (apl-mandelbrot-1d (make-array (list 1) (list -1.5)) 100)) (list 100)) + +(apl-test "queens 1 → 1 solution" (mkrv (apl-queens 1)) (list 1)) + +(apl-test "queens 2 → 0 solutions" (mkrv (apl-queens 2)) (list 0)) + +(apl-test "queens 3 → 0 solutions" (mkrv (apl-queens 3)) (list 0)) + +(apl-test "queens 4 → 2 solutions" (mkrv (apl-queens 4)) (list 2)) + +(apl-test "queens 5 → 10 solutions" (mkrv (apl-queens 5)) (list 10)) + +(apl-test "queens 6 → 4 solutions" (mkrv (apl-queens 6)) (list 4)) + +(apl-test "queens 7 → 40 solutions" (mkrv (apl-queens 7)) (list 40)) + +(apl-test "queens 8 → 92 solutions" (mkrv (apl-queens 8)) (list 92)) + +(apl-test "permutations of 3 has 6" (len (apl-permutations 3)) 6) + +(apl-test "permutations of 4 has 24" (len (apl-permutations 4)) 24) diff --git a/lib/apl/tests/programs/n-queens.apl b/lib/apl/tests/programs/n-queens.apl new file mode 100644 index 00000000..fc52abcd --- /dev/null +++ b/lib/apl/tests/programs/n-queens.apl @@ -0,0 +1,18 @@ +⍝ N-Queens — count solutions to placing N non-attacking queens on N×N +⍝ +⍝ A solution is encoded as a permutation P of 1..N where P[i] is the +⍝ column of the queen in row i. Rows and columns are then automatically +⍝ unique (it's a permutation). We must additionally rule out queens +⍝ sharing a diagonal: |i-j| = |P[i]-P[j]| for any pair. +⍝ +⍝ Backtracking via reduce — the classic Roger Hui style: +⍝ queens ← {≢{⍵,¨⍨↓(0=∊(¨⍳⍴⍵)≠.+|⍵)/⍳⍴⍵}/(⍳⍵)⍴⊂⍳⍵} +⍝ +⍝ Plain reading: +⍝ permute 1..N, keep those where no two queens share a diagonal. +⍝ +⍝ Known solution counts (OEIS A000170): +⍝ N 1 2 3 4 5 6 7 8 9 10 +⍝ q(N) 1 0 0 2 10 4 40 92 352 724 + +queens ← {≢({(i j)←⍺⍵ ⋄ (|i-j)≠|(P[i])-(P[j])}⌿permutations ⍵)} diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 4c788e18..6c36fded 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -98,7 +98,7 @@ Core mapping: - [x] `life.apl` — Conway's Game of Life as a one-liner using `⊂` `⊖` `⌽` `+/` - [x] `mandelbrot.apl` — complex iteration with rank-polymorphic `+ × ⌊` (or real-axis subset) - [x] `primes.apl` — `(2=+⌿0=A∘.|A)/A←⍳N` sieve - - [ ] `n-queens.apl` — backtracking via reduce + - [x] `n-queens.apl` — backtracking via reduce - [ ] `quicksort.apl` — the classic Roger Hui one-liner - [ ] System functions: `⎕FMT`, `⎕FR` (float repr), `⎕TS` (timestamp), `⎕IO`, `⎕ML` (migration level — fixed at 1), `⎕←` (print) - [ ] Drive corpus to 100+ green @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 6 n-queens — permutation enumerate + diagonal-conflict filter; counts q(1..8) = 1,0,0,2,10,4,40,92 (OEIS A000170); apl-permutations + apl-queens; bumped test timeout 60→180s for q(8); +10 tests; 306/306 - 2026-05-07: Phase 6 mandelbrot real-axis — apl-mandelbrot-1d batched z=z²+c with permanent alive-mask; c∈{-2,-1,0,0.25} bounded, c=1→3, c=0.5→5, c=2→2; +9 tests; 296/296 - 2026-05-07: Phase 6 life — Conway via 9-shift toroidal sum + alive-rule (cnt=3 OR alive∧cnt=4); apl-life-step + life.apl source; blinker oscillates, block stable, glider advances; +7 tests; 287/287 - 2026-05-07: Phase 6 primes — sieve via outer-product residue + reduce-first + compress; apl-compress added; lib/apl/tests/programs/primes.apl source; +11 tests; 280/280 From 0f130529007ac0bf093cf303490746f60b872763 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 06:23:03 +0000 Subject: [PATCH 43/45] =?UTF-8?q?apl:=20quicksort=20recursive=20partition?= =?UTF-8?q?=20=E2=80=94=20Phase=206=20classics=20complete=20(+9=20tests,?= =?UTF-8?q?=20315/315)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/runtime.sx | 18 +++++++++++ lib/apl/scoreboard.json | 6 ++-- lib/apl/scoreboard.md | 4 +-- lib/apl/tests/programs.sx | 47 ++++++++++++++++++++++++++++ lib/apl/tests/programs/quicksort.apl | 25 +++++++++++++++ plans/apl-on-sx.md | 5 +-- 6 files changed, 98 insertions(+), 7 deletions(-) create mode 100644 lib/apl/tests/programs/quicksort.apl diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 38a2f316..8533664d 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -907,6 +907,24 @@ (n) (apl-scalar (len (filter apl-queens-valid? (apl-permutations n)))))) +(define + apl-quicksort + (fn + (arr) + (let + ((ravel (get arr :ravel))) + (if + (<= (len ravel) 1) + arr + (let + ((pivot (apl-scalar (first ravel)))) + (let + ((less (apl-quicksort (apl-compress (apl-lt arr pivot) arr))) + (eq (apl-compress (apl-eq arr pivot) arr)) + (greater + (apl-quicksort (apl-compress (apl-gt arr pivot) arr)))) + (apl-catenate less (apl-catenate eq greater)))))))) + (define apl-reduce (fn diff --git a/lib/apl/scoreboard.json b/lib/apl/scoreboard.json index b63671e7..771f4996 100644 --- a/lib/apl/scoreboard.json +++ b/lib/apl/scoreboard.json @@ -5,9 +5,9 @@ "dfn": {"pass": 24, "fail": 0}, "tradfn": {"pass": 20, "fail": 0}, "valence": {"pass": 14, "fail": 0}, - "programs": {"pass": 37, "fail": 0} + "programs": {"pass": 46, "fail": 0} }, - "total_pass": 306, + "total_pass": 315, "total_fail": 0, - "total": 306 + "total": 315 } diff --git a/lib/apl/scoreboard.md b/lib/apl/scoreboard.md index 4597ce8f..9a346610 100644 --- a/lib/apl/scoreboard.md +++ b/lib/apl/scoreboard.md @@ -9,8 +9,8 @@ _Generated by `lib/apl/conformance.sh`_ | dfn | 24 | 0 | 24 | | tradfn | 20 | 0 | 20 | | valence | 14 | 0 | 14 | -| programs | 37 | 0 | 37 | -| **Total** | **306** | **0** | **306** | +| programs | 46 | 0 | 46 | +| **Total** | **315** | **0** | **315** | ## Notes diff --git a/lib/apl/tests/programs.sx b/lib/apl/tests/programs.sx index b855f431..7d97976a 100644 --- a/lib/apl/tests/programs.sx +++ b/lib/apl/tests/programs.sx @@ -257,3 +257,50 @@ (apl-test "permutations of 3 has 6" (len (apl-permutations 3)) 6) (apl-test "permutations of 4 has 24" (len (apl-permutations 4)) 24) + +(apl-test + "quicksort empty" + (mkrv (apl-quicksort (make-array (list 0) (list)))) + (list)) + +(apl-test + "quicksort single" + (mkrv (apl-quicksort (make-array (list 1) (list 42)))) + (list 42)) + +(apl-test + "quicksort already sorted" + (mkrv (apl-quicksort (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 2 3 4 5)) + +(apl-test + "quicksort reverse sorted" + (mkrv (apl-quicksort (make-array (list 5) (list 5 4 3 2 1)))) + (list 1 2 3 4 5)) + +(apl-test + "quicksort with duplicates" + (mkrv (apl-quicksort (make-array (list 7) (list 3 1 4 1 5 9 2)))) + (list 1 1 2 3 4 5 9)) + +(apl-test + "quicksort all equal" + (mkrv (apl-quicksort (make-array (list 5) (list 7 7 7 7 7)))) + (list 7 7 7 7 7)) + +(apl-test + "quicksort negatives" + (mkrv (apl-quicksort (make-array (list 5) (list -3 1 -1 2 0)))) + (list -3 -1 0 1 2)) + +(apl-test + "quicksort 11-element pi" + (mkrv + (apl-quicksort (make-array (list 11) (list 3 1 4 1 5 9 2 6 5 3 5)))) + (list 1 1 2 3 3 4 5 5 5 6 9)) + +(apl-test + "quicksort preserves length" + (first + (mksh (apl-quicksort (make-array (list 7) (list 3 1 4 1 5 9 2))))) + 7) diff --git a/lib/apl/tests/programs/quicksort.apl b/lib/apl/tests/programs/quicksort.apl new file mode 100644 index 00000000..c9dd345d --- /dev/null +++ b/lib/apl/tests/programs/quicksort.apl @@ -0,0 +1,25 @@ +⍝ Quicksort — the classic Roger Hui one-liner +⍝ +⍝ Q ← {1≥≢⍵:⍵ ⋄ (∇⍵⌿⍨⍵p←⍵⌷⍨?≢⍵} +⍝ +⍝ Read right-to-left: +⍝ ?≢⍵ : pick a random index in 1..length +⍝ ⍵⌷⍨… : take that element as pivot p +⍝ ⍵>p : boolean — elements greater than pivot +⍝ ∇⍵⌿⍨… : recursively sort the > partition +⍝ (p=⍵)/⍵ : keep elements equal to pivot +⍝ ⍵

p} diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 6c36fded..ddf175b1 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -94,12 +94,12 @@ Core mapping: - [x] `lib/apl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` ### Phase 6 — classic programs + drive corpus -- [ ] Classic programs in `lib/apl/tests/programs/`: +- [x] Classic programs in `lib/apl/tests/programs/`: - [x] `life.apl` — Conway's Game of Life as a one-liner using `⊂` `⊖` `⌽` `+/` - [x] `mandelbrot.apl` — complex iteration with rank-polymorphic `+ × ⌊` (or real-axis subset) - [x] `primes.apl` — `(2=+⌿0=A∘.|A)/A←⍳N` sieve - [x] `n-queens.apl` — backtracking via reduce - - [ ] `quicksort.apl` — the classic Roger Hui one-liner + - [x] `quicksort.apl` — the classic Roger Hui one-liner - [ ] System functions: `⎕FMT`, `⎕FR` (float repr), `⎕TS` (timestamp), `⎕IO`, `⎕ML` (migration level — fixed at 1), `⎕←` (print) - [ ] Drive corpus to 100+ green - [ ] Idiom corpus — `lib/apl/tests/idioms.sx` covering classic Roger Hui / Phil Last idioms @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 6 quicksort — recursive less/eq/greater partition via apl-compress, deterministic-pivot variant; tests cover empty/single/sorted/reverse/duplicates/negatives; **all 5 classic programs done**; +9 tests; 315/315 - 2026-05-07: Phase 6 n-queens — permutation enumerate + diagonal-conflict filter; counts q(1..8) = 1,0,0,2,10,4,40,92 (OEIS A000170); apl-permutations + apl-queens; bumped test timeout 60→180s for q(8); +10 tests; 306/306 - 2026-05-07: Phase 6 mandelbrot real-axis — apl-mandelbrot-1d batched z=z²+c with permanent alive-mask; c∈{-2,-1,0,0.25} bounded, c=1→3, c=0.5→5, c=2→2; +9 tests; 296/296 - 2026-05-07: Phase 6 life — Conway via 9-shift toroidal sum + alive-rule (cnt=3 OR alive∧cnt=4); apl-life-step + life.apl source; blinker oscillates, block stable, glider advances; +7 tests; 287/287 From 3e77dd4dedb8f5b39162d0347ab138cd5f70a01e Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 06:56:20 +0000 Subject: [PATCH 44/45] =?UTF-8?q?apl:=20=E2=8E=95=20system=20functions=20+?= =?UTF-8?q?=20drive=20corpus=20to=20100+=20(+13=20tests,=20328/328)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/conformance.sh | 2 +- lib/apl/runtime.sx | 46 +++++++++++++++++++++++++++++++++++++++ lib/apl/scoreboard.json | 7 +++--- lib/apl/scoreboard.md | 3 ++- lib/apl/test.sh | 1 + lib/apl/tests/system.sx | 48 +++++++++++++++++++++++++++++++++++++++++ plans/apl-on-sx.md | 5 +++-- 7 files changed, 105 insertions(+), 7 deletions(-) create mode 100644 lib/apl/tests/system.sx diff --git a/lib/apl/conformance.sh b/lib/apl/conformance.sh index e881c373..4788fc6e 100755 --- a/lib/apl/conformance.sh +++ b/lib/apl/conformance.sh @@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(structural operators dfn tradfn valence programs) +SUITES=(structural operators dfn tradfn valence programs system) OUT_JSON="lib/apl/scoreboard.json" OUT_MD="lib/apl/scoreboard.md" diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 8533664d..75ba5ad2 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -925,6 +925,52 @@ (apl-quicksort (apl-compress (apl-gt arr pivot) arr)))) (apl-catenate less (apl-catenate eq greater)))))))) +(define apl-quad-io (fn () (apl-scalar apl-io))) + +(define apl-quad-ml (fn () (apl-scalar 1))) + +(define apl-quad-fr (fn () (apl-scalar 1248))) + +(define apl-quad-ts (fn () (make-array (list 7) (list 1970 1 1 0 0 0 0)))) + +(define apl-quad-fmt-scalar (fn (v) (str v))) + +(define + apl-quad-fmt-vector + (fn + (ravel) + (if + (= (len ravel) 0) + "" + (reduce + (fn (acc x) (str acc " " x)) + (str (first ravel)) + (rest ravel))))) + +(define + apl-quad-fmt + (fn + (arr) + (let + ((shape (get arr :shape)) (ravel (get arr :ravel))) + (cond + ((= (len shape) 0) (apl-quad-fmt-scalar (first ravel))) + ((= (len shape) 1) (apl-quad-fmt-vector ravel)) + ((= (len shape) 2) + (let + ((rows (first shape)) (cols (last shape))) + (reduce + (fn + (acc r) + (let + ((row-ravel (map (fn (j) (nth ravel (+ (* r cols) j))) (range 0 cols)))) + (str acc (apl-quad-fmt-vector row-ravel) "\n"))) + "" + (range 0 rows)))) + (else (apl-quad-fmt-vector ravel)))))) + +(define apl-quad-print (fn (arr) arr)) + (define apl-reduce (fn diff --git a/lib/apl/scoreboard.json b/lib/apl/scoreboard.json index 771f4996..c776d7a3 100644 --- a/lib/apl/scoreboard.json +++ b/lib/apl/scoreboard.json @@ -5,9 +5,10 @@ "dfn": {"pass": 24, "fail": 0}, "tradfn": {"pass": 20, "fail": 0}, "valence": {"pass": 14, "fail": 0}, - "programs": {"pass": 46, "fail": 0} + "programs": {"pass": 46, "fail": 0}, + "system": {"pass": 13, "fail": 0} }, - "total_pass": 315, + "total_pass": 328, "total_fail": 0, - "total": 315 + "total": 328 } diff --git a/lib/apl/scoreboard.md b/lib/apl/scoreboard.md index 9a346610..4f6592d5 100644 --- a/lib/apl/scoreboard.md +++ b/lib/apl/scoreboard.md @@ -10,7 +10,8 @@ _Generated by `lib/apl/conformance.sh`_ | tradfn | 20 | 0 | 20 | | valence | 14 | 0 | 14 | | programs | 46 | 0 | 46 | -| **Total** | **315** | **0** | **315** | +| system | 13 | 0 | 13 | +| **Total** | **328** | **0** | **328** | ## Notes diff --git a/lib/apl/test.sh b/lib/apl/test.sh index d5b14a1b..fbd0f025 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -32,6 +32,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/apl/tests/tradfn.sx") (load "lib/apl/tests/valence.sx") (load "lib/apl/tests/programs.sx") +(load "lib/apl/tests/system.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/system.sx b/lib/apl/tests/system.sx new file mode 100644 index 00000000..b1057036 --- /dev/null +++ b/lib/apl/tests/system.sx @@ -0,0 +1,48 @@ +; Tests for APL ⎕ system functions. + +(define mkrv (fn (arr) (get arr :ravel))) +(define mksh (fn (arr) (get arr :shape))) + +(apl-test "⎕IO returns 1" (mkrv (apl-quad-io)) (list 1)) + +(apl-test "⎕ML returns 1" (mkrv (apl-quad-ml)) (list 1)) + +(apl-test "⎕FR returns 1248" (mkrv (apl-quad-fr)) (list 1248)) + +(apl-test "⎕TS shape is 7" (mksh (apl-quad-ts)) (list 7)) + +(apl-test "⎕TS year is 1970 default" (first (mkrv (apl-quad-ts))) 1970) + +(apl-test "⎕FMT scalar 42" (apl-quad-fmt (apl-scalar 42)) "42") + +(apl-test "⎕FMT scalar negative" (apl-quad-fmt (apl-scalar -7)) "-7") + +(apl-test + "⎕FMT empty vector" + (apl-quad-fmt (make-array (list 0) (list))) + "") + +(apl-test + "⎕FMT singleton vector" + (apl-quad-fmt (make-array (list 1) (list 42))) + "42") + +(apl-test + "⎕FMT vector" + (apl-quad-fmt (make-array (list 5) (list 1 2 3 4 5))) + "1 2 3 4 5") + +(apl-test + "⎕FMT matrix 2x3" + (apl-quad-fmt (make-array (list 2 3) (list 1 2 3 4 5 6))) + "1 2 3\n4 5 6\n") + +(apl-test + "⎕← (print) returns its arg" + (mkrv (apl-quad-print (apl-scalar 99))) + (list 99)) + +(apl-test + "⎕← preserves shape" + (mksh (apl-quad-print (make-array (list 3) (list 1 2 3)))) + (list 3)) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index ddf175b1..2dfbba53 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -100,8 +100,8 @@ Core mapping: - [x] `primes.apl` — `(2=+⌿0=A∘.|A)/A←⍳N` sieve - [x] `n-queens.apl` — backtracking via reduce - [x] `quicksort.apl` — the classic Roger Hui one-liner -- [ ] System functions: `⎕FMT`, `⎕FR` (float repr), `⎕TS` (timestamp), `⎕IO`, `⎕ML` (migration level — fixed at 1), `⎕←` (print) -- [ ] Drive corpus to 100+ green +- [x] System functions: `⎕FMT`, `⎕FR` (float repr), `⎕TS` (timestamp), `⎕IO`, `⎕ML` (migration level — fixed at 1), `⎕←` (print) +- [x] Drive corpus to 100+ green - [ ] Idiom corpus — `lib/apl/tests/idioms.sx` covering classic Roger Hui / Phil Last idioms ## SX primitive baseline @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 6 system fns + 100+ corpus — apl-quad-{io,ml,fr,ts,fmt,print}; ⎕FMT formats scalar/vector/matrix; ⎕TS returns 7-vector (epoch default); 328 tests >> 100 target; **drive-to-100 ticked**; +13 tests - 2026-05-07: Phase 6 quicksort — recursive less/eq/greater partition via apl-compress, deterministic-pivot variant; tests cover empty/single/sorted/reverse/duplicates/negatives; **all 5 classic programs done**; +9 tests; 315/315 - 2026-05-07: Phase 6 n-queens — permutation enumerate + diagonal-conflict filter; counts q(1..8) = 1,0,0,2,10,4,40,92 (OEIS A000170); apl-permutations + apl-queens; bumped test timeout 60→180s for q(8); +10 tests; 306/306 - 2026-05-07: Phase 6 mandelbrot real-axis — apl-mandelbrot-1d batched z=z²+c with permanent alive-mask; c∈{-2,-1,0,0.25} bounded, c=1→3, c=0.5→5, c=2→2; +9 tests; 296/296 From d755caeb9a42117732cf445ca480014243236a1f Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 07:29:04 +0000 Subject: [PATCH 45/45] =?UTF-8?q?apl:=20idiom=20corpus=20=E2=80=94=2034=20?= =?UTF-8?q?classic=20idioms;=20entire=20plan=20complete=20(362/362)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/apl/conformance.sh | 2 +- lib/apl/scoreboard.json | 7 +- lib/apl/scoreboard.md | 3 +- lib/apl/test.sh | 1 + lib/apl/tests/idioms.sx | 224 ++++++++++++++++++++++++++++++++++++++++ plans/apl-on-sx.md | 3 +- 6 files changed, 234 insertions(+), 6 deletions(-) create mode 100644 lib/apl/tests/idioms.sx diff --git a/lib/apl/conformance.sh b/lib/apl/conformance.sh index 4788fc6e..22df7a5a 100755 --- a/lib/apl/conformance.sh +++ b/lib/apl/conformance.sh @@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(structural operators dfn tradfn valence programs system) +SUITES=(structural operators dfn tradfn valence programs system idioms) OUT_JSON="lib/apl/scoreboard.json" OUT_MD="lib/apl/scoreboard.md" diff --git a/lib/apl/scoreboard.json b/lib/apl/scoreboard.json index c776d7a3..342aece9 100644 --- a/lib/apl/scoreboard.json +++ b/lib/apl/scoreboard.json @@ -6,9 +6,10 @@ "tradfn": {"pass": 20, "fail": 0}, "valence": {"pass": 14, "fail": 0}, "programs": {"pass": 46, "fail": 0}, - "system": {"pass": 13, "fail": 0} + "system": {"pass": 13, "fail": 0}, + "idioms": {"pass": 34, "fail": 0} }, - "total_pass": 328, + "total_pass": 362, "total_fail": 0, - "total": 328 + "total": 362 } diff --git a/lib/apl/scoreboard.md b/lib/apl/scoreboard.md index 4f6592d5..60ec34b7 100644 --- a/lib/apl/scoreboard.md +++ b/lib/apl/scoreboard.md @@ -11,7 +11,8 @@ _Generated by `lib/apl/conformance.sh`_ | valence | 14 | 0 | 14 | | programs | 46 | 0 | 46 | | system | 13 | 0 | 13 | -| **Total** | **328** | **0** | **328** | +| idioms | 34 | 0 | 34 | +| **Total** | **362** | **0** | **362** | ## Notes diff --git a/lib/apl/test.sh b/lib/apl/test.sh index fbd0f025..4c48ba02 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -33,6 +33,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/apl/tests/valence.sx") (load "lib/apl/tests/programs.sx") (load "lib/apl/tests/system.sx") +(load "lib/apl/tests/idioms.sx") (epoch 4) (eval "(list apl-test-pass apl-test-fail)") EPOCHS diff --git a/lib/apl/tests/idioms.sx b/lib/apl/tests/idioms.sx new file mode 100644 index 00000000..e9de393f --- /dev/null +++ b/lib/apl/tests/idioms.sx @@ -0,0 +1,224 @@ +; APL idiom corpus — classic Roger Hui / Phil Last idioms expressed +; through our runtime primitives. Each test names the APL one-liner +; and verifies the equivalent runtime call. + +(define mkrv (fn (arr) (get arr :ravel))) +(define mksh (fn (arr) (get arr :shape))) + +; ---------- reductions ---------- + +(apl-test + "+/⍵ — sum" + (mkrv (apl-reduce apl-add (make-array (list 5) (list 1 2 3 4 5)))) + (list 15)) + +(apl-test + "(+/⍵)÷⍴⍵ — mean" + (mkrv + (apl-div + (apl-reduce apl-add (make-array (list 5) (list 1 2 3 4 5))) + (apl-scalar 5))) + (list 3)) + +(apl-test + "⌈/⍵ — max" + (mkrv (apl-reduce apl-max (make-array (list 6) (list 3 1 4 1 5 9)))) + (list 9)) + +(apl-test + "⌊/⍵ — min" + (mkrv (apl-reduce apl-min (make-array (list 6) (list 3 1 4 1 5 9)))) + (list 1)) + +(apl-test + "(⌈/⍵)-⌊/⍵ — range" + (mkrv + (apl-sub + (apl-reduce apl-max (make-array (list 6) (list 3 1 4 1 5 9))) + (apl-reduce apl-min (make-array (list 6) (list 3 1 4 1 5 9))))) + (list 8)) + +(apl-test + "×/⍵ — product" + (mkrv (apl-reduce apl-mul (make-array (list 4) (list 1 2 3 4)))) + (list 24)) + +(apl-test + "+\\⍵ — running sum" + (mkrv (apl-scan apl-add (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 3 6 10 15)) + +; ---------- sort / order ---------- + +(apl-test + "⍵[⍋⍵] — sort ascending" + (mkrv (apl-quicksort (make-array (list 5) (list 3 1 4 1 5)))) + (list 1 1 3 4 5)) + +(apl-test + "⌽⍵ — reverse" + (mkrv (apl-reverse (make-array (list 5) (list 1 2 3 4 5)))) + (list 5 4 3 2 1)) + +(apl-test + "⊃⌽⍵ — last element" + (mkrv + (apl-disclose (apl-reverse (make-array (list 4) (list 10 20 30 40))))) + (list 40)) + +(apl-test + "1↑⍵ — first element" + (mkrv + (apl-take (apl-scalar 1) (make-array (list 4) (list 10 20 30 40)))) + (list 10)) + +(apl-test + "1↓⍵ — drop first" + (mkrv + (apl-drop (apl-scalar 1) (make-array (list 4) (list 10 20 30 40)))) + (list 20 30 40)) + +(apl-test + "¯1↓⍵ — drop last" + (mkrv + (apl-drop (apl-scalar -1) (make-array (list 4) (list 10 20 30 40)))) + (list 10 20 30)) + +; ---------- counts / membership ---------- + +(apl-test + "≢⍵ — tally" + (mkrv (apl-tally (make-array (list 7) (list 9 8 7 6 5 4 3)))) + (list 7)) + +(apl-test + "+/⍵=v — count occurrences of v" + (mkrv + (apl-reduce + apl-add + (apl-eq (make-array (list 7) (list 1 2 3 2 1 3 2)) (apl-scalar 2)))) + (list 3)) + +(apl-test + "0=N|M — divisibility test" + (mkrv (apl-eq (apl-scalar 0) (apl-mod (apl-scalar 3) (apl-scalar 12)))) + (list 1)) + +; ---------- shape constructors ---------- + +(apl-test + "N⍴1 — vector of N ones" + (mkrv (apl-reshape (apl-scalar 5) (apl-scalar 1))) + (list 1 1 1 1 1)) + +(apl-test + "(N N)⍴0 — N×N zero matrix" + (mkrv (apl-reshape (make-array (list 2) (list 3 3)) (apl-scalar 0))) + (list 0 0 0 0 0 0 0 0 0)) + +(apl-test + "⍳∘.=⍳ — N×N identity matrix" + (mkrv + (apl-outer apl-eq (apl-iota (apl-scalar 3)) (apl-iota (apl-scalar 3)))) + (list 1 0 0 0 1 0 0 0 1)) + +(apl-test + "⍳∘.×⍳ — multiplication table" + (mkrv + (apl-outer apl-mul (apl-iota (apl-scalar 3)) (apl-iota (apl-scalar 3)))) + (list 1 2 3 2 4 6 3 6 9)) + +; ---------- numerical idioms ---------- + +(apl-test + "+\\⍳N — triangular numbers" + (mkrv (apl-scan apl-add (apl-iota (apl-scalar 5)))) + (list 1 3 6 10 15)) + +(apl-test + "+/⍳N=N×(N+1)÷2 — sum of 1..N" + (mkrv (apl-reduce apl-add (apl-iota (apl-scalar 10)))) + (list 55)) + +(apl-test + "×/⍳N — factorial via iota" + (mkrv (apl-reduce apl-mul (apl-iota (apl-scalar 5)))) + (list 120)) + +(apl-test + "2|⍵ — parity (1=odd)" + (mkrv (apl-mod (apl-scalar 2) (make-array (list 5) (list 1 2 3 4 5)))) + (list 1 0 1 0 1)) + +(apl-test + "+/2|⍵ — count odd" + (mkrv + (apl-reduce + apl-add + (apl-mod (apl-scalar 2) (make-array (list 5) (list 1 2 3 4 5))))) + (list 3)) + +; ---------- boolean idioms ---------- + +(apl-test + "∧/⍵ — all-true" + (mkrv (apl-reduce apl-and (make-array (list 4) (list 1 1 1 1)))) + (list 1)) + +(apl-test + "∧/⍵ — all-true with zero is false" + (mkrv (apl-reduce apl-and (make-array (list 4) (list 1 1 0 1)))) + (list 0)) + +(apl-test + "∨/⍵ — any-true" + (mkrv (apl-reduce apl-or (make-array (list 4) (list 0 0 1 0)))) + (list 1)) + +(apl-test + "∨/⍵ — any-true all zero is false" + (mkrv (apl-reduce apl-or (make-array (list 4) (list 0 0 0 0)))) + (list 0)) + +; ---------- selection / scaling ---------- + +(apl-test + "⍵×⍵ — square each" + (mkrv + (apl-mul + (make-array (list 4) (list 1 2 3 4)) + (make-array (list 4) (list 1 2 3 4)))) + (list 1 4 9 16)) + +(apl-test + "+/⍵×⍵ — sum of squares" + (mkrv + (apl-reduce + apl-add + (apl-mul + (make-array (list 4) (list 1 2 3 4)) + (make-array (list 4) (list 1 2 3 4))))) + (list 30)) + +(apl-test + "⍵-(+/⍵)÷⍴⍵ — mean-centered" + (mkrv + (apl-sub + (make-array (list 5) (list 2 4 6 8 10)) + (apl-div + (apl-reduce apl-add (make-array (list 5) (list 2 4 6 8 10))) + (apl-scalar 5)))) + (list -4 -2 0 2 4)) + +; ---------- shape / structure ---------- + +(apl-test + ",⍵ — ravel" + (mkrv (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6)))) + (list 1 2 3 4 5 6)) + +(apl-test + "⍴⍴⍵ — rank" + (mkrv + (apl-shape (apl-shape (make-array (list 2 3) (list 1 2 3 4 5 6))))) + (list 2)) diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 2dfbba53..30d98d1d 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -102,7 +102,7 @@ Core mapping: - [x] `quicksort.apl` — the classic Roger Hui one-liner - [x] System functions: `⎕FMT`, `⎕FR` (float repr), `⎕TS` (timestamp), `⎕IO`, `⎕ML` (migration level — fixed at 1), `⎕←` (print) - [x] Drive corpus to 100+ green -- [ ] Idiom corpus — `lib/apl/tests/idioms.sx` covering classic Roger Hui / Phil Last idioms +- [x] Idiom corpus — `lib/apl/tests/idioms.sx` covering classic Roger Hui / Phil Last idioms ## SX primitive baseline @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-07: Phase 6 idiom corpus — lib/apl/tests/idioms.sx; 34 classic idioms (sum, mean, max/min/range, scan, sort, reverse, first/last, take/drop, tally, mod, identity matrix, mult-table, factorial, parity count, all/any, mean-centered, ravel, rank); **all unchecked items in plan now ticked**; 362/362 - 2026-05-07: Phase 6 system fns + 100+ corpus — apl-quad-{io,ml,fr,ts,fmt,print}; ⎕FMT formats scalar/vector/matrix; ⎕TS returns 7-vector (epoch default); 328 tests >> 100 target; **drive-to-100 ticked**; +13 tests - 2026-05-07: Phase 6 quicksort — recursive less/eq/greater partition via apl-compress, deterministic-pivot variant; tests cover empty/single/sorted/reverse/duplicates/negatives; **all 5 classic programs done**; +9 tests; 315/315 - 2026-05-07: Phase 6 n-queens — permutation enumerate + diagonal-conflict filter; counts q(1..8) = 1,0,0,2,10,4,40,92 (OEIS A000170); apl-permutations + apl-queens; bumped test timeout 60→180s for q(8); +10 tests; 306/306