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