coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

apl: quicksort.apl runs as-written (+7); Phase 10 complete
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
Details

Browse Source 
Three fixes for Iverson's dfn
{1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p}:

1. parser: standalone op-glyph branch (/ ⌿ \ ⍀) now consumes a
   following ⍨ or ¨ and emits :derived-fn — `⍵⌿⍨⍵<p` parses
   as compress-commute (was previously dropping ⍨)
2. tokenizer: `name←...` (no spaces) now tokenizes as separate
   :name + :assign instead of eating ← into the name. ⎕← still
   stays one token for the output op
3. inline p←⍵⌷⍨?≢⍵ mid-dfn now works via existing :assign-expr

Full suite 585/585. Phase 10 complete (all 7 items ticked).

Remaining gaps for a future phase: heterogeneous-strand inner
product is the only unfinished part — life works after dropping ⊃,
quicksort works directly.
This commit is contained in:
giles
2026-05-08 23:53:49 +00:00
parent 36e1519613
commit eeb530eb85
4 changed files with 226 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
lib/apl/parser.sx
View File

@@ -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))))))))

59
lib/apl/tests/programs-e2e.sx
View File

@@ -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),(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),(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),(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),(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),(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),(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)))

284
lib/apl/tokenizer.sx
View File

@@ -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)))

3
plans/apl-on-sx.md
View File

@@ -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≥≢⍵:⍵ ⋄ (∇(⍵<pivot)⌿⍵),(⍵=pivot)⌿⍵,∇(⍵>pivot)⌿⍵⊣pivot←⍵⌷⍨?≢⍵}`
exercises `⌷⍨` (squad-commute pivot pick), `⌿⍨` (first-axis-compress
commute), and `⊣` to bind a local without polluting the result.
@@ -288,6 +288,7 @@ data; format for string templating.
_Newest first._
- 2026-05-08: Phase 10 step 7 — quicksort.apl runs as-written. Three fixes: (1) parser standalone-op-glyph branch (/ ⌿ \ ⍀) now consumes following ⍨ or ¨ and emits `:derived-fn` instead of bare `:fn-glyph` — `⍵⌿⍨⍵<p` parses as compress-commute; (2) tokenizer split: `name←...` (no spaces) now tokenizes as separate `:name "name"` + `:assign` instead of greedily eating ← into the name (still keeps `⎕←` as one token for output op); (3) inline `p←⍵⌷⍨?≢⍵` mid-dfn now works via existing :assign-expr machinery. The classic Iverson dfn `{1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>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