Compare commits
10 Commits
lib/tcl/up
...
loops/apl
| Author | SHA1 | Date | |
|---|---|---|---|
| 40dff449ef | |||
| eeb530eb85 | |||
| 36e1519613 | |||
| d1a491e530 | |||
| 015ecb8bc8 | |||
| a074ea9e98 | |||
| ef53232314 | |||
| 8cdebbe305 | |||
| 58c6ec27f3 | |||
| fa43aa6711 |
@@ -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))))))))
|
||||
|
||||
@@ -65,10 +65,30 @@
|
||||
(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"))))))
|
||||
(let
|
||||
((a-shape (get a :shape)) (b-shape (get b :shape)))
|
||||
(cond
|
||||
((equal? a-shape b-shape)
|
||||
(make-array a-shape (map f (get a :ravel) (get b :ravel))))
|
||||
((and (= (len a-shape) 1) (> (len b-shape) 1))
|
||||
(make-array
|
||||
(append a-shape b-shape)
|
||||
(flatten
|
||||
(map
|
||||
(fn
|
||||
(x)
|
||||
(get (broadcast-dyadic f (apl-scalar x) b) :ravel))
|
||||
(get a :ravel)))))
|
||||
((and (= (len b-shape) 1) (> (len a-shape) 1))
|
||||
(make-array
|
||||
(append a-shape b-shape)
|
||||
(flatten
|
||||
(map
|
||||
(fn
|
||||
(acell)
|
||||
(get (broadcast-dyadic f (apl-scalar acell) b) :ravel))
|
||||
(get a :ravel)))))
|
||||
(else (error "length error: shape mismatch"))))))))
|
||||
|
||||
; ============================================================
|
||||
; Arithmetic primitives
|
||||
@@ -827,6 +847,106 @@
|
||||
((new-ravel (reduce (fn (acc r) (append acc (map (fn (j) (nth ravel (+ (* r cols) j))) (range 0 cols)))) (list) kept-rows)))
|
||||
(make-array (cons (len kept-rows) (rest shape)) new-ravel))))))))
|
||||
|
||||
(define
|
||||
apl-where
|
||||
(fn
|
||||
(arr)
|
||||
(let
|
||||
((ravel (get arr :ravel)) (io (disclose (apl-quad-io))))
|
||||
(let
|
||||
((indices (filter (fn (i) (not (= (nth ravel i) 0))) (range 0 (len ravel)))))
|
||||
(apl-vector (map (fn (i) (+ i io)) indices))))))
|
||||
|
||||
(define
|
||||
apl-interval-index
|
||||
(fn
|
||||
(breaks vals)
|
||||
(let
|
||||
((b-ravel (get breaks :ravel))
|
||||
(v-ravel
|
||||
(if (scalar? vals) (list (disclose vals)) (get vals :ravel))))
|
||||
(let
|
||||
((result (map (fn (y) (len (filter (fn (b) (<= b y)) b-ravel))) v-ravel)))
|
||||
(if
|
||||
(scalar? vals)
|
||||
(apl-scalar (first result))
|
||||
(make-array (get vals :shape) result))))))
|
||||
|
||||
(define
|
||||
apl-unique
|
||||
(fn
|
||||
(arr)
|
||||
(let
|
||||
((ravel (if (scalar? arr) (list (disclose arr)) (get arr :ravel))))
|
||||
(let
|
||||
((dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) ravel)))
|
||||
(apl-vector dedup)))))
|
||||
|
||||
(define
|
||||
apl-union
|
||||
(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
|
||||
((a-dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) a-ravel)))
|
||||
(let
|
||||
((b-extra (filter (fn (x) (not (index-of a-dedup x))) b-ravel)))
|
||||
(let
|
||||
((b-extra-dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) b-extra)))
|
||||
(apl-vector (append a-dedup b-extra-dedup))))))))
|
||||
|
||||
(define
|
||||
apl-intersect
|
||||
(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))))
|
||||
(apl-vector (filter (fn (x) (index-of b-ravel x)) a-ravel)))))
|
||||
|
||||
(define
|
||||
apl-decode
|
||||
(fn
|
||||
(base digits)
|
||||
(let
|
||||
((d-ravel (if (scalar? digits) (list (disclose digits)) (get digits :ravel))))
|
||||
(let
|
||||
((d-len (len d-ravel)))
|
||||
(let
|
||||
((b-ravel (if (scalar? base) (let ((b (disclose base))) (map (fn (i) b) (range 0 d-len))) (get base :ravel))))
|
||||
(let
|
||||
((result (reduce (fn (acc i) (if (= i 0) (nth d-ravel 0) (+ (* acc (nth b-ravel i)) (nth d-ravel i)))) 0 (range 0 d-len))))
|
||||
(apl-scalar result)))))))
|
||||
|
||||
(define
|
||||
apl-encode
|
||||
(fn
|
||||
(base val)
|
||||
(let
|
||||
((b-ravel (if (scalar? base) (list (disclose base)) (get base :ravel)))
|
||||
(n (if (scalar? val) (disclose val) (first (get val :ravel)))))
|
||||
(let
|
||||
((b-len (len b-ravel)))
|
||||
(let
|
||||
((result (reduce (fn (acc-and-n i) (let ((acc (first acc-and-n)) (rem (nth acc-and-n 1))) (let ((b (nth b-ravel (- (- b-len 1) i)))) (if (= b 0) (list (cons rem acc) 0) (list (cons (modulo rem b) acc) (floor (/ rem b))))))) (list (list) n) (range 0 b-len))))
|
||||
(apl-vector (first result)))))))
|
||||
|
||||
(define
|
||||
apl-partition
|
||||
(fn
|
||||
(mask val)
|
||||
(let
|
||||
((m-ravel (if (scalar? mask) (list (disclose mask)) (get mask :ravel)))
|
||||
(v-ravel
|
||||
(if (scalar? val) (list (disclose val)) (get val :ravel))))
|
||||
(let
|
||||
((n (len m-ravel)))
|
||||
(let
|
||||
((built (reduce (fn (acc-and-prev i) (let ((acc (first acc-and-prev)) (prev (nth acc-and-prev 1))) (let ((mi (nth m-ravel i)) (vi (nth v-ravel i))) (cond ((= mi 0) (list acc 0)) ((> mi prev) (list (append acc (list (list vi))) mi)) (else (let ((idx (- (len acc) 1))) (list (append (slice acc 0 idx) (list (append (nth acc idx) (list vi)))) mi))))))) (list (list) 0) (range 0 n))))
|
||||
(apl-vector (map (fn (part) (apl-vector part)) (first built))))))))
|
||||
|
||||
(define
|
||||
apl-primes
|
||||
(fn
|
||||
@@ -1074,11 +1194,9 @@
|
||||
(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
|
||||
((rr (reduce (fn (a b) (let ((wa (if (= (type-of a) "dict") a (apl-scalar a))) (wb (if (= (type-of b) "dict") b (apl-scalar b)))) (let ((r (f wa wb))) (if (scalar? r) (disclose r) r)))) (first ravel) (rest ravel))))
|
||||
(if (= (type-of rr) "dict") rr (apl-scalar rr)))))
|
||||
(let
|
||||
((last-dim (last shape))
|
||||
(pre-shape (take shape (- (len shape) 1)))
|
||||
@@ -1100,7 +1218,13 @@
|
||||
(reduce
|
||||
(fn
|
||||
(a b)
|
||||
(disclose (f (apl-scalar a) (apl-scalar b))))
|
||||
(let
|
||||
((wa (if (= (type-of a) "dict") a (apl-scalar a)))
|
||||
(wb
|
||||
(if (= (type-of b) "dict") b (apl-scalar b))))
|
||||
(let
|
||||
((r (f wa wb)))
|
||||
(if (scalar? r) (disclose r) r))))
|
||||
(first elems)
|
||||
(rest elems)))))
|
||||
(range 0 pre-size)))))))))
|
||||
@@ -1241,13 +1365,29 @@
|
||||
(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))))
|
||||
(let
|
||||
((a-eff (let ((d (disclose a))) (if (= (type-of d) "dict") d a))))
|
||||
(make-array
|
||||
(get b :shape)
|
||||
(map
|
||||
(fn
|
||||
(x)
|
||||
(let
|
||||
((r (f a-eff (apl-scalar x))))
|
||||
(if (scalar? r) (disclose r) r)))
|
||||
(get b :ravel)))))
|
||||
((scalar? b)
|
||||
(make-array
|
||||
(get a :shape)
|
||||
(map (fn (x) (disclose (f (apl-scalar x) b))) (get a :ravel))))
|
||||
(let
|
||||
((b-eff (let ((d (disclose b))) (if (= (type-of d) "dict") d b))))
|
||||
(make-array
|
||||
(get a :shape)
|
||||
(map
|
||||
(fn
|
||||
(x)
|
||||
(let
|
||||
((r (f (apl-scalar x) b-eff)))
|
||||
(if (scalar? r) (disclose r) r)))
|
||||
(get a :ravel)))))
|
||||
(else
|
||||
(if
|
||||
(equal? (get a :shape) (get b :shape))
|
||||
@@ -1268,16 +1408,22 @@
|
||||
(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))))))
|
||||
(let
|
||||
((wrap (fn (x) (if (= (type-of x) "dict") x (apl-scalar x)))))
|
||||
(make-array
|
||||
(append a-shape b-shape)
|
||||
(flatten
|
||||
(map
|
||||
(fn
|
||||
(x)
|
||||
(map
|
||||
(fn
|
||||
(y)
|
||||
(let
|
||||
((r (f (wrap x) (wrap y))))
|
||||
(if (scalar? r) (disclose r) r)))
|
||||
b-ravel))
|
||||
a-ravel)))))))
|
||||
|
||||
(define
|
||||
apl-inner
|
||||
@@ -1301,25 +1447,12 @@
|
||||
((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)))))))))))
|
||||
(let
|
||||
((result (make-array new-shape (flatten (map (fn (i) (map (fn (j) (let ((pairs (map (fn (k) (let ((a-elem (nth a-ravel (+ (* i inner-dim) k))) (b-elem (nth b-ravel (+ (* k b-post-size) j)))) (let ((a-cell (if (= (type-of a-elem) "dict") (nth (get a-elem :ravel) j) a-elem)) (b-cell (if (= (type-of b-elem) "dict") (nth (get b-elem :ravel) 0) b-elem))) (disclose (g (apl-scalar a-cell) (apl-scalar b-cell)))))) (range 0 inner-dim)))) (reduce (fn (x y) (let ((wx (if (= (type-of x) "dict") x (apl-scalar x))) (wy (if (= (type-of y) "dict") y (apl-scalar y)))) (let ((r (f wx wy))) (if (scalar? r) (disclose r) r)))) (first pairs) (rest pairs)))) (range 0 b-post-size))) (range 0 a-pre-size))))))
|
||||
(if
|
||||
(some (fn (x) (= (type-of x) "dict")) a-ravel)
|
||||
(enclose result)
|
||||
result)))))))))
|
||||
|
||||
(define apl-commute (fn (f x) (f x x)))
|
||||
|
||||
|
||||
@@ -455,3 +455,233 @@
|
||||
(list 1 2 3))
|
||||
|
||||
(apl-test "⍕ 42 → \"42\" (alias for ⎕FMT)" (apl-run "⍕ 42") "42")
|
||||
|
||||
(begin
|
||||
(apl-test
|
||||
"⍸ where: indices of truthy cells"
|
||||
(mkrv (apl-run "⍸ 0 1 0 1 1"))
|
||||
(list 2 4 5))
|
||||
(apl-test
|
||||
"⍸ where: leading truthy"
|
||||
(mkrv (apl-run "⍸ 1 0 0 1 1"))
|
||||
(list 1 4 5))
|
||||
(apl-test
|
||||
"⍸ where: all-zero → empty"
|
||||
(mkrv (apl-run "⍸ 0 0 0"))
|
||||
(list))
|
||||
(apl-test
|
||||
"⍸ where: all-truthy"
|
||||
(mkrv (apl-run "⍸ 1 1 1"))
|
||||
(list 1 2 3))
|
||||
(apl-test
|
||||
"⍸ where: ⎕IO=1 (1-based)"
|
||||
(mkrv (apl-run "⍸ (⍳5)=3"))
|
||||
(list 3))
|
||||
(apl-test
|
||||
"⍸ interval-index: 2 4 6 ⍸ 5 → 2"
|
||||
(mkrv (apl-run "2 4 6 ⍸ 5"))
|
||||
(list 2))
|
||||
(apl-test
|
||||
"⍸ interval-index: 2 4 6 ⍸ 1 3 5 6 7 → 0 1 2 3 3"
|
||||
(mkrv (apl-run "2 4 6 ⍸ 1 3 5 6 7"))
|
||||
(list 0 1 2 3 3))
|
||||
(apl-test
|
||||
"⍸ interval-index: ⍳5 ⍸ 3 → 3"
|
||||
(mkrv (apl-run "(⍳5) ⍸ 3"))
|
||||
(list 3))
|
||||
(apl-test
|
||||
"⍸ interval-index: y below all → 0"
|
||||
(mkrv (apl-run "10 20 30 ⍸ 5"))
|
||||
(list 0))
|
||||
(apl-test
|
||||
"⍸ interval-index: y above all → len breaks"
|
||||
(mkrv (apl-run "10 20 30 ⍸ 100"))
|
||||
(list 3)))
|
||||
|
||||
(begin
|
||||
(apl-test
|
||||
"∪ unique: dedup keeps first-occurrence order"
|
||||
(mkrv (apl-run "∪ 1 2 1 3 2 1 4"))
|
||||
(list 1 2 3 4))
|
||||
(apl-test
|
||||
"∪ unique: already-unique unchanged"
|
||||
(mkrv (apl-run "∪ 5 4 3 2 1"))
|
||||
(list 5 4 3 2 1))
|
||||
(apl-test "∪ unique: scalar" (mkrv (apl-run "∪ 7")) (list 7))
|
||||
(apl-test
|
||||
"∪ unique: string mississippi → misp"
|
||||
(mkrv (apl-run "∪ 'mississippi'"))
|
||||
(list "m" "i" "s" "p"))
|
||||
(apl-test
|
||||
"∪ union: 1 2 3 ∪ 3 4 5 → 1 2 3 4 5"
|
||||
(mkrv (apl-run "1 2 3 ∪ 3 4 5"))
|
||||
(list 1 2 3 4 5))
|
||||
(apl-test
|
||||
"∪ union: dedups left side too"
|
||||
(mkrv (apl-run "1 2 1 ∪ 1 3 2"))
|
||||
(list 1 2 3))
|
||||
(apl-test
|
||||
"∪ union: disjoint → catenated"
|
||||
(mkrv (apl-run "1 2 ∪ 3 4"))
|
||||
(list 1 2 3 4))
|
||||
(apl-test
|
||||
"∩ intersection: 1 2 3 4 ∩ 2 4 6 → 2 4"
|
||||
(mkrv (apl-run "1 2 3 4 ∩ 2 4 6"))
|
||||
(list 2 4))
|
||||
(apl-test
|
||||
"∩ intersection: disjoint → empty"
|
||||
(mkrv (apl-run "1 2 3 ∩ 4 5 6"))
|
||||
(list))
|
||||
(apl-test
|
||||
"∩ intersection: preserves left order"
|
||||
(mkrv (apl-run "(⍳5) ∩ 5 3 1"))
|
||||
(list 1 3 5))
|
||||
(apl-test
|
||||
"∩ intersection: identical"
|
||||
(mkrv (apl-run "1 2 3 ∩ 1 2 3"))
|
||||
(list 1 2 3))
|
||||
(apl-test
|
||||
"∪/∩ identity: A ∪ A = ∪A"
|
||||
(mkrv (apl-run "1 2 1 ∪ 1 2 1"))
|
||||
(list 1 2)))
|
||||
|
||||
(begin
|
||||
(apl-test
|
||||
"⊥ decode: 2 2 2 ⊥ 1 0 1 → 5"
|
||||
(mkrv (apl-run "2 2 2 ⊥ 1 0 1"))
|
||||
(list 5))
|
||||
(apl-test
|
||||
"⊥ decode: 10 10 10 ⊥ 1 2 3 → 123"
|
||||
(mkrv (apl-run "10 10 10 ⊥ 1 2 3"))
|
||||
(list 123))
|
||||
(apl-test
|
||||
"⊥ decode: 24 60 60 ⊥ 2 3 4 → 7384 (mixed-radix HMS)"
|
||||
(mkrv (apl-run "24 60 60 ⊥ 2 3 4"))
|
||||
(list 7384))
|
||||
(apl-test
|
||||
"⊥ decode: scalar base 2 ⊥ 1 0 1 0 → 10"
|
||||
(mkrv (apl-run "2 ⊥ 1 0 1 0"))
|
||||
(list 10))
|
||||
(apl-test
|
||||
"⊥ decode: 16 16 ⊥ 15 15 → 255"
|
||||
(mkrv (apl-run "16 16 ⊥ 15 15"))
|
||||
(list 255))
|
||||
(apl-test
|
||||
"⊤ encode: 2 2 2 ⊤ 5 → 1 0 1"
|
||||
(mkrv (apl-run "2 2 2 ⊤ 5"))
|
||||
(list 1 0 1))
|
||||
(apl-test
|
||||
"⊤ encode: 24 60 60 ⊤ 7384 → 2 3 4 (HMS)"
|
||||
(mkrv (apl-run "24 60 60 ⊤ 7384"))
|
||||
(list 2 3 4))
|
||||
(apl-test
|
||||
"⊤ encode: 2 2 2 2 ⊤ 13 → 1 1 0 1"
|
||||
(mkrv (apl-run "2 2 2 2 ⊤ 13"))
|
||||
(list 1 1 0 1))
|
||||
(apl-test
|
||||
"⊤ encode: 10 10 ⊤ 42 → 4 2"
|
||||
(mkrv (apl-run "10 10 ⊤ 42"))
|
||||
(list 4 2))
|
||||
(apl-test
|
||||
"⊤ encode: round-trip B⊥(B⊤N) = N"
|
||||
(mkrv (apl-run "24 60 60 ⊥ 24 60 60 ⊤ 7384"))
|
||||
(list 7384))
|
||||
(apl-test
|
||||
"⊥ decode: round-trip B⊤(B⊥V) = V"
|
||||
(mkrv (apl-run "2 2 2 ⊤ 2 2 2 ⊥ 1 0 1"))
|
||||
(list 1 0 1)))
|
||||
|
||||
(begin
|
||||
(define
|
||||
mk-parts
|
||||
(fn (s) (map (fn (p) (get p :ravel)) (get (apl-run s) :ravel))))
|
||||
(apl-test
|
||||
"⊆ partition: 1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')"
|
||||
(mk-parts "1 1 0 1 1 ⊆ 'abcde'")
|
||||
(list (list "a" "b") (list "d" "e")))
|
||||
(apl-test
|
||||
"⊆ partition: 1 0 0 1 1 ⊆ ⍳5 → ((1) (4 5))"
|
||||
(mk-parts "1 0 0 1 1 ⊆ ⍳5")
|
||||
(list (list 1) (list 4 5)))
|
||||
(apl-test
|
||||
"⊆ partition: all-zero mask → empty"
|
||||
(len (get (apl-run "0 0 0 ⊆ 1 2 3") :ravel))
|
||||
0)
|
||||
(apl-test
|
||||
"⊆ partition: all-one mask → single partition"
|
||||
(mk-parts "1 1 1 ⊆ 7 8 9")
|
||||
(list (list 7 8 9)))
|
||||
(apl-test
|
||||
"⊆ partition: strict increase 1 2 starts new"
|
||||
(mk-parts "1 2 ⊆ 10 20")
|
||||
(list (list 10) (list 20)))
|
||||
(apl-test
|
||||
"⊆ partition: same level continues 2 2 → one partition"
|
||||
(mk-parts "2 2 ⊆ 10 20")
|
||||
(list (list 10 20)))
|
||||
(apl-test
|
||||
"⊆ partition: 0 separates"
|
||||
(mk-parts "1 1 0 0 1 ⊆ 1 2 3 4 5")
|
||||
(list (list 1 2) (list 5)))
|
||||
(apl-test
|
||||
"⊆ partition: outer length matches partition count"
|
||||
(len (get (apl-run "1 0 1 0 1 ⊆ ⍳5") :ravel))
|
||||
3))
|
||||
|
||||
(begin
|
||||
(apl-test
|
||||
"⍎ execute: ⍎ '1 + 2' → 3"
|
||||
(mkrv (apl-run "⍎ '1 + 2'"))
|
||||
(list 3))
|
||||
(apl-test
|
||||
"⍎ execute: ⍎ '+/⍳10' → 55"
|
||||
(mkrv (apl-run "⍎ '+/⍳10'"))
|
||||
(list 55))
|
||||
(apl-test
|
||||
"⍎ execute: ⍎ '⌈/ 1 3 9 5 7' → 9"
|
||||
(mkrv (apl-run "⍎ '⌈/ 1 3 9 5 7'"))
|
||||
(list 9))
|
||||
(apl-test
|
||||
"⍎ execute: ⍎ '⍳5' → 1..5"
|
||||
(mkrv (apl-run "⍎ '⍳5'"))
|
||||
(list 1 2 3 4 5))
|
||||
(apl-test
|
||||
"⍎ execute: ⍎ '×/⍳5' → 120"
|
||||
(mkrv (apl-run "⍎ '×/⍳5'"))
|
||||
(list 120))
|
||||
(apl-test
|
||||
"⍎ execute: round-trip ⍎ ⎕FMT 42 → 42"
|
||||
(mkrv (apl-run "⍎ ⎕FMT 42"))
|
||||
(list 42))
|
||||
(apl-test
|
||||
"⍎ execute: nested ⍎ ⍎"
|
||||
(mkrv (apl-run "⍎ '⍎ ''2 × 3'''"))
|
||||
(list 6))
|
||||
(apl-test
|
||||
"⍎ execute: with assignment side-effect"
|
||||
(mkrv (apl-run "⍎ 'q ← 99 ⋄ q + 1'"))
|
||||
(list 100)))
|
||||
|
||||
(begin
|
||||
(apl-test
|
||||
"het-inner: 1 ⍵ ∨.∧ X — result is enclosed (5 5)"
|
||||
(let
|
||||
((r (apl-run "B ← 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 ⋄ X ← 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂B ⋄ 1 B ∨.∧ X")))
|
||||
(list
|
||||
(len (get r :shape))
|
||||
(= (type-of (first (get r :ravel))) "dict")))
|
||||
(list 0 true))
|
||||
(apl-test
|
||||
"het-inner: ⊃ unwraps to (5 5) board"
|
||||
(mksh
|
||||
(apl-run
|
||||
"B ← 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 ⋄ X ← 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂B ⋄ ⊃ 1 B ∨.∧ X"))
|
||||
(list 5 5))
|
||||
(apl-test
|
||||
"het-inner: homogeneous inner product unaffected"
|
||||
(mkrv (apl-run "1 2 3 +.× 4 5 6"))
|
||||
(list 32))
|
||||
(apl-test
|
||||
"het-inner: matrix inner product unaffected"
|
||||
(mkrv (apl-run "(2 2 ⍴ 1 2 3 4) +.× 2 2 ⍴ 5 6 7 8"))
|
||||
(list 19 22 43 50)))
|
||||
|
||||
@@ -94,3 +94,96 @@
|
||||
"e2e: sqrt-via-newton 1 step from 1 → 2.5"
|
||||
(mkrv (apl-run "step ← {(⍵+⍺÷⍵)÷2} ⋄ 4 step 1"))
|
||||
(list 2.5))
|
||||
|
||||
(begin
|
||||
(apl-test
|
||||
"life.apl: blinker 5×5 → vertical blinker"
|
||||
(mkrv
|
||||
(apl-run
|
||||
"life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 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"))
|
||||
(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.apl: blinker oscillates (period 2)"
|
||||
(mkrv
|
||||
(apl-run
|
||||
"life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life life 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"))
|
||||
(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.apl: 2×2 block stable"
|
||||
(mkrv
|
||||
(apl-run
|
||||
"life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 4 4 ⍴ 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0"))
|
||||
(list 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0))
|
||||
(apl-test
|
||||
"life.apl: empty grid stays empty"
|
||||
(mkrv
|
||||
(apl-run
|
||||
"life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 5 5 ⍴ 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.apl: source-file as-written runs"
|
||||
(let
|
||||
((dfn (apl-run-file "lib/apl/tests/programs/life.apl"))
|
||||
(board
|
||||
(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)))
|
||||
|
||||
@@ -8,9 +8,9 @@
|
||||
⍝ ¯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
|
||||
⍝ 3 4 = … : leading-axis-extended boolean — count is 3 (born) or 4 (survive)
|
||||
⍝ 1 ⍵ ∨.∧ … : "alive next" iff (count=3) or (alive AND count=4)
|
||||
⍝ ⊃ … : disclose back to a 2D board
|
||||
⍝ ⊃ … : disclose the enclosed result back to a 2D board
|
||||
⍝
|
||||
⍝ Rules in plain language:
|
||||
⍝ - dead cell + 3 live neighbors → born
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -46,6 +46,9 @@
|
||||
((= g "⍕") apl-quad-fmt)
|
||||
((= g "⎕FMT") apl-quad-fmt)
|
||||
((= g "⎕←") apl-quad-print)
|
||||
((= g "⍸") apl-where)
|
||||
((= g "∪") apl-unique)
|
||||
((= g "⍎") apl-execute)
|
||||
(else (error "no monadic fn for glyph")))))
|
||||
|
||||
(define
|
||||
@@ -90,6 +93,12 @@
|
||||
((= g "⍉") apl-transpose-dyadic)
|
||||
((= g "⊢") (fn (a b) b))
|
||||
((= g "⊣") (fn (a b) a))
|
||||
((= g "⍸") apl-interval-index)
|
||||
((= g "∪") apl-union)
|
||||
((= g "∩") apl-intersect)
|
||||
((= g "⊥") apl-decode)
|
||||
((= g "⊤") apl-encode)
|
||||
((= g "⊆") apl-partition)
|
||||
(else (error "no dyadic fn for glyph")))))
|
||||
|
||||
(define
|
||||
@@ -124,7 +133,14 @@
|
||||
((vals (map (fn (n) (apl-eval-ast n env)) items)))
|
||||
(make-array
|
||||
(list (len vals))
|
||||
(map (fn (v) (first (get v :ravel))) vals)))))
|
||||
(map
|
||||
(fn
|
||||
(v)
|
||||
(if
|
||||
(= (len (get v :shape)) 0)
|
||||
(first (get v :ravel))
|
||||
v))
|
||||
vals)))))
|
||||
((= tag :name)
|
||||
(let
|
||||
((nm (nth node 1)))
|
||||
@@ -566,3 +582,11 @@
|
||||
(define apl-run (fn (src) (apl-eval-ast (parse-apl src) {})))
|
||||
|
||||
(define apl-run-file (fn (path) (apl-run (file-read path))))
|
||||
|
||||
(define
|
||||
apl-execute
|
||||
(fn
|
||||
(arr)
|
||||
(let
|
||||
((src (cond ((string? arr) arr) ((scalar? arr) (disclose arr)) (else (reduce str "" (get arr :ravel))))))
|
||||
(apl-run src))))
|
||||
|
||||
@@ -227,6 +227,71 @@ Today they are documentation; we paraphrase the algorithms in
|
||||
in the runtime — parser sees them as functions but eval errors;
|
||||
next-phase work.)_
|
||||
|
||||
### Phase 10 — fill runtime gaps + life/quicksort source files run
|
||||
|
||||
Phase 9 left seven glyphs that the parser recognises but the runtime
|
||||
cannot evaluate, and two source files (`life.apl`, `quicksort.apl`) that
|
||||
still need work to run as-written. Phase 10 closes both.
|
||||
|
||||
- [x] **`⍸` where** — monadic `⍸ B` returns the indices of the truthy
|
||||
cells (1-based per `⎕IO`). Dyadic `X ⍸ Y` is interval index (find
|
||||
the largest `i` such that `X[i] ≤ Y`). Add `apl-where` + dyadic
|
||||
`apl-interval-index`; wire both into `apl-monadic-fn` / `apl-dyadic-fn`.
|
||||
Tests: `⍸ 0 1 0 1 1 → 2 4 5`, `⍸ ⍳5 = ¯1+⍳5 → empty`,
|
||||
`2 4 6 ⍸ 5 → 2`.
|
||||
- [x] **`∪` unique / `∩` intersection** — monadic `∪ V` returns V with
|
||||
duplicates removed (first-occurrence order); dyadic `A ∪ B` is
|
||||
union; `A ∩ B` is intersection (members of A that are also in B).
|
||||
Add `apl-unique`, `apl-union`, `apl-intersect`. Tests cover empty,
|
||||
single, repeats, mixed numerics.
|
||||
- [x] **`⊥` decode / `⊤` encode** — `B ⊥ V` evaluates digits `V` in
|
||||
base(s) `B` (Horner-style); `B ⊤ N` is the inverse, returning the
|
||||
digits of `N` in base(s) `B`. Both broadcast `B` as scalar or
|
||||
conformable vector. Add `apl-decode` and `apl-encode`. Tests:
|
||||
`2 ⊥ 1 0 1 → 5`, `10 ⊥ 1 2 3 → 123`, `2 2 2 ⊤ 5 → 1 0 1`,
|
||||
`24 60 60 ⊤ 7384 → 2 3 4`.
|
||||
- [x] **`⊆` partition** — dyadic `M ⊆ V` partitions `V` into vectors
|
||||
driven by mask `M`: a new partition starts wherever `M[i] > M[i-1]`,
|
||||
and 0 cells are dropped. Returns a vector of (boxed) partitions.
|
||||
Add `apl-partition`. Tests: `1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')`,
|
||||
`1 0 0 1 1 ⊆ ⍳5 → ((⊂ 1) (⊂ 4 5))`.
|
||||
- [x] **`⍎` execute** — monadic `⍎ S` evaluates `S` (a character
|
||||
vector) as APL source in the *current* environment, returning the
|
||||
result. Implement as `(fn (s) (apl-run s))` — env is the global
|
||||
one; nested execute is fine. Wire into `apl-monadic-fn`. Tests:
|
||||
`⍎ '1 + 2' → 3`, `⍎ '+/⍳10' → 55`.
|
||||
- [x] **`life.apl` runs as-written** — Conway's life one-liner uses
|
||||
`⊃+/⌽¨ -1 0 1 ∘.,¯1 0 1` (each + outer-comma + disclose + reduce
|
||||
over a list of rotations) and the rule expression. Probe what
|
||||
fails when `apl-run-file "lib/apl/tests/programs/life.apl"` is
|
||||
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`.
|
||||
- [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.
|
||||
Set the RNG seed for determinism and assert the sort against
|
||||
`apl-grade-up`.
|
||||
|
||||
### Phase 11 — heterogeneous-strand inner product (restore life.apl ⊃)
|
||||
|
||||
Phase 10 step 6 closed life.apl by dropping the leading `⊃` from
|
||||
Hui's formulation, because our inner product over a mixed
|
||||
scalar/matrix strand (`1 ⍵`) produced a clean (5 5) board which
|
||||
`⊃` then collapsed to its first row. Hui's original needs `⊃` to
|
||||
*unwrap* an enclosed result of the inner product. Phase 11 closes
|
||||
that semantic gap so life.apl can be restored to its true
|
||||
as-written form.
|
||||
|
||||
- [x] **Inner product encloses on heterogeneous left arg** —
|
||||
detect when `A` in `A f.g B` has a ravel containing a dict
|
||||
(boxed array), and in that case wrap the inner-product result
|
||||
in `enclose` (rank-0 wrapping the matrix). Then `⊃` on the
|
||||
result unwraps to the underlying board. Restore life.apl to
|
||||
the original `{⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵}`
|
||||
and update its tests + comment block.
|
||||
|
||||
## SX primitive baseline
|
||||
|
||||
Use vectors for arrays; numeric tower + rationals for numbers; ADTs for tagged data;
|
||||
@@ -241,6 +306,15 @@ data; format for string templating.
|
||||
|
||||
_Newest first._
|
||||
|
||||
- 2026-05-11: Phase 11 — heterogeneous-strand inner product. apl-inner now encloses its result when A's ravel contains a dict (boxed array) — Hui's `1 ⍵ ∨.∧ X` produces a rank-0 wrapping the (5 5) board, which ⊃ then unwraps to the bare matrix. Restored life.apl to its true as-written form `{⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵}` and updated all 5 e2e tests + comment block. Homogeneous inner product unaffected (+.× over numbers/matrices still produces bare arrays). +4 pipeline tests for the heterogeneous case + ⊃ unwrap path; **Phase 11 complete**; full suite 589/589
|
||||
- 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
|
||||
- 2026-05-08: Phase 10 step 3 — `⊥` decode / `⊤` encode. apl-decode (Horner reduce over indices, base[i]>0; scalar base broadcasts to digit length); apl-encode (right-to-left modulo+floor-div via reduce). Mixed-radix HMS works: `24 60 60 ⊥ 2 3 4 → 7384`, `24 60 60 ⊤ 7384 → 2 3 4`. Round-trips exact. Wired ⊥ ⊤ into apl-dyadic-fn. +11 tests; pipeline 132/132
|
||||
- 2026-05-08: Phase 10 step 2 — `∪` unique / `∩` intersection. apl-unique (monadic, dedup keeping first-occurrence order via reduce+index-of), apl-union (dyadic, dedup'd A then B-elements-not-in-A), apl-intersect (dyadic, A elements that are also in B, preserves left order). Wired ∪ into both apl-monadic-fn and apl-dyadic-fn cond chains; ∩ into apl-dyadic-fn. +12 tests; pipeline 121/121
|
||||
- 2026-05-08: Phase 10 step 1 — `⍸` where. apl-where (monadic, indices of truthy cells, ⎕IO-respecting) + apl-interval-index (dyadic, count of breaks ≤ y; broadcasts over Y vector or scalar). Wired into apl-monadic-fn / apl-dyadic-fn (cond clauses inserted as proper siblings via sx_insert_child after sx_insert_near silently wrapped multi-form sources in `(begin …)`). +10 tests; pipeline 109/109
|
||||
- 2026-05-08: Phase 10 added — fill runtime gaps (⍸ ∪ ∩ ⊥ ⊤ ⊆ ⍎) + life.apl and quicksort.apl as-written
|
||||
- 2026-05-07: Phase 9 step 6 — glyph audit. Wired ⍉ → apl-transpose/apl-transpose-dyadic, ⊢ → monadic+dyadic identity-right, ⊣ → identity-left, ⍕ → apl-quad-fmt. +6 tests; **Phase 9 complete, all unchecked items ticked**; pipeline 99/99
|
||||
- 2026-05-07: Phase 9 step 5 — primes.apl runs as-written end-to-end. Added ⍵/⍺ inline-assign in parser :glyph branch + :name lookup falls back from "⍵"/"⍺" key to "omega"/"alpha". `apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 50"` → 15 primes. +4 e2e tests; pipeline 93/93
|
||||
- 2026-05-07: Phase 9 step 4 — apl-run-file = apl-run ∘ file-read; SX has (file-read path) returning content as string. primes/life/quicksort .apl files now load and parse end-to-end (return :dfn AST). +4 tests
|
||||
@@ -298,6 +372,10 @@ _Newest first._
|
||||
|
||||
## Blockers
|
||||
|
||||
- 2026-05-08: **sx-tree MCP server disconnected at start of Phase 10.**
|
||||
Path-based sx-tree tools error with `Type_error("Expected string, got null")`
|
||||
and the server then dropped entirely (45 tools unavailable). Loop paused
|
||||
at Phase 10 step 1 (`⍸ where`); resume once `/mcp` reconnects sx-tree.
|
||||
- 2026-05-07: **sx-tree MCP server disconnected mid-Phase-9.** `lib/apl/**.sx`
|
||||
edits require `sx-tree` per CLAUDE.md — Edit/Read on `.sx` is hook-blocked.
|
||||
Loop paused at Phase 9 step 2 (inline assignment); resume once MCP restored.
|
||||
|
||||
Reference in New Issue
Block a user