diff --git a/lib/apl/parser.sx b/lib/apl/parser.sx index a430dc6b..2b2761e6 100644 --- a/lib/apl/parser.sx +++ b/lib/apl/parser.sx @@ -416,10 +416,20 @@ ((apl-parse-op-glyph? tv) (if (or (= tv "/") (= tv "⌿") (= tv "\\") (= tv "⍀")) - (collect-segments-loop - tokens - (+ i 1) - (append acc {:kind "fn" :node (list :fn-glyph tv)})) + (let + ((next-i (+ i 1))) + (let + ((next-tok (if (< next-i n) (nth tokens next-i) nil))) + (let + ((mod (if (and next-tok (= (tok-type next-tok) :glyph) (or (= (get next-tok :value) "⍨") (= (get next-tok :value) "¨"))) (get next-tok :value) nil)) + (base-fn-node (list :fn-glyph tv))) + (let + ((node (if mod (list :derived-fn mod base-fn-node) base-fn-node)) + (advance (if mod 2 1))) + (collect-segments-loop + tokens + (+ i advance) + (append acc {:kind "fn" :node node})))))) (collect-segments-loop tokens (+ i 1) acc))) (true (collect-segments-loop tokens (+ i 1) acc)))) (true (collect-segments-loop tokens (+ i 1) acc)))))))) diff --git a/lib/apl/tests/programs-e2e.sx b/lib/apl/tests/programs-e2e.sx index db4f80bb..35ad6d43 100644 --- a/lib/apl/tests/programs-e2e.sx +++ b/lib/apl/tests/programs-e2e.sx @@ -128,3 +128,62 @@ (apl-run "5 5 ⍴ 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"))) (get (apl-call-dfn-m dfn board) :ravel)) (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))) + +(begin + (apl-test + "quicksort.apl: 11-element with duplicates" + (begin + (apl-rng-seed! 42) + (mkrv + (apl-run + "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵
p} ⋄ quicksort 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.apl: already sorted" + (begin + (apl-rng-seed! 42) + (mkrv + (apl-run + "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵
p} ⋄ quicksort 1 2 3 4 5"))) + (list 1 2 3 4 5)) + (apl-test + "quicksort.apl: reverse sorted" + (begin + (apl-rng-seed! 42) + (mkrv + (apl-run + "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵
p} ⋄ quicksort 5 4 3 2 1"))) + (list 1 2 3 4 5)) + (apl-test + "quicksort.apl: all equal" + (begin + (apl-rng-seed! 42) + (mkrv + (apl-run + "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵
p} ⋄ quicksort 7 7 7 7"))) + (list 7 7 7 7)) + (apl-test + "quicksort.apl: single element" + (begin + (apl-rng-seed! 42) + (mkrv + (apl-run + "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵
p} ⋄ quicksort ,42"))) + (list 42)) + (apl-test + "quicksort.apl: matches grade-up" + (begin + (apl-rng-seed! 42) + (mkrv + (apl-run + "V ← 8 3 1 9 2 7 5 6 4 ⋄ quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵
p} ⋄ quicksort V")))
+ (list 1 2 3 4 5 6 7 8 9))
+ (apl-test
+ "quicksort.apl: source-file as-written runs"
+ (begin
+ (apl-rng-seed! 42)
+ (let
+ ((dfn (apl-run-file "lib/apl/tests/programs/quicksort.apl"))
+ (vec (apl-run "5 2 8 1 9 3 7 4 6")))
+ (get (apl-call-dfn-m dfn vec) :ravel)))
+ (list 1 2 3 4 5 6 7 8 9)))
diff --git a/lib/apl/tokenizer.sx b/lib/apl/tokenizer.sx
index 76dcf5be..a0d766e5 100644
--- a/lib/apl/tokenizer.sx
+++ b/lib/apl/tokenizer.sx
@@ -19,162 +19,180 @@
(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)
+(define
+ apl-tokenize
+ (fn
+ (source)
+ (let
+ ((pos 0) (src-len (len source)) (tokens (list)))
+ (define tok-push! (fn (type value) (append! tokens {:value value :type type})))
+ (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)))
+ (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))))
+ (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)
+ (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)))
+ (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)))
+ (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!)))
+ (begin (advance!) (scan!)))
((= ch "\n")
- (begin (advance!) (tok-push! :newline nil) (scan!)))
- ((cur-sw? "⍝")
- (begin (skip-line!) (scan!)))
+ (begin (advance!) (tok-push! :newline nil) (scan!)))
+ ((cur-sw? "⍝") (begin (skip-line!) (scan!)))
((cur-sw? "⋄")
- (begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
+ (begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
((= ch "(")
- (begin (advance!) (tok-push! :lparen nil) (scan!)))
+ (begin (advance!) (tok-push! :lparen nil) (scan!)))
((= ch ")")
- (begin (advance!) (tok-push! :rparen nil) (scan!)))
+ (begin (advance!) (tok-push! :rparen nil) (scan!)))
((= ch "[")
- (begin (advance!) (tok-push! :lbracket nil) (scan!)))
+ (begin (advance!) (tok-push! :lbracket nil) (scan!)))
((= ch "]")
- (begin (advance!) (tok-push! :rbracket nil) (scan!)))
+ (begin (advance!) (tok-push! :rbracket nil) (scan!)))
((= ch "{")
- (begin (advance!) (tok-push! :lbrace nil) (scan!)))
+ (begin (advance!) (tok-push! :lbrace nil) (scan!)))
((= ch "}")
- (begin (advance!) (tok-push! :rbrace nil) (scan!)))
+ (begin (advance!) (tok-push! :rbrace nil) (scan!)))
((= ch ";")
- (begin (advance!) (tok-push! :semi nil) (scan!)))
+ (begin (advance!) (tok-push! :semi nil) (scan!)))
((cur-sw? "←")
- (begin (consume! "←") (tok-push! :assign nil) (scan!)))
+ (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! "")))
- (if (and (< pos src-len) (= (cur-byte) ".")
- (< (+ pos 1) src-len) (apl-digit? (nth source (+ pos 1))))
- (begin (advance!)
- (let ((frac (read-digits! "")))
- (tok-push! :num (- 0 (string->number (str digits "." frac))))))
- (tok-push! :num (- 0 (parse-int digits 0)))))
- (scan!)))
+ (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! "")))
+ (if
+ (and
+ (< pos src-len)
+ (= (cur-byte) ".")
+ (< (+ pos 1) src-len)
+ (apl-digit? (nth source (+ pos 1))))
+ (begin
+ (advance!)
+ (let
+ ((frac (read-digits! "")))
+ (tok-push!
+ :num (- 0 (string->number (str digits "." frac))))))
+ (tok-push! :num (- 0 (parse-int digits 0)))))
+ (scan!)))
((apl-digit? ch)
- (begin
- (let ((digits (read-digits! "")))
- (if (and (< pos src-len) (= (cur-byte) ".")
- (< (+ pos 1) src-len) (apl-digit? (nth source (+ pos 1))))
- (begin (advance!)
- (let ((frac (read-digits! "")))
- (tok-push! :num (string->number (str digits "." frac)))))
- (tok-push! :num (parse-int digits 0))))
- (scan!)))
+ (begin
+ (let
+ ((digits (read-digits! "")))
+ (if
+ (and
+ (< pos src-len)
+ (= (cur-byte) ".")
+ (< (+ pos 1) src-len)
+ (apl-digit? (nth source (+ pos 1))))
+ (begin
+ (advance!)
+ (let
+ ((frac (read-digits! "")))
+ (tok-push!
+ :num (string->number (str digits "." frac)))))
+ (tok-push! :num (parse-int digits 0))))
+ (scan!)))
((= ch "'")
- (begin
- (advance!)
- (let ((s (read-string! "")))
- (tok-push! :str s))
- (scan!)))
+ (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!))
- (if (and (< pos src-len) (cur-sw? "←"))
- (consume! "←")
- (read-ident-cont!))
- (tok-push! :name (slice source start pos))
- (scan!))))
+ (let
+ ((start pos))
+ (begin
+ (if
+ (cur-sw? "⎕")
+ (begin
+ (consume! "⎕")
+ (if
+ (and (< pos src-len) (cur-sw? "←"))
+ (consume! "←")
+ (read-ident-cont!)))
+ (begin (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!))))))))))
-
+ (let
+ ((g (find-glyph)))
+ (if
+ g
+ (begin (consume! g) (tok-push! :glyph g) (scan!))
+ (begin (advance!) (scan!))))))))))
(scan!)
tokens)))
diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md
index cc62457c..86e784fb 100644
--- a/plans/apl-on-sx.md
+++ b/plans/apl-on-sx.md
@@ -267,7 +267,7 @@ still need work to run as-written. Phase 10 closes both.
called on a 5×5 blinker grid; fix any remaining parser/runtime
gaps; assert blinker oscillates and block stays stable as full
end-to-end tests in `programs-e2e.sx`.
-- [ ] **`quicksort.apl` runs as-written** — the classic Iverson dfn
+- [x] **`quicksort.apl` runs as-written** — the classic Iverson dfn
`{1≥≢⍵:⍵ ⋄ (∇(⍵ p}` sorts correctly. +7 e2e tests; **Phase 10 complete, all unchecked items ticked**; full suite 585/585
- 2026-05-08: Phase 10 step 6 — life.apl runs as-written. Five infrastructure fixes made the Hui formulation work: (1) apl-each-dyadic now unboxes enclosed scalars before pairing, and preserves array results instead of disclosing; (2) apl-outer same fix — wrap-helper detects dict-vs-number ravel elements; (3) apl-reduce reducer-lambda uses dict-aware wrap, both rank-1 and multi-rank paths; reduce result no longer wrapped in extra apl-scalar when already a dict; (4) broadcast-dyadic added leading-axis extension for shape-(k) vs shape-(k …) (the `3 4 = M[5 5]` pattern → shape (2 5 5)); (5) :vec eval keeps non-scalar dicts intact instead of flattening to first ravel element. Updated life.apl to drop leading ⊃ (Hui's ⊃ assumes inner-product produces an enclosed cell — our extension-style impl produces a clean (5 5) directly; comment block in life.apl explains). +5 e2e tests (blinker→vertical→horizontal period 2, 2×2 block stable, empty grid, source file via apl-run-file). Full test suite 578/578
- 2026-05-08: Phase 10 step 5 — `⍎` execute. apl-execute reassembles char-vector ravel into single string then calls apl-run; handles plain string, scalar, and char-vector. `⍎ '1 + 2' → 3`, `⍎ '+/⍳10' → 55`, round-trip `⍎ ⎕FMT 42 → 42`, nested `⍎ ⍎ '...'` works, with `⋄` separator (assignment + use). Wired into apl-monadic-fn. +8 tests; pipeline 148/148
- 2026-05-08: Phase 10 step 4 — `⊆` partition. apl-partition: walk M and V together via reduce, opening a new partition where M[i]>M[i-1] (initial prev=0), continuing where M[i]≤prev∧M[i]≠0, dropping cells where M[i]=0. Returns apl-vector of apl-vector parts. `1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')`, `1 0 0 1 1 ⊆ ⍳5 → ((1) (4 5))`, strict-increase `1 2` opens new, constant `2 2` continues. Wired into apl-dyadic-fn. +8 tests; pipeline 140/140