Compare commits
32 Commits
d473f39b04
...
loops/apl
| Author | SHA1 | Date | |
|---|---|---|---|
| 40dff449ef | |||
| eeb530eb85 | |||
| 36e1519613 | |||
| d1a491e530 | |||
| 015ecb8bc8 | |||
| a074ea9e98 | |||
| ef53232314 | |||
| 8cdebbe305 | |||
| 58c6ec27f3 | |||
| fa43aa6711 | |||
| 69078a59a9 | |||
| f5d3b1df19 | |||
| bf782d9c49 | |||
| bcdd137d6f | |||
| 0b3610a63a | |||
| 2b8c1a506c | |||
| 203f81004d | |||
| 04b0e61a33 | |||
| 80dac0051d | |||
| b661318a45 | |||
| a677585639 | |||
| c04f38a1ba | |||
| b13819c50c | |||
| d9cf00f287 | |||
| 0c0ed0605a | |||
| 0dd2fa3058 | |||
| 67ff2a3ae8 | |||
| aaabe370d6 | |||
| 637ba4102f | |||
| 7cf8b74d1d | |||
| dec1cf3fbe | |||
| 52df09655d |
@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
SUITES=(structural operators dfn tradfn valence programs system idioms)
|
||||
SUITES=(structural operators dfn tradfn valence programs system idioms eval-ops pipeline)
|
||||
|
||||
OUT_JSON="lib/apl/scoreboard.json"
|
||||
OUT_MD="lib/apl/scoreboard.md"
|
||||
@@ -26,7 +26,10 @@ run_suite() {
|
||||
cat > "$TMP" << EPOCHS
|
||||
(epoch 1)
|
||||
(load "spec/stdlib.sx")
|
||||
(load "lib/r7rs.sx")
|
||||
(load "lib/apl/runtime.sx")
|
||||
(load "lib/apl/tokenizer.sx")
|
||||
(load "lib/apl/parser.sx")
|
||||
(load "lib/apl/transpile.sx")
|
||||
(epoch 2)
|
||||
(eval "(define apl-test-pass 0)")
|
||||
@@ -39,7 +42,7 @@ run_suite() {
|
||||
EPOCHS
|
||||
|
||||
local OUTPUT
|
||||
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMP" 2>/dev/null)
|
||||
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
|
||||
rm -f "$TMP"
|
||||
|
||||
local LINE
|
||||
|
||||
@@ -25,99 +25,151 @@
|
||||
; Glyph classification sets
|
||||
; ============================================================
|
||||
|
||||
(define apl-parse-op-glyphs
|
||||
(list "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))
|
||||
(define
|
||||
apl-parse-op-glyphs
|
||||
(list "/" "⌿" "\\" "⍀" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))
|
||||
|
||||
(define apl-parse-fn-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-quad-fn-names (list "⎕FMT" "⎕←"))
|
||||
|
||||
(define apl-parse-fn-glyph?
|
||||
(fn (v)
|
||||
(some (fn (g) (= g v)) apl-parse-fn-glyphs)))
|
||||
(define apl-known-fn-names (list))
|
||||
|
||||
; ============================================================
|
||||
; Token accessors
|
||||
; ============================================================
|
||||
|
||||
(define tok-type
|
||||
(fn (tok)
|
||||
(get tok :type)))
|
||||
(define
|
||||
apl-collect-fn-bindings
|
||||
(fn
|
||||
(stmt-groups)
|
||||
(set! apl-known-fn-names (list))
|
||||
(for-each
|
||||
(fn
|
||||
(toks)
|
||||
(when
|
||||
(and
|
||||
(>= (len toks) 3)
|
||||
(= (tok-type (nth toks 0)) :name)
|
||||
(= (tok-type (nth toks 1)) :assign)
|
||||
(= (tok-type (nth toks 2)) :lbrace))
|
||||
(set!
|
||||
apl-known-fn-names
|
||||
(cons (tok-val (nth toks 0)) apl-known-fn-names))))
|
||||
stmt-groups)))
|
||||
|
||||
(define tok-val
|
||||
(fn (tok)
|
||||
(get tok :value)))
|
||||
(define
|
||||
apl-parse-op-glyph?
|
||||
(fn (v) (some (fn (g) (= g v)) apl-parse-op-glyphs)))
|
||||
|
||||
(define is-op-tok?
|
||||
(fn (tok)
|
||||
(and (= (tok-type tok) :glyph)
|
||||
(apl-parse-op-glyph? (tok-val tok)))))
|
||||
(define
|
||||
apl-parse-fn-glyph?
|
||||
(fn (v) (some (fn (g) (= g v)) apl-parse-fn-glyphs)))
|
||||
|
||||
(define is-fn-tok?
|
||||
(fn (tok)
|
||||
(and (= (tok-type tok) :glyph)
|
||||
(apl-parse-fn-glyph? (tok-val tok)))))
|
||||
(define tok-type (fn (tok) (get tok :type)))
|
||||
|
||||
; ============================================================
|
||||
; 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 tok-val (fn (tok) (get tok :value)))
|
||||
|
||||
(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})))))
|
||||
(define
|
||||
is-op-tok?
|
||||
(fn
|
||||
(tok)
|
||||
(and (= (tok-type tok) :glyph) (apl-parse-op-glyph? (tok-val tok)))))
|
||||
|
||||
; ============================================================
|
||||
; 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)))))
|
||||
(define
|
||||
is-fn-tok?
|
||||
(fn
|
||||
(tok)
|
||||
(or
|
||||
(and (= (tok-type tok) :glyph) (apl-parse-fn-glyph? (tok-val tok)))
|
||||
(and
|
||||
(= (tok-type tok) :name)
|
||||
(or
|
||||
(some (fn (q) (= q (tok-val tok))) apl-quad-fn-names)
|
||||
(some (fn (q) (= q (tok-val tok))) apl-known-fn-names))))))
|
||||
|
||||
; ============================================================
|
||||
; 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 collect-ops (fn (tokens i) (collect-ops-loop tokens i (list))))
|
||||
|
||||
(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)))))))
|
||||
(define
|
||||
collect-ops-loop
|
||||
(fn
|
||||
(tokens i acc)
|
||||
(if
|
||||
(>= i (len tokens))
|
||||
{:end i :ops acc}
|
||||
(let
|
||||
((tok (nth tokens i)))
|
||||
(if
|
||||
(is-op-tok? tok)
|
||||
(collect-ops-loop tokens (+ i 1) (append acc (tok-val tok)))
|
||||
{:end i :ops acc})))))
|
||||
|
||||
; ============================================================
|
||||
; Segment collection: scan tokens left-to-right, building
|
||||
@@ -126,122 +178,20 @@
|
||||
; derived-fn nodes during this pass.
|
||||
; ============================================================
|
||||
|
||||
(define collect-segments
|
||||
(fn (tokens)
|
||||
(collect-segments-loop tokens 0 (list))))
|
||||
(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)))))
|
||||
|
||||
(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))))))))
|
||||
(define
|
||||
find-matching-close
|
||||
(fn
|
||||
(tokens start open-type close-type)
|
||||
(find-matching-close-loop tokens start open-type close-type 1)))
|
||||
|
||||
; ============================================================
|
||||
; Build tree from segment list
|
||||
@@ -258,57 +208,233 @@
|
||||
; ============================================================
|
||||
|
||||
; 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-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)))))))
|
||||
|
||||
(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))))))
|
||||
(define
|
||||
collect-segments
|
||||
(fn (tokens) (collect-segments-loop tokens 0 (list))))
|
||||
|
||||
; 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
|
||||
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
|
||||
((or (= tt :diamond) (= tt :newline) (= tt :semi))
|
||||
(collect-segments-loop tokens (+ i 1) acc))
|
||||
((= tt :num)
|
||||
(collect-segments-loop tokens (+ i 1) (append acc {:kind "val" :node (list :num tv)})))
|
||||
((= tt :str)
|
||||
(collect-segments-loop tokens (+ i 1) (append acc {:kind "val" :node (list :str tv)})))
|
||||
((= tt :name)
|
||||
(cond
|
||||
((and (< (+ i 1) (len tokens)) (= (tok-type (nth tokens (+ i 1))) :assign))
|
||||
(let
|
||||
((rhs-tokens (slice tokens (+ i 2) (len tokens))))
|
||||
(let
|
||||
((rhs-expr (parse-apl-expr rhs-tokens)))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
(len tokens)
|
||||
(append acc {:kind "val" :node (list :assign-expr tv rhs-expr)})))))
|
||||
((some (fn (q) (= q tv)) apl-quad-fn-names)
|
||||
(let
|
||||
((op-result (collect-ops tokens (+ i 1))))
|
||||
(let
|
||||
((ops (get op-result :ops))
|
||||
(ni (get op-result :end)))
|
||||
(let
|
||||
((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
ni
|
||||
(append acc {:kind "fn" :node fn-node}))))))
|
||||
((some (fn (q) (= q tv)) apl-known-fn-names)
|
||||
(let
|
||||
((op-result (collect-ops tokens (+ i 1))))
|
||||
(let
|
||||
((ops (get op-result :ops))
|
||||
(ni (get op-result :end)))
|
||||
(let
|
||||
((fn-node (build-derived-fn (list :fn-name tv) ops)))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
ni
|
||||
(append acc {:kind "fn" :node fn-node}))))))
|
||||
(else
|
||||
(let
|
||||
((br (maybe-bracket (list :name tv) tokens (+ i 1))))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
(nth br 1)
|
||||
(append acc {:kind "val" :node (nth br 0)}))))))
|
||||
((= tt :lparen)
|
||||
(let
|
||||
((end (find-matching-close tokens (+ i 1) :lparen :rparen)))
|
||||
(let
|
||||
((inner-tokens (slice tokens (+ i 1) end))
|
||||
(after (+ end 1)))
|
||||
(let
|
||||
((inner-segs (collect-segments inner-tokens)))
|
||||
(if
|
||||
(and
|
||||
(>= (len inner-segs) 2)
|
||||
(every? (fn (s) (= (get s :kind) "fn")) inner-segs))
|
||||
(let
|
||||
((train-node (cons :train (map (fn (s) (get s :node)) inner-segs))))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
after
|
||||
(append acc {:kind "fn" :node train-node})))
|
||||
(let
|
||||
((br (maybe-bracket (parse-apl-expr inner-tokens) tokens after)))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
(nth br 1)
|
||||
(append acc {:kind "val" :node (nth br 0)}))))))))
|
||||
((= 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)})))))
|
||||
((= tt :glyph)
|
||||
(cond
|
||||
((or (= tv "⍺") (= tv "⍵"))
|
||||
(if
|
||||
(and
|
||||
(< (+ i 1) (len tokens))
|
||||
(= (tok-type (nth tokens (+ i 1))) :assign))
|
||||
(let
|
||||
((rhs-tokens (slice tokens (+ i 2) (len tokens))))
|
||||
(let
|
||||
((rhs-expr (parse-apl-expr rhs-tokens)))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
(len tokens)
|
||||
(append acc {:kind "val" :node (list :assign-expr tv rhs-expr)}))))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
(+ i 1)
|
||||
(append acc {:kind "val" :node (list :name tv)}))))
|
||||
((= tv "∇")
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
(+ i 1)
|
||||
(append acc {:kind "fn" :node (list :fn-glyph "∇")})))
|
||||
((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)}))))))
|
||||
(collect-segments-loop tokens (+ i 1) acc)))
|
||||
((apl-parse-fn-glyph? tv)
|
||||
(let
|
||||
((op-result (collect-ops tokens (+ i 1))))
|
||||
(let
|
||||
((ops (get op-result :ops))
|
||||
(ni (get op-result :end)))
|
||||
(if
|
||||
(and
|
||||
(= (len ops) 1)
|
||||
(= (first ops) ".")
|
||||
(< ni n)
|
||||
(is-fn-tok? (nth tokens ni)))
|
||||
(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)}))))))
|
||||
(let
|
||||
((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
|
||||
(collect-segments-loop
|
||||
tokens
|
||||
ni
|
||||
(append acc {:kind "fn" :node fn-node})))))))
|
||||
((apl-parse-op-glyph? tv)
|
||||
(if
|
||||
(or (= tv "/") (= tv "⌿") (= tv "\\") (= 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))))))))
|
||||
|
||||
(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))))))))))
|
||||
(define find-first-fn (fn (segs) (find-first-fn-loop segs 0)))
|
||||
|
||||
|
||||
; ============================================================
|
||||
@@ -316,121 +442,270 @@
|
||||
; Only splits at depth 0 (ignores separators inside { } or ( ) )
|
||||
; ============================================================
|
||||
|
||||
(define split-statements
|
||||
(fn (tokens)
|
||||
(split-statements-loop tokens (list) (list) 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))))))
|
||||
|
||||
(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)))))))
|
||||
(define
|
||||
segs-to-array
|
||||
(fn
|
||||
(segs)
|
||||
(if
|
||||
(= (len segs) 1)
|
||||
(get (first segs) :node)
|
||||
(cons :vec (map (fn (s) (get s :node)) segs)))))
|
||||
|
||||
; ============================================================
|
||||
; 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
|
||||
build-tree
|
||||
(fn
|
||||
(segs)
|
||||
(cond
|
||||
((= (len segs) 0) nil)
|
||||
((= (len segs) 1) (get (first segs) :node))
|
||||
((every? (fn (s) (= (get s :kind) "val")) segs)
|
||||
(segs-to-array segs))
|
||||
(true
|
||||
(let
|
||||
((fn-idx (find-first-fn segs)))
|
||||
(cond
|
||||
((= fn-idx -1) (segs-to-array segs))
|
||||
((= fn-idx 0)
|
||||
(list
|
||||
:monad (get (first segs) :node)
|
||||
(build-tree (rest segs))))
|
||||
(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))))))))))
|
||||
|
||||
(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
|
||||
split-statements
|
||||
(fn (tokens) (split-statements-loop tokens (list) (list) 0)))
|
||||
|
||||
(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))))
|
||||
(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
|
||||
((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
|
||||
(find-top-level-colon-loop tokens (+ i 1) (+ depth 1)))
|
||||
(split-statements-loop
|
||||
rest-toks
|
||||
(append current-stmt tok)
|
||||
acc
|
||||
(+ 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)
|
||||
(split-statements-loop
|
||||
rest-toks
|
||||
(append current-stmt tok)
|
||||
acc
|
||||
(- depth 1)))
|
||||
((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)))
|
||||
(true
|
||||
(find-top-level-colon-loop tokens (+ i 1) depth)))))))
|
||||
(split-statements-loop
|
||||
rest-toks
|
||||
(append current-stmt tok)
|
||||
acc
|
||||
depth)))))))
|
||||
|
||||
(define
|
||||
parse-dfn
|
||||
(fn
|
||||
(tokens)
|
||||
(let
|
||||
((stmt-groups (split-statements tokens)))
|
||||
(let ((stmts (map parse-dfn-stmt stmt-groups))) (cons :dfn stmts)))))
|
||||
|
||||
; ============================================================
|
||||
; 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))))
|
||||
(define
|
||||
parse-dfn-stmt
|
||||
(fn
|
||||
(tokens)
|
||||
(let
|
||||
((colon-idx (find-top-level-colon tokens 0)))
|
||||
(if
|
||||
(>= colon-idx 0)
|
||||
(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)))
|
||||
(parse-stmt 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)))))
|
||||
(define
|
||||
find-top-level-colon
|
||||
(fn (tokens i) (find-top-level-colon-loop tokens i 0)))
|
||||
|
||||
; ============================================================
|
||||
; 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))))))))
|
||||
(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)))))))
|
||||
|
||||
(define
|
||||
parse-stmt
|
||||
(fn
|
||||
(tokens)
|
||||
(if
|
||||
(and
|
||||
(>= (len tokens) 2)
|
||||
(= (tok-type (nth tokens 0)) :name)
|
||||
(= (tok-type (nth tokens 1)) :assign))
|
||||
(list
|
||||
:assign (tok-val (nth tokens 0))
|
||||
(parse-apl-expr (slice tokens 2)))
|
||||
(parse-apl-expr tokens))))
|
||||
|
||||
(define
|
||||
parse-apl-expr
|
||||
(fn
|
||||
(tokens)
|
||||
(let
|
||||
((segs (collect-segments tokens)))
|
||||
(if (= (len segs) 0) nil (build-tree segs)))))
|
||||
|
||||
(define
|
||||
parse-apl
|
||||
(fn
|
||||
(src)
|
||||
(let
|
||||
((tokens (apl-tokenize src)))
|
||||
(let
|
||||
((stmt-groups (split-statements tokens)))
|
||||
(begin
|
||||
(apl-collect-fn-bindings stmt-groups)
|
||||
(if
|
||||
(= (len stmt-groups) 0)
|
||||
nil
|
||||
(if
|
||||
(= (len stmt-groups) 1)
|
||||
(parse-stmt (first stmt-groups))
|
||||
(cons :program (map parse-stmt stmt-groups)))))))))
|
||||
|
||||
(define
|
||||
split-bracket-loop
|
||||
(fn
|
||||
(tokens current acc depth)
|
||||
(if
|
||||
(= (len tokens) 0)
|
||||
(append acc (list current))
|
||||
(let
|
||||
((tok (first tokens)) (more (rest tokens)))
|
||||
(let
|
||||
((tt (tok-type tok)))
|
||||
(cond
|
||||
((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
|
||||
(split-bracket-loop
|
||||
more
|
||||
(append current (list tok))
|
||||
acc
|
||||
(+ depth 1)))
|
||||
((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
|
||||
(split-bracket-loop
|
||||
more
|
||||
(append current (list tok))
|
||||
acc
|
||||
(- depth 1)))
|
||||
((and (= tt :semi) (= depth 0))
|
||||
(split-bracket-loop
|
||||
more
|
||||
(list)
|
||||
(append acc (list current))
|
||||
depth))
|
||||
(else
|
||||
(split-bracket-loop more (append current (list tok)) acc depth))))))))
|
||||
|
||||
(define
|
||||
split-bracket-content
|
||||
(fn (tokens) (split-bracket-loop tokens (list) (list) 0)))
|
||||
|
||||
(define
|
||||
maybe-bracket
|
||||
(fn
|
||||
(val-node tokens after)
|
||||
(if
|
||||
(and
|
||||
(< after (len tokens))
|
||||
(= (tok-type (nth tokens after)) :lbracket))
|
||||
(let
|
||||
((end (find-matching-close tokens (+ after 1) :lbracket :rbracket)))
|
||||
(let
|
||||
((inner-tokens (slice tokens (+ after 1) end))
|
||||
(next-after (+ end 1)))
|
||||
(let
|
||||
((sections (split-bracket-content inner-tokens)))
|
||||
(if
|
||||
(= (len sections) 1)
|
||||
(let
|
||||
((idx-expr (parse-apl-expr inner-tokens)))
|
||||
(let
|
||||
((indexed (list :dyad (list :fn-glyph "⌷") idx-expr val-node)))
|
||||
(maybe-bracket indexed tokens next-after)))
|
||||
(let
|
||||
((axis-exprs (map (fn (toks) (if (= (len toks) 0) :all (parse-apl-expr toks))) sections)))
|
||||
(let
|
||||
((indexed (cons :bracket (cons val-node axis-exprs))))
|
||||
(maybe-bracket indexed tokens next-after)))))))
|
||||
(list val-node after))))
|
||||
|
||||
@@ -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
|
||||
@@ -808,6 +828,125 @@
|
||||
((picked (map (fn (i) (nth arr-ravel i)) kept)))
|
||||
(make-array (list (len picked)) picked))))))
|
||||
|
||||
(define
|
||||
apl-compress-first
|
||||
(fn
|
||||
(mask arr)
|
||||
(let
|
||||
((mask-ravel (get mask :ravel))
|
||||
(shape (get arr :shape))
|
||||
(ravel (get arr :ravel)))
|
||||
(if
|
||||
(< (len shape) 2)
|
||||
(apl-compress mask arr)
|
||||
(let
|
||||
((rows (first shape)) (cols (last shape)))
|
||||
(let
|
||||
((kept-rows (filter (fn (i) (not (= 0 (nth mask-ravel i)))) (range 0 rows))))
|
||||
(let
|
||||
((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
|
||||
@@ -883,7 +1022,7 @@
|
||||
(let
|
||||
((sub (apl-permutations (- n 1))))
|
||||
(reduce
|
||||
(fn (acc p) (append acc (apl-insert-everywhere n p)))
|
||||
(fn (acc p) (append (apl-insert-everywhere n p) acc))
|
||||
(list)
|
||||
sub)))))
|
||||
|
||||
@@ -971,6 +1110,74 @@
|
||||
|
||||
(define apl-quad-print (fn (arr) arr))
|
||||
|
||||
(define apl-throw (fn (code msg) (raise (list "apl-error" code msg))))
|
||||
|
||||
(define
|
||||
apl-trap-matches?
|
||||
(fn
|
||||
(codes e)
|
||||
(and
|
||||
(list? e)
|
||||
(>= (len e) 2)
|
||||
(= (first e) "apl-error")
|
||||
(or
|
||||
(some (fn (c) (= c 0)) codes)
|
||||
(some (fn (c) (= c (nth e 1))) codes)))))
|
||||
|
||||
(define apl-rng-state 12345)
|
||||
|
||||
(define apl-rng-seed! (fn (s) (set! apl-rng-state s)))
|
||||
|
||||
(define
|
||||
apl-rng-next!
|
||||
(fn
|
||||
()
|
||||
(begin
|
||||
(set!
|
||||
apl-rng-state
|
||||
(mod (+ (* apl-rng-state 1103515245) 12345) 2147483648))
|
||||
apl-rng-state)))
|
||||
|
||||
(define
|
||||
apl-roll
|
||||
(fn
|
||||
(arr)
|
||||
(let
|
||||
((n (if (scalar? arr) (first (get arr :ravel)) (first (get arr :ravel)))))
|
||||
(apl-scalar (+ apl-io (mod (apl-rng-next!) n))))))
|
||||
|
||||
(define
|
||||
apl-cartesian
|
||||
(fn
|
||||
(lists)
|
||||
(if
|
||||
(= (len lists) 0)
|
||||
(list (list))
|
||||
(let
|
||||
((rest-prods (apl-cartesian (rest lists))))
|
||||
(reduce
|
||||
(fn (acc x) (append acc (map (fn (p) (cons x p)) rest-prods)))
|
||||
(list)
|
||||
(first lists))))))
|
||||
|
||||
(define
|
||||
apl-bracket-multi
|
||||
(fn
|
||||
(axes arr)
|
||||
(let
|
||||
((shape (get arr :shape)) (ravel (get arr :ravel)))
|
||||
(let
|
||||
((rank (len shape)) (strides (apl-strides shape)))
|
||||
(let
|
||||
((axis-info (map (fn (i) (let ((a (nth axes i))) (cond ((= a nil) {:idxs (range 0 (nth shape i)) :scalar? false}) ((= (len (get a :shape)) 0) {:idxs (list (- (first (get a :ravel)) apl-io)) :scalar? true}) (else {:idxs (map (fn (x) (- x apl-io)) (get a :ravel)) :scalar? false})))) (range 0 rank))))
|
||||
(let
|
||||
((cells (apl-cartesian (map (fn (a) (get a :idxs)) axis-info))))
|
||||
(let
|
||||
((result-ravel (map (fn (cell) (let ((flat (reduce + 0 (map (fn (i) (* (nth cell i) (nth strides i))) (range 0 rank))))) (nth ravel flat))) cells)))
|
||||
(let
|
||||
((result-shape (filter (fn (x) (>= x 0)) (map (fn (i) (let ((a (nth axis-info i))) (if (get a :scalar?) -1 (len (get a :idxs))))) (range 0 rank)))))
|
||||
(make-array result-shape result-ravel)))))))))
|
||||
|
||||
(define
|
||||
apl-reduce
|
||||
(fn
|
||||
@@ -987,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)))
|
||||
@@ -1013,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)))))))))
|
||||
@@ -1154,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))
|
||||
@@ -1181,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
|
||||
@@ -1214,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)))
|
||||
|
||||
|
||||
@@ -3,13 +3,15 @@
|
||||
"structural": {"pass": 94, "fail": 0},
|
||||
"operators": {"pass": 117, "fail": 0},
|
||||
"dfn": {"pass": 24, "fail": 0},
|
||||
"tradfn": {"pass": 20, "fail": 0},
|
||||
"tradfn": {"pass": 25, "fail": 0},
|
||||
"valence": {"pass": 14, "fail": 0},
|
||||
"programs": {"pass": 46, "fail": 0},
|
||||
"programs": {"pass": 45, "fail": 0},
|
||||
"system": {"pass": 13, "fail": 0},
|
||||
"idioms": {"pass": 34, "fail": 0}
|
||||
"idioms": {"pass": 64, "fail": 0},
|
||||
"eval-ops": {"pass": 14, "fail": 0},
|
||||
"pipeline": {"pass": 40, "fail": 0}
|
||||
},
|
||||
"total_pass": 362,
|
||||
"total_pass": 450,
|
||||
"total_fail": 0,
|
||||
"total": 362
|
||||
"total": 450
|
||||
}
|
||||
|
||||
@@ -7,12 +7,14 @@ _Generated by `lib/apl/conformance.sh`_
|
||||
| structural | 94 | 0 | 94 |
|
||||
| operators | 117 | 0 | 117 |
|
||||
| dfn | 24 | 0 | 24 |
|
||||
| tradfn | 20 | 0 | 20 |
|
||||
| tradfn | 25 | 0 | 25 |
|
||||
| valence | 14 | 0 | 14 |
|
||||
| programs | 46 | 0 | 46 |
|
||||
| programs | 45 | 0 | 45 |
|
||||
| system | 13 | 0 | 13 |
|
||||
| idioms | 34 | 0 | 34 |
|
||||
| **Total** | **362** | **0** | **362** |
|
||||
| idioms | 64 | 0 | 64 |
|
||||
| eval-ops | 14 | 0 | 14 |
|
||||
| pipeline | 40 | 0 | 40 |
|
||||
| **Total** | **450** | **0** | **450** |
|
||||
|
||||
## Notes
|
||||
|
||||
|
||||
@@ -18,7 +18,10 @@ TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
|
||||
cat > "$TMPFILE" << 'EPOCHS'
|
||||
(epoch 1)
|
||||
(load "spec/stdlib.sx")
|
||||
(load "lib/r7rs.sx")
|
||||
(load "lib/apl/runtime.sx")
|
||||
(load "lib/apl/tokenizer.sx")
|
||||
(load "lib/apl/parser.sx")
|
||||
(load "lib/apl/transpile.sx")
|
||||
(epoch 2)
|
||||
(eval "(define apl-test-pass 0)")
|
||||
@@ -34,11 +37,14 @@ cat > "$TMPFILE" << 'EPOCHS'
|
||||
(load "lib/apl/tests/programs.sx")
|
||||
(load "lib/apl/tests/system.sx")
|
||||
(load "lib/apl/tests/idioms.sx")
|
||||
(load "lib/apl/tests/eval-ops.sx")
|
||||
(load "lib/apl/tests/pipeline.sx")
|
||||
(load "lib/apl/tests/programs-e2e.sx")
|
||||
(epoch 4)
|
||||
(eval "(list apl-test-pass apl-test-fail)")
|
||||
EPOCHS
|
||||
|
||||
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||
|
||||
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
|
||||
if [ -z "$LINE" ]; then
|
||||
|
||||
147
lib/apl/tests/eval-ops.sx
Normal file
147
lib/apl/tests/eval-ops.sx
Normal file
@@ -0,0 +1,147 @@
|
||||
; Tests for operator handling in apl-eval-ast (Phase 7).
|
||||
; Manual AST construction; verifies :derived-fn / :outer / :derived-fn2
|
||||
; route through apl-resolve-monadic / apl-resolve-dyadic correctly.
|
||||
|
||||
(define mkrv (fn (arr) (get arr :ravel)))
|
||||
(define mksh (fn (arr) (get arr :shape)))
|
||||
(define mknum (fn (n) (list :num n)))
|
||||
(define mkfg (fn (g) (list :fn-glyph g)))
|
||||
(define mkmon (fn (g a) (list :monad g a)))
|
||||
(define mkdyd (fn (g l r) (list :dyad g l r)))
|
||||
(define mkder (fn (op f) (list :derived-fn op f)))
|
||||
(define mkdr2 (fn (op f g) (list :derived-fn2 op f g)))
|
||||
(define mkout (fn (f) (list :outer "∘." f)))
|
||||
|
||||
; helper: literal vector AST via :vec (from list of values)
|
||||
(define mkvec (fn (xs) (cons :vec (map (fn (n) (mknum n)) xs))))
|
||||
|
||||
; ---------- monadic operators ----------
|
||||
|
||||
(apl-test
|
||||
"eval-ast +/ ⍳5 → 15"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkmon (mkder "/" (mkfg "+")) (mkmon (mkfg "⍳") (mknum 5)))
|
||||
{}))
|
||||
(list 15))
|
||||
|
||||
(apl-test
|
||||
"eval-ast ×/ ⍳5 → 120"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkmon (mkder "/" (mkfg "×")) (mkmon (mkfg "⍳") (mknum 5)))
|
||||
{}))
|
||||
(list 120))
|
||||
|
||||
(apl-test
|
||||
"eval-ast ⌈/ — max reduce"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkmon (mkder "/" (mkfg "⌈")) (mkvec (list 3 1 4 1 5 9 2 6)))
|
||||
{}))
|
||||
(list 9))
|
||||
|
||||
(apl-test
|
||||
"eval-ast +\\ scan"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkmon (mkder "\\" (mkfg "+")) (mkvec (list 1 2 3 4 5)))
|
||||
{}))
|
||||
(list 1 3 6 10 15))
|
||||
|
||||
(apl-test
|
||||
"eval-ast +⌿ first-axis reduce on vector"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkmon (mkder "⌿" (mkfg "+")) (mkvec (list 1 2 3 4 5)))
|
||||
{}))
|
||||
(list 15))
|
||||
|
||||
(apl-test
|
||||
"eval-ast -¨ each-negate"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkmon (mkder "¨" (mkfg "-")) (mkvec (list 1 2 3 4)))
|
||||
{}))
|
||||
(list -1 -2 -3 -4))
|
||||
|
||||
(apl-test
|
||||
"eval-ast +⍨ commute (double via x+x)"
|
||||
(mkrv
|
||||
(apl-eval-ast (mkmon (mkder "⍨" (mkfg "+")) (mknum 7)) {}))
|
||||
(list 14))
|
||||
|
||||
; ---------- dyadic operators ----------
|
||||
|
||||
(apl-test
|
||||
"eval-ast outer ∘.× — multiplication table"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkdyd
|
||||
(mkout (mkfg "×"))
|
||||
(mkvec (list 1 2 3))
|
||||
(mkvec (list 1 2 3)))
|
||||
{}))
|
||||
(list 1 2 3 2 4 6 3 6 9))
|
||||
|
||||
(apl-test
|
||||
"eval-ast outer ∘.× shape (3 3)"
|
||||
(mksh
|
||||
(apl-eval-ast
|
||||
(mkdyd
|
||||
(mkout (mkfg "×"))
|
||||
(mkvec (list 1 2 3))
|
||||
(mkvec (list 1 2 3)))
|
||||
{}))
|
||||
(list 3 3))
|
||||
|
||||
(apl-test
|
||||
"eval-ast inner +.× — dot product"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkdyd
|
||||
(mkdr2 "." (mkfg "+") (mkfg "×"))
|
||||
(mkvec (list 1 2 3))
|
||||
(mkvec (list 4 5 6)))
|
||||
{}))
|
||||
(list 32))
|
||||
|
||||
(apl-test
|
||||
"eval-ast inner ∧.= equal vectors"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkdyd
|
||||
(mkdr2 "." (mkfg "∧") (mkfg "="))
|
||||
(mkvec (list 1 2 3))
|
||||
(mkvec (list 1 2 3)))
|
||||
{}))
|
||||
(list 1))
|
||||
|
||||
(apl-test
|
||||
"eval-ast each-dyadic +¨"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkdyd
|
||||
(mkder "¨" (mkfg "+"))
|
||||
(mkvec (list 1 2 3))
|
||||
(mkvec (list 10 20 30)))
|
||||
{}))
|
||||
(list 11 22 33))
|
||||
|
||||
(apl-test
|
||||
"eval-ast commute -⍨ (subtract swapped)"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkdyd (mkder "⍨" (mkfg "-")) (mknum 5) (mknum 3))
|
||||
{}))
|
||||
(list -2))
|
||||
|
||||
; ---------- nested operators ----------
|
||||
|
||||
(apl-test
|
||||
"eval-ast +/¨ — sum of each"
|
||||
(mkrv
|
||||
(apl-eval-ast
|
||||
(mkmon (mkder "/" (mkfg "+")) (mkvec (list 10 20 30)))
|
||||
{}))
|
||||
(list 60))
|
||||
@@ -222,3 +222,138 @@
|
||||
(mkrv
|
||||
(apl-shape (apl-shape (make-array (list 2 3) (list 1 2 3 4 5 6)))))
|
||||
(list 2))
|
||||
|
||||
(apl-test
|
||||
"src: +/⍳N → triangular(N)"
|
||||
(mkrv (apl-run "+/⍳100"))
|
||||
(list 5050))
|
||||
|
||||
(apl-test "src: ×/⍳N → N!" (mkrv (apl-run "×/⍳6")) (list 720))
|
||||
|
||||
(apl-test
|
||||
"src: ⌈/V — max"
|
||||
(mkrv (apl-run "⌈/3 1 4 1 5 9 2 6"))
|
||||
(list 9))
|
||||
|
||||
(apl-test
|
||||
"src: ⌊/V — min"
|
||||
(mkrv (apl-run "⌊/3 1 4 1 5 9 2 6"))
|
||||
(list 1))
|
||||
|
||||
(apl-test
|
||||
"src: range = (⌈/V) - ⌊/V"
|
||||
(mkrv (apl-run "(⌈/3 1 4 1 5 9 2 6) - ⌊/3 1 4 1 5 9 2 6"))
|
||||
(list 8))
|
||||
|
||||
(apl-test
|
||||
"src: +\\V — running sum"
|
||||
(mkrv (apl-run "+\\1 2 3 4 5"))
|
||||
(list 1 3 6 10 15))
|
||||
|
||||
(apl-test
|
||||
"src: ×\\V — running product"
|
||||
(mkrv (apl-run "×\\1 2 3 4 5"))
|
||||
(list 1 2 6 24 120))
|
||||
|
||||
(apl-test
|
||||
"src: V × V — squares"
|
||||
(mkrv (apl-run "(⍳5) × ⍳5"))
|
||||
(list 1 4 9 16 25))
|
||||
|
||||
(apl-test
|
||||
"src: +/V × V — sum of squares"
|
||||
(mkrv (apl-run "+/(⍳5) × ⍳5"))
|
||||
(list 55))
|
||||
|
||||
(apl-test "src: ∧/V — all-true" (mkrv (apl-run "∧/1 1 1 1")) (list 1))
|
||||
|
||||
(apl-test "src: ∨/V — any-true" (mkrv (apl-run "∨/0 0 1 0")) (list 1))
|
||||
|
||||
(apl-test "src: 0 = N|M — divides" (mkrv (apl-run "0 = 3 | 12")) (list 1))
|
||||
|
||||
(apl-test
|
||||
"src: 2 | V — parity"
|
||||
(mkrv (apl-run "2 | 1 2 3 4 5 6"))
|
||||
(list 1 0 1 0 1 0))
|
||||
|
||||
(apl-test
|
||||
"src: +/2|V — count odd"
|
||||
(mkrv (apl-run "+/2 | 1 2 3 4 5 6"))
|
||||
(list 3))
|
||||
|
||||
(apl-test "src: ⍴ V" (mkrv (apl-run "⍴ 1 2 3 4 5")) (list 5))
|
||||
|
||||
(apl-test
|
||||
"src: ⍴⍴ M — rank"
|
||||
(mkrv (apl-run "⍴ ⍴ (2 3) ⍴ ⍳6"))
|
||||
(list 2))
|
||||
|
||||
(apl-test
|
||||
"src: N⍴1 — vector of ones"
|
||||
(mkrv (apl-run "5 ⍴ 1"))
|
||||
(list 1 1 1 1 1))
|
||||
|
||||
(apl-test
|
||||
"src: ⍳N ∘.= ⍳N — identity matrix"
|
||||
(mkrv (apl-run "(⍳3) ∘.= ⍳3"))
|
||||
(list 1 0 0 0 1 0 0 0 1))
|
||||
|
||||
(apl-test
|
||||
"src: ⍳N ∘.× ⍳N — multiplication table"
|
||||
(mkrv (apl-run "(⍳3) ∘.× ⍳3"))
|
||||
(list 1 2 3 2 4 6 3 6 9))
|
||||
|
||||
(apl-test
|
||||
"src: V +.× V — dot product"
|
||||
(mkrv (apl-run "1 2 3 +.× 4 5 6"))
|
||||
(list 32))
|
||||
|
||||
(apl-test
|
||||
"src: ∧.= V — vectors equal?"
|
||||
(mkrv (apl-run "1 2 3 ∧.= 1 2 3"))
|
||||
(list 1))
|
||||
|
||||
(apl-test
|
||||
"src: V[1] — first element"
|
||||
(mkrv (apl-run "(10 20 30 40)[1]"))
|
||||
(list 10))
|
||||
|
||||
(apl-test
|
||||
"src: 1↑V — first via take"
|
||||
(mkrv (apl-run "1 ↑ 10 20 30 40"))
|
||||
(list 10))
|
||||
|
||||
(apl-test
|
||||
"src: 1↓V — drop first"
|
||||
(mkrv (apl-run "1 ↓ 10 20 30 40"))
|
||||
(list 20 30 40))
|
||||
|
||||
(apl-test
|
||||
"src: ¯1↓V — drop last"
|
||||
(mkrv (apl-run "¯1 ↓ 10 20 30 40"))
|
||||
(list 10 20 30))
|
||||
|
||||
(apl-test
|
||||
"src: ⌽V — reverse"
|
||||
(mkrv (apl-run "⌽ 1 2 3 4 5"))
|
||||
(list 5 4 3 2 1))
|
||||
|
||||
(apl-test
|
||||
"src: ≢V — tally"
|
||||
(mkrv (apl-run "≢ 9 8 7 6 5 4 3 2 1"))
|
||||
(list 9))
|
||||
|
||||
(apl-test
|
||||
"src: ,M — ravel"
|
||||
(mkrv (apl-run ", (2 3) ⍴ ⍳6"))
|
||||
(list 1 2 3 4 5 6))
|
||||
|
||||
(apl-test
|
||||
"src: A=V — count occurrences"
|
||||
(mkrv (apl-run "+/2 = 1 2 3 2 1 3 2"))
|
||||
(list 3))
|
||||
|
||||
(apl-test
|
||||
"src: ⌈/(V × V) — max squared"
|
||||
(mkrv (apl-run "⌈/(1 2 3 4 5) × 1 2 3 4 5"))
|
||||
(list 25))
|
||||
|
||||
687
lib/apl/tests/pipeline.sx
Normal file
687
lib/apl/tests/pipeline.sx
Normal file
@@ -0,0 +1,687 @@
|
||||
; End-to-end pipeline tests: source string → tokenize → parse → eval-ast → array.
|
||||
; Verifies the full stack as a single function call (apl-run).
|
||||
|
||||
(define mkrv (fn (arr) (get arr :ravel)))
|
||||
(define mksh (fn (arr) (get arr :shape)))
|
||||
|
||||
; ---------- scalars ----------
|
||||
|
||||
(apl-test "apl-run \"42\" → scalar 42" (mkrv (apl-run "42")) (list 42))
|
||||
|
||||
(apl-test "apl-run \"¯7\" → scalar -7" (mkrv (apl-run "¯7")) (list -7))
|
||||
|
||||
; ---------- strands ----------
|
||||
|
||||
(apl-test
|
||||
"apl-run \"1 2 3\" → vector"
|
||||
(mkrv (apl-run "1 2 3"))
|
||||
(list 1 2 3))
|
||||
|
||||
(apl-test "apl-run \"1 2 3\" shape" (mksh (apl-run "1 2 3")) (list 3))
|
||||
|
||||
; ---------- dyadic arithmetic ----------
|
||||
|
||||
(apl-test "apl-run \"2 + 3\" → 5" (mkrv (apl-run "2 + 3")) (list 5))
|
||||
|
||||
(apl-run "2 × 3 + 4") ; right-to-left
|
||||
|
||||
(apl-test
|
||||
"apl-run \"2 × 3 + 4\" → 14 (right-to-left)"
|
||||
(mkrv (apl-run "2 × 3 + 4"))
|
||||
(list 14))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"1 2 3 + 4 5 6\" → 5 7 9"
|
||||
(mkrv (apl-run "1 2 3 + 4 5 6"))
|
||||
(list 5 7 9))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"3 × 1 2 3 4\" → scalar broadcast"
|
||||
(mkrv (apl-run "3 × 1 2 3 4"))
|
||||
(list 3 6 9 12))
|
||||
|
||||
; ---------- monadic primitives ----------
|
||||
|
||||
(apl-test
|
||||
"apl-run \"⍳5\" → 1..5"
|
||||
(mkrv (apl-run "⍳5"))
|
||||
(list 1 2 3 4 5))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"-3\" → -3 (monadic negate)"
|
||||
(mkrv (apl-run "-3"))
|
||||
(list -3))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"⌈/ 1 3 9 5 7\" → 9 (max-reduce)"
|
||||
(mkrv (apl-run "⌈/ 1 3 9 5 7"))
|
||||
(list 9))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"⌊/ 4 7 2 9 1 3\" → 1 (min-reduce)"
|
||||
(mkrv (apl-run "⌊/ 4 7 2 9 1 3"))
|
||||
(list 1))
|
||||
|
||||
; ---------- operators ----------
|
||||
|
||||
(apl-test "apl-run \"+/⍳5\" → 15" (mkrv (apl-run "+/⍳5")) (list 15))
|
||||
|
||||
(apl-test "apl-run \"×/⍳5\" → 120" (mkrv (apl-run "×/⍳5")) (list 120))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"⌈/3 1 4 1 5 9 2\" → 9"
|
||||
(mkrv (apl-run "⌈/3 1 4 1 5 9 2"))
|
||||
(list 9))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"+\\\\⍳5\" → triangular numbers"
|
||||
(mkrv (apl-run "+\\⍳5"))
|
||||
(list 1 3 6 10 15))
|
||||
|
||||
; ---------- outer / inner products ----------
|
||||
|
||||
(apl-test
|
||||
"apl-run \"1 2 3 ∘.× 1 2 3\" → mult table values"
|
||||
(mkrv (apl-run "1 2 3 ∘.× 1 2 3"))
|
||||
(list 1 2 3 2 4 6 3 6 9))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"1 2 3 +.× 4 5 6\" → dot product 32"
|
||||
(mkrv (apl-run "1 2 3 +.× 4 5 6"))
|
||||
(list 32))
|
||||
|
||||
; ---------- shape ----------
|
||||
|
||||
(apl-test
|
||||
"apl-run \"⍴ 1 2 3 4 5\" → 5"
|
||||
(mkrv (apl-run "⍴ 1 2 3 4 5"))
|
||||
(list 5))
|
||||
|
||||
(apl-test "apl-run \"⍴⍳10\" → 10" (mkrv (apl-run "⍴⍳10")) (list 10))
|
||||
|
||||
; ---------- comparison ----------
|
||||
|
||||
(apl-test "apl-run \"3 < 5\" → 1" (mkrv (apl-run "3 < 5")) (list 1))
|
||||
|
||||
(apl-test "apl-run \"5 = 5\" → 1" (mkrv (apl-run "5 = 5")) (list 1))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"1 2 3 = 1 0 3\" → 1 0 1"
|
||||
(mkrv (apl-run "1 2 3 = 1 0 3"))
|
||||
(list 1 0 1))
|
||||
|
||||
; ---------- famous one-liners ----------
|
||||
|
||||
(apl-test
|
||||
"apl-run \"+/(⍳10)\" → sum 1..10 = 55"
|
||||
(mkrv (apl-run "+/(⍳10)"))
|
||||
(list 55))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"×/⍳10\" → 10! = 3628800"
|
||||
(mkrv (apl-run "×/⍳10"))
|
||||
(list 3628800))
|
||||
|
||||
(apl-test "apl-run \"⎕IO\" → 1" (mkrv (apl-run "⎕IO")) (list 1))
|
||||
|
||||
(apl-test "apl-run \"⎕ML\" → 1" (mkrv (apl-run "⎕ML")) (list 1))
|
||||
|
||||
(apl-test "apl-run \"⎕FR\" → 1248" (mkrv (apl-run "⎕FR")) (list 1248))
|
||||
|
||||
(apl-test "apl-run \"⎕TS\" shape (7)" (mksh (apl-run "⎕TS")) (list 7))
|
||||
|
||||
(apl-test "apl-run \"⎕FMT 42\" → \"42\"" (apl-run "⎕FMT 42") "42")
|
||||
|
||||
(apl-test
|
||||
"apl-run \"⎕FMT 1 2 3\" → \"1 2 3\""
|
||||
(apl-run "⎕FMT 1 2 3")
|
||||
"1 2 3")
|
||||
|
||||
(apl-test
|
||||
"apl-run \"⎕FMT ⍳5\" → \"1 2 3 4 5\""
|
||||
(apl-run "⎕FMT ⍳5")
|
||||
"1 2 3 4 5")
|
||||
|
||||
(apl-test "apl-run \"⎕IO + 4\" → 5" (mkrv (apl-run "⎕IO + 4")) (list 5))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"(10 20 30 40 50)[3]\" → 30"
|
||||
(mkrv (apl-run "(10 20 30 40 50)[3]"))
|
||||
(list 30))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"(⍳10)[5]\" → 5"
|
||||
(mkrv (apl-run "(⍳10)[5]"))
|
||||
(list 5))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"A ← 100 200 300 ⋄ A[2]\" → 200"
|
||||
(mkrv (apl-run "A ← 100 200 300 ⋄ A[2]"))
|
||||
(list 200))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"V ← ⍳10 ⋄ V[3]\" → 3"
|
||||
(mkrv (apl-run "V ← ⍳10 ⋄ V[3]"))
|
||||
(list 3))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"(10 20 30)[1]\" → 10 (1-indexed)"
|
||||
(mkrv (apl-run "(10 20 30)[1]"))
|
||||
(list 10))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"V ← 10 20 30 40 50 ⋄ V[3] + 1\" → 31"
|
||||
(mkrv (apl-run "V ← 10 20 30 40 50 ⋄ V[3] + 1"))
|
||||
(list 31))
|
||||
|
||||
(apl-test
|
||||
"apl-run \"(⍳5)[3] × 7\" → 21"
|
||||
(mkrv (apl-run "(⍳5)[3] × 7"))
|
||||
(list 21))
|
||||
|
||||
(apl-test "decimal: 3.7 → 3.7" (mkrv (apl-run "3.7")) (list 3.7))
|
||||
|
||||
(apl-test "decimal: ¯2.5 → -2.5" (mkrv (apl-run "¯2.5")) (list -2.5))
|
||||
|
||||
(apl-test "decimal: 1.5 + 2.5 → 4" (mkrv (apl-run "1.5 + 2.5")) (list 4))
|
||||
|
||||
(apl-test "decimal: ⌊3.7 → 3" (mkrv (apl-run "⌊ 3.7")) (list 3))
|
||||
|
||||
(apl-test "decimal: ⌈3.7 → 4" (mkrv (apl-run "⌈ 3.7")) (list 4))
|
||||
|
||||
(apl-test
|
||||
"⎕← scalar passthrough"
|
||||
(mkrv (apl-run "⎕← 42"))
|
||||
(list 42))
|
||||
|
||||
(apl-test
|
||||
"⎕← vector passthrough"
|
||||
(mkrv (apl-run "⎕← 1 2 3"))
|
||||
(list 1 2 3))
|
||||
|
||||
(apl-test
|
||||
"string: 'abc' → 3-char vector"
|
||||
(mkrv (apl-run "'abc'"))
|
||||
(list "a" "b" "c"))
|
||||
|
||||
(apl-test "string: 'a' is rank-0 scalar" (mksh (apl-run "'a'")) (list))
|
||||
|
||||
(apl-test "string: 'hello' shape (5)" (mksh (apl-run "'hello'")) (list 5))
|
||||
|
||||
(apl-test
|
||||
"named-fn: f ← {⍺+⍵} ⋄ 3 f 4 → 7"
|
||||
(mkrv (apl-run "f ← {⍺+⍵} ⋄ 3 f 4"))
|
||||
(list 7))
|
||||
|
||||
(apl-test
|
||||
"named-fn monadic: sq ← {⍵×⍵} ⋄ sq 7 → 49"
|
||||
(mkrv (apl-run "sq ← {⍵×⍵} ⋄ sq 7"))
|
||||
(list 49))
|
||||
|
||||
(apl-test
|
||||
"named-fn dyadic: hyp ← {((⍺×⍺)+⍵×⍵)} ⋄ 3 hyp 4 → 25"
|
||||
(mkrv (apl-run "hyp ← {((⍺×⍺)+⍵×⍵)} ⋄ 3 hyp 4"))
|
||||
(list 25))
|
||||
|
||||
(apl-test
|
||||
"named-fn: dbl ← {⍵+⍵} ⋄ dbl ⍳5"
|
||||
(mkrv (apl-run "dbl ← {⍵+⍵} ⋄ dbl ⍳5"))
|
||||
(list 2 4 6 8 10))
|
||||
|
||||
(apl-test
|
||||
"named-fn factorial via ∇ recursion"
|
||||
(mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 5"))
|
||||
(list 120))
|
||||
|
||||
(apl-test
|
||||
"named-fn used twice in expr: dbl ← {⍵+⍵} ⋄ (dbl 3) + dbl 4"
|
||||
(mkrv (apl-run "dbl ← {⍵+⍵} ⋄ (dbl 3) + dbl 4"))
|
||||
(list 14))
|
||||
|
||||
(apl-test
|
||||
"named-fn with vector arg: neg ← {-⍵} ⋄ neg 1 2 3"
|
||||
(mkrv (apl-run "neg ← {-⍵} ⋄ neg 1 2 3"))
|
||||
(list -1 -2 -3))
|
||||
|
||||
(apl-test
|
||||
"multi-axis: M[2;2] → center"
|
||||
(mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[2;2]"))
|
||||
(list 5))
|
||||
|
||||
(apl-test
|
||||
"multi-axis: M[1;] → first row"
|
||||
(mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"))
|
||||
(list 1 2 3))
|
||||
|
||||
(apl-test
|
||||
"multi-axis: M[;2] → second column"
|
||||
(mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[;2]"))
|
||||
(list 2 5 8))
|
||||
|
||||
(apl-test
|
||||
"multi-axis: M[1 2;1 2] → 2x2 block"
|
||||
(mkrv (apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]"))
|
||||
(list 1 2 4 5))
|
||||
|
||||
(apl-test
|
||||
"multi-axis: M[1 2;1 2] shape (2 2)"
|
||||
(mksh (apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]"))
|
||||
(list 2 2))
|
||||
|
||||
(apl-test
|
||||
"multi-axis: M[;] full matrix"
|
||||
(mkrv (apl-run "M ← (2 2) ⍴ 10 20 30 40 ⋄ M[;]"))
|
||||
(list 10 20 30 40))
|
||||
|
||||
(apl-test
|
||||
"multi-axis: M[1;] shape collapsed"
|
||||
(mksh (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"))
|
||||
(list 3))
|
||||
|
||||
(apl-test
|
||||
"multi-axis: select all rows of column 3"
|
||||
(mkrv (apl-run "M ← (4 3) ⍴ 1 2 3 4 5 6 7 8 9 10 11 12 ⋄ M[;3]"))
|
||||
(list 3 6 9 12))
|
||||
|
||||
(apl-test
|
||||
"train: mean = (+/÷≢) on 1..5"
|
||||
(mkrv (apl-run "(+/÷≢) 1 2 3 4 5"))
|
||||
(list 3))
|
||||
|
||||
(apl-test
|
||||
"train: mean of 2 4 6 8 10"
|
||||
(mkrv (apl-run "(+/÷≢) 2 4 6 8 10"))
|
||||
(list 6))
|
||||
|
||||
(apl-test
|
||||
"train 2-atop: (- ⌊) 5 → -5"
|
||||
(mkrv (apl-run "(- ⌊) 5"))
|
||||
(list -5))
|
||||
|
||||
(apl-test
|
||||
"train 3-fork dyadic: 2(+×-)5 → -21"
|
||||
(mkrv (apl-run "2 (+ × -) 5"))
|
||||
(list -21))
|
||||
|
||||
(apl-test
|
||||
"train: range = (⌈/-⌊/) on vector"
|
||||
(mkrv (apl-run "(⌈/-⌊/) 3 1 4 1 5 9 2 6"))
|
||||
(list 8))
|
||||
|
||||
(apl-test
|
||||
"train: mean of ⍳10 has shape ()"
|
||||
(mksh (apl-run "(+/÷≢) ⍳10"))
|
||||
(list))
|
||||
|
||||
(apl-test
|
||||
"compress: 1 0 1 0 1 / 10 20 30 40 50"
|
||||
(mkrv (apl-run "1 0 1 0 1 / 10 20 30 40 50"))
|
||||
(list 10 30 50))
|
||||
|
||||
(apl-test
|
||||
"compress: empty mask → empty"
|
||||
(mkrv (apl-run "0 0 0 / 1 2 3"))
|
||||
(list))
|
||||
|
||||
(apl-test
|
||||
"primes via classic idiom (multi-stmt)"
|
||||
(mkrv (apl-run "P ← ⍳ 30 ⋄ (2 = +⌿ 0 = P ∘.| P) / P"))
|
||||
(list 2 3 5 7 11 13 17 19 23 29))
|
||||
|
||||
(apl-test
|
||||
"primes via classic idiom (n=20)"
|
||||
(mkrv (apl-run "P ← ⍳ 20 ⋄ (2 = +⌿ 0 = P ∘.| P) / P"))
|
||||
(list 2 3 5 7 11 13 17 19))
|
||||
|
||||
(apl-test
|
||||
"compress: filter even values"
|
||||
(mkrv (apl-run "(0 = 2 | 1 2 3 4 5 6) / 1 2 3 4 5 6"))
|
||||
(list 2 4 6))
|
||||
|
||||
(apl-test "inline-assign: x ← 5" (mkrv (apl-run "x ← 5")) (list 5))
|
||||
|
||||
(apl-test
|
||||
"inline-assign: (2×x) + x←10 → 30"
|
||||
(mkrv (apl-run "(2 × x) + x ← 10"))
|
||||
(list 30))
|
||||
|
||||
(apl-test
|
||||
"inline-assign primes one-liner: (2=+⌿0=a∘.|a)/a←⍳30"
|
||||
(mkrv (apl-run "(2 = +⌿ 0 = a ∘.| a) / a ← ⍳ 30"))
|
||||
(list 2 3 5 7 11 13 17 19 23 29))
|
||||
|
||||
(apl-test
|
||||
"inline-assign: x is reusable — x + x ← 7 → 14"
|
||||
(mkrv (apl-run "x + x ← 7"))
|
||||
(list 14))
|
||||
|
||||
(apl-test
|
||||
"inline-assign in dfn: f ← {x + x ← ⍵} ⋄ f 8 → 16"
|
||||
(mkrv (apl-run "f ← {x + x ← ⍵} ⋄ f 8"))
|
||||
(list 16))
|
||||
|
||||
(begin (apl-rng-seed! 42) nil)
|
||||
|
||||
(apl-test
|
||||
"?10 with seed 42 → 8 (deterministic)"
|
||||
(mkrv (apl-run "?10"))
|
||||
(list 8))
|
||||
|
||||
(apl-test "?10 next call → 5" (mkrv (apl-run "?10")) (list 5))
|
||||
|
||||
(apl-test
|
||||
"?100 stays in range"
|
||||
(let ((v (first (mkrv (apl-run "?100"))))) (and (>= v 1) (<= v 100)))
|
||||
true)
|
||||
|
||||
(begin (apl-rng-seed! 42) nil)
|
||||
|
||||
(apl-test
|
||||
"?10 with re-seed 42 → 8 (reproducible)"
|
||||
(mkrv (apl-run "?10"))
|
||||
(list 8))
|
||||
|
||||
(apl-test
|
||||
"apl-run-file: load primes.apl returns dfn AST"
|
||||
(first (apl-run-file "lib/apl/tests/programs/primes.apl"))
|
||||
:dfn)
|
||||
|
||||
(apl-test
|
||||
"apl-run-file: life.apl parses without error"
|
||||
(first (apl-run-file "lib/apl/tests/programs/life.apl"))
|
||||
:dfn)
|
||||
|
||||
(apl-test
|
||||
"apl-run-file: quicksort.apl parses without error"
|
||||
(first (apl-run-file "lib/apl/tests/programs/quicksort.apl"))
|
||||
:dfn)
|
||||
|
||||
(apl-test
|
||||
"apl-run-file: source-then-call returns primes count"
|
||||
(mksh
|
||||
(apl-run
|
||||
(str (file-read "lib/apl/tests/programs/primes.apl") " ⋄ primes 30")))
|
||||
(list 10))
|
||||
|
||||
(apl-test
|
||||
"primes one-liner with ⍵-rebind: primes 30"
|
||||
(mkrv
|
||||
(apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 30"))
|
||||
(list 2 3 5 7 11 13 17 19 23 29))
|
||||
|
||||
(apl-test
|
||||
"primes one-liner: primes 50"
|
||||
(mkrv
|
||||
(apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 50"))
|
||||
(list 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))
|
||||
|
||||
(apl-test
|
||||
"primes.apl loaded + called via apl-run-file"
|
||||
(mkrv
|
||||
(apl-run
|
||||
(str (file-read "lib/apl/tests/programs/primes.apl") " ⋄ primes 20")))
|
||||
(list 2 3 5 7 11 13 17 19))
|
||||
|
||||
(apl-test
|
||||
"primes.apl loaded — count of primes ≤ 100"
|
||||
(first
|
||||
(mksh
|
||||
(apl-run
|
||||
(str
|
||||
(file-read "lib/apl/tests/programs/primes.apl")
|
||||
" ⋄ primes 100"))))
|
||||
25)
|
||||
|
||||
(apl-test
|
||||
"⍉ monadic transpose 2x3 → 3x2"
|
||||
(mkrv (apl-run "⍉ (2 3) ⍴ ⍳6"))
|
||||
(list 1 4 2 5 3 6))
|
||||
|
||||
(apl-test
|
||||
"⍉ transpose shape (3 2)"
|
||||
(mksh (apl-run "⍉ (2 3) ⍴ ⍳6"))
|
||||
(list 3 2))
|
||||
|
||||
(apl-test "⊢ monadic identity" (mkrv (apl-run "⊢ 1 2 3")) (list 1 2 3))
|
||||
|
||||
(apl-test
|
||||
"5 ⊣ 1 2 3 → 5 (left)"
|
||||
(mkrv (apl-run "5 ⊣ 1 2 3"))
|
||||
(list 5))
|
||||
|
||||
(apl-test
|
||||
"5 ⊢ 1 2 3 → 1 2 3 (right)"
|
||||
(mkrv (apl-run "5 ⊢ 1 2 3"))
|
||||
(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)))
|
||||
189
lib/apl/tests/programs-e2e.sx
Normal file
189
lib/apl/tests/programs-e2e.sx
Normal file
@@ -0,0 +1,189 @@
|
||||
; End-to-end tests of the classic-program archetypes — running APL
|
||||
; source through the full pipeline (tokenize → parse → eval-ast → runtime).
|
||||
;
|
||||
; These mirror the algorithms documented in lib/apl/tests/programs/*.apl
|
||||
; but use forms our pipeline supports today (named functions instead of
|
||||
; the inline ⍵← rebinding idiom; multi-stmt over single one-liners).
|
||||
|
||||
(define mkrv (fn (arr) (get arr :ravel)))
|
||||
(define mksh (fn (arr) (get arr :shape)))
|
||||
|
||||
; ---------- factorial via ∇ recursion (cf. n-queens style) ----------
|
||||
|
||||
(apl-test
|
||||
"e2e: factorial 5! = 120"
|
||||
(mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 5"))
|
||||
(list 120))
|
||||
|
||||
(apl-test
|
||||
"e2e: factorial 7! = 5040"
|
||||
(mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 7"))
|
||||
(list 5040))
|
||||
|
||||
(apl-test
|
||||
"e2e: factorial via ×/⍳N (no recursion)"
|
||||
(mkrv (apl-run "fact ← {×/⍳⍵} ⋄ fact 6"))
|
||||
(list 720))
|
||||
|
||||
; ---------- sum / triangular numbers (sum-1..N) ----------
|
||||
|
||||
(apl-test
|
||||
"e2e: triangular(10) = 55"
|
||||
(mkrv (apl-run "tri ← {+/⍳⍵} ⋄ tri 10"))
|
||||
(list 55))
|
||||
|
||||
(apl-test
|
||||
"e2e: triangular(100) = 5050"
|
||||
(mkrv (apl-run "tri ← {+/⍳⍵} ⋄ tri 100"))
|
||||
(list 5050))
|
||||
|
||||
; ---------- sum of squares ----------
|
||||
|
||||
(apl-test
|
||||
"e2e: sum-of-squares 1..5 = 55"
|
||||
(mkrv (apl-run "ss ← {+/⍵×⍵} ⋄ ss ⍳5"))
|
||||
(list 55))
|
||||
|
||||
(apl-test
|
||||
"e2e: sum-of-squares 1..10 = 385"
|
||||
(mkrv (apl-run "ss ← {+/⍵×⍵} ⋄ ss ⍳10"))
|
||||
(list 385))
|
||||
|
||||
; ---------- divisor-counting (prime-sieve building blocks) ----------
|
||||
|
||||
(apl-test
|
||||
"e2e: divisor counts 1..5 via outer mod"
|
||||
(mkrv (apl-run "P ← ⍳ 5 ⋄ +⌿ 0 = P ∘.| P"))
|
||||
(list 1 2 2 3 2))
|
||||
|
||||
(apl-test
|
||||
"e2e: divisor counts 1..10"
|
||||
(mkrv (apl-run "P ← ⍳ 10 ⋄ +⌿ 0 = P ∘.| P"))
|
||||
(list 1 2 2 3 2 4 2 4 3 4))
|
||||
|
||||
(apl-test
|
||||
"e2e: prime-mask 1..10 (count==2)"
|
||||
(mkrv (apl-run "P ← ⍳ 10 ⋄ 2 = +⌿ 0 = P ∘.| P"))
|
||||
(list 0 1 1 0 1 0 1 0 0 0))
|
||||
|
||||
; ---------- monadic primitives chained ----------
|
||||
|
||||
(apl-test
|
||||
"e2e: sum of |abs| = 15"
|
||||
(mkrv (apl-run "+/|¯1 ¯2 ¯3 ¯4 ¯5"))
|
||||
(list 15))
|
||||
|
||||
(apl-test
|
||||
"e2e: max of squares 1..6"
|
||||
(mkrv (apl-run "⌈/(⍳6)×⍳6"))
|
||||
(list 36))
|
||||
|
||||
; ---------- nested named functions ----------
|
||||
|
||||
(apl-test
|
||||
"e2e: compose dbl and sq via two named fns"
|
||||
(mkrv (apl-run "dbl ← {⍵+⍵} ⋄ sq ← {⍵×⍵} ⋄ sq dbl 3"))
|
||||
(list 36))
|
||||
|
||||
(apl-test
|
||||
"e2e: max-of-two as named dyadic fn"
|
||||
(mkrv (apl-run "mx ← {⍺⌈⍵} ⋄ 5 mx 3"))
|
||||
(list 5))
|
||||
|
||||
(apl-test
|
||||
"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)))
|
||||
@@ -252,8 +252,6 @@
|
||||
|
||||
(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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -18,6 +18,10 @@
|
||||
|
||||
(define mksel (fn (v cs d) (list :select v cs d)))
|
||||
|
||||
(define mktrap (fn (codes t c) (list :trap codes t c)))
|
||||
|
||||
(define mkthr (fn (code msg) (list :throw code msg)))
|
||||
|
||||
(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)))
|
||||
@@ -125,3 +129,28 @@
|
||||
"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))
|
||||
|
||||
(apl-test
|
||||
"tradfn :Trap normal flow (no error)"
|
||||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 0) (list (mkasg "R" (mknum 99))) (list (mkasg "R" (mknum -1))))) :alpha nil} nil nil))
|
||||
(list 99))
|
||||
|
||||
(apl-test
|
||||
"tradfn :Trap catches matching code"
|
||||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 5) (list (mkthr 5 "boom")) (list (mkasg "R" (mknum 42))))) :alpha nil} nil nil))
|
||||
(list 42))
|
||||
|
||||
(apl-test
|
||||
"tradfn :Trap catch-all (code 0)"
|
||||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 0) (list (mkthr 99 "any")) (list (mkasg "R" (mknum 1))))) :alpha nil} nil nil))
|
||||
(list 1))
|
||||
|
||||
(apl-test
|
||||
"tradfn :Trap catches one of many codes"
|
||||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 1 2 3) (list (mkthr 2 "two")) (list (mkasg "R" (mknum 22))))) :alpha nil} nil nil))
|
||||
(list 22))
|
||||
|
||||
(apl-test
|
||||
"tradfn :Trap continues to next stmt after catch"
|
||||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 7) (list (mkthr 7 "c")) (list (mkasg "R" (mknum 10)))) (mkasg "R" (mkdyd "+" (mknm "R") (mknum 5)))) :alpha nil} nil nil))
|
||||
(list 15))
|
||||
|
||||
@@ -1,8 +1,8 @@
|
||||
(define apl-glyph-set
|
||||
(list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~" "<" "≤" "=" "≥" ">" "≠"
|
||||
"∊" "∧" "∨" "⍱" "⍲" "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
|
||||
"≢" "≡" "∊" "∧" "∨" "⍱" "⍲" "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
|
||||
"∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕"
|
||||
"⍺" "⍵" "∇" "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))
|
||||
"⍺" "⍵" "∇" "/" "⌿" "\\" "⍀" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))
|
||||
|
||||
(define apl-glyph?
|
||||
(fn (ch)
|
||||
@@ -19,150 +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! "")))
|
||||
(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! "")))
|
||||
(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!))
|
||||
(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)))
|
||||
|
||||
@@ -39,6 +39,16 @@
|
||||
((= g "⊖") apl-reverse-first)
|
||||
((= g "⍋") apl-grade-up)
|
||||
((= g "⍒") apl-grade-down)
|
||||
((= g "?") apl-roll)
|
||||
((= g "⍉") apl-transpose)
|
||||
((= g "⊢") (fn (a) a))
|
||||
((= g "⊣") (fn (a) a))
|
||||
((= 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
|
||||
@@ -78,6 +88,17 @@
|
||||
((= g "∊") apl-member)
|
||||
((= g "⍳") apl-index-of)
|
||||
((= g "~") apl-without)
|
||||
((= g "/") apl-compress)
|
||||
((= g "⌿") apl-compress-first)
|
||||
((= 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
|
||||
@@ -96,6 +117,15 @@
|
||||
((tag (first node)))
|
||||
(cond
|
||||
((= tag :num) (apl-scalar (nth node 1)))
|
||||
((= tag :str)
|
||||
(let
|
||||
((s (nth node 1)))
|
||||
(if
|
||||
(= (len s) 1)
|
||||
(apl-scalar s)
|
||||
(make-array
|
||||
(list (len s))
|
||||
(map (fn (i) (slice s i (+ i 1))) (range 0 (len s)))))))
|
||||
((= tag :vec)
|
||||
(let
|
||||
((items (rest node)))
|
||||
@@ -103,41 +133,74 @@
|
||||
((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)))
|
||||
(cond
|
||||
((= nm "⍺") (get env "alpha"))
|
||||
((= nm "⍵") (get env "omega"))
|
||||
((= nm "⍺")
|
||||
(let
|
||||
((v (get env "⍺")))
|
||||
(if (= v nil) (get env "alpha") v)))
|
||||
((= nm "⍵")
|
||||
(let
|
||||
((v (get env "⍵")))
|
||||
(if (= v nil) (get env "omega") v)))
|
||||
((= nm "⎕IO") (apl-quad-io))
|
||||
((= nm "⎕ML") (apl-quad-ml))
|
||||
((= nm "⎕FR") (apl-quad-fr))
|
||||
((= nm "⎕TS") (apl-quad-ts))
|
||||
(else (get env nm)))))
|
||||
((= tag :monad)
|
||||
(let
|
||||
((fn-node (nth node 1)) (arg (nth node 2)))
|
||||
(let
|
||||
((g (nth fn-node 1)))
|
||||
(if
|
||||
(= g "∇")
|
||||
(apl-call-dfn-m (get env "nabla") (apl-eval-ast arg env))
|
||||
((apl-monadic-fn g) (apl-eval-ast arg env))))))
|
||||
(if
|
||||
(and (= (first fn-node) :fn-glyph) (= (nth fn-node 1) "∇"))
|
||||
(apl-call-dfn-m (get env "nabla") (apl-eval-ast arg env))
|
||||
(let
|
||||
((arg-val (apl-eval-ast arg env)))
|
||||
(let
|
||||
((new-env (if (and (list? arg) (> (len arg) 0) (= (first arg) :assign-expr)) (assoc env (nth arg 1) arg-val) env)))
|
||||
((apl-resolve-monadic fn-node new-env) arg-val))))))
|
||||
((= tag :dyad)
|
||||
(let
|
||||
((fn-node (nth node 1))
|
||||
(lhs (nth node 2))
|
||||
(rhs (nth node 3)))
|
||||
(let
|
||||
((g (nth fn-node 1)))
|
||||
(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))))))
|
||||
(if
|
||||
(and (= (first fn-node) :fn-glyph) (= (nth fn-node 1) "∇"))
|
||||
(apl-call-dfn
|
||||
(get env "nabla")
|
||||
(apl-eval-ast lhs env)
|
||||
(apl-eval-ast rhs env))
|
||||
(let
|
||||
((rhs-val (apl-eval-ast rhs env)))
|
||||
(let
|
||||
((new-env (if (and (list? rhs) (> (len rhs) 0) (= (first rhs) :assign-expr)) (assoc env (nth rhs 1) rhs-val) env)))
|
||||
((apl-resolve-dyadic fn-node new-env)
|
||||
(apl-eval-ast lhs new-env)
|
||||
rhs-val))))))
|
||||
((= tag :program) (apl-eval-stmts (rest node) env))
|
||||
((= tag :dfn) node)
|
||||
((= tag :bracket)
|
||||
(let
|
||||
((arr-expr (nth node 1)) (axis-exprs (rest (rest node))))
|
||||
(let
|
||||
((arr (apl-eval-ast arr-expr env))
|
||||
(axes
|
||||
(map
|
||||
(fn (a) (if (= a :all) nil (apl-eval-ast a env)))
|
||||
axis-exprs)))
|
||||
(apl-bracket-multi axes arr))))
|
||||
((= tag :assign-expr) (apl-eval-ast (nth node 2) env))
|
||||
((= tag :assign) (apl-eval-ast (nth node 2) env))
|
||||
(else (error (list "apl-eval-ast: unknown node tag" tag node)))))))
|
||||
|
||||
(define
|
||||
@@ -275,6 +338,17 @@
|
||||
(let
|
||||
((val (apl-eval-ast (nth stmt 1) env)))
|
||||
(apl-tradfn-eval-select val (nth stmt 2) (nth stmt 3) env)))
|
||||
((= tag :trap)
|
||||
(let
|
||||
((codes (nth stmt 1))
|
||||
(try-block (nth stmt 2))
|
||||
(catch-block (nth stmt 3)))
|
||||
(guard
|
||||
(e
|
||||
((apl-trap-matches? codes e)
|
||||
(apl-tradfn-eval-block catch-block env)))
|
||||
(apl-tradfn-eval-block try-block env))))
|
||||
((= tag :throw) (apl-throw (nth stmt 1) (nth stmt 2)))
|
||||
(else (begin (apl-eval-ast stmt env) env))))))
|
||||
|
||||
(define
|
||||
@@ -369,3 +443,150 @@
|
||||
(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")))))
|
||||
|
||||
(define
|
||||
apl-resolve-monadic
|
||||
(fn
|
||||
(fn-node env)
|
||||
(let
|
||||
((tag (first fn-node)))
|
||||
(cond
|
||||
((= tag :fn-glyph) (apl-monadic-fn (nth fn-node 1)))
|
||||
((= tag :derived-fn)
|
||||
(let
|
||||
((op (nth fn-node 1)) (inner (nth fn-node 2)))
|
||||
(cond
|
||||
((= op "/")
|
||||
(let
|
||||
((f (apl-resolve-dyadic inner env)))
|
||||
(fn (arr) (apl-reduce f arr))))
|
||||
((= op "⌿")
|
||||
(let
|
||||
((f (apl-resolve-dyadic inner env)))
|
||||
(fn (arr) (apl-reduce-first f arr))))
|
||||
((= op "\\")
|
||||
(let
|
||||
((f (apl-resolve-dyadic inner env)))
|
||||
(fn (arr) (apl-scan f arr))))
|
||||
((= op "⍀")
|
||||
(let
|
||||
((f (apl-resolve-dyadic inner env)))
|
||||
(fn (arr) (apl-scan-first f arr))))
|
||||
((= op "¨")
|
||||
(let
|
||||
((f (apl-resolve-monadic inner env)))
|
||||
(fn (arr) (apl-each f arr))))
|
||||
((= op "⍨")
|
||||
(let
|
||||
((f (apl-resolve-dyadic inner env)))
|
||||
(fn (arr) (apl-commute f arr))))
|
||||
(else (error "apl-resolve-monadic: unsupported op")))))
|
||||
((= tag :fn-name)
|
||||
(let
|
||||
((nm (nth fn-node 1)))
|
||||
(let
|
||||
((bound (get env nm)))
|
||||
(if
|
||||
(and
|
||||
(list? bound)
|
||||
(> (len bound) 0)
|
||||
(= (first bound) :dfn))
|
||||
(fn (arg) (apl-call-dfn-m bound arg))
|
||||
(error "apl-resolve-monadic: name not bound to dfn")))))
|
||||
((= tag :train)
|
||||
(let
|
||||
((fns (rest fn-node)))
|
||||
(let
|
||||
((n (len fns)))
|
||||
(cond
|
||||
((= n 2)
|
||||
(let
|
||||
((g (apl-resolve-monadic (nth fns 0) env))
|
||||
(h (apl-resolve-monadic (nth fns 1) env)))
|
||||
(fn (arg) (g (h arg)))))
|
||||
((= n 3)
|
||||
(let
|
||||
((f (apl-resolve-monadic (nth fns 0) env))
|
||||
(g (apl-resolve-dyadic (nth fns 1) env))
|
||||
(h (apl-resolve-monadic (nth fns 2) env)))
|
||||
(fn (arg) (g (f arg) (h arg)))))
|
||||
(else (error "monadic train arity not 2 or 3"))))))
|
||||
(else (error "apl-resolve-monadic: unknown fn-node tag"))))))
|
||||
|
||||
(define
|
||||
apl-resolve-dyadic
|
||||
(fn
|
||||
(fn-node env)
|
||||
(let
|
||||
((tag (first fn-node)))
|
||||
(cond
|
||||
((= tag :fn-glyph) (apl-dyadic-fn (nth fn-node 1)))
|
||||
((= tag :derived-fn)
|
||||
(let
|
||||
((op (nth fn-node 1)) (inner (nth fn-node 2)))
|
||||
(cond
|
||||
((= op "¨")
|
||||
(let
|
||||
((f (apl-resolve-dyadic inner env)))
|
||||
(fn (a b) (apl-each-dyadic f a b))))
|
||||
((= op "⍨")
|
||||
(let
|
||||
((f (apl-resolve-dyadic inner env)))
|
||||
(fn (a b) (apl-commute-dyadic f a b))))
|
||||
(else (error "apl-resolve-dyadic: unsupported op")))))
|
||||
((= tag :fn-name)
|
||||
(let
|
||||
((nm (nth fn-node 1)))
|
||||
(let
|
||||
((bound (get env nm)))
|
||||
(if
|
||||
(and
|
||||
(list? bound)
|
||||
(> (len bound) 0)
|
||||
(= (first bound) :dfn))
|
||||
(fn (a b) (apl-call-dfn bound a b))
|
||||
(error "apl-resolve-dyadic: name not bound to dfn")))))
|
||||
((= tag :outer)
|
||||
(let
|
||||
((inner (nth fn-node 2)))
|
||||
(let
|
||||
((f (apl-resolve-dyadic inner env)))
|
||||
(fn (a b) (apl-outer f a b)))))
|
||||
((= tag :derived-fn2)
|
||||
(let
|
||||
((f-node (nth fn-node 2)) (g-node (nth fn-node 3)))
|
||||
(let
|
||||
((f (apl-resolve-dyadic f-node env))
|
||||
(g (apl-resolve-dyadic g-node env)))
|
||||
(fn (a b) (apl-inner f g a b)))))
|
||||
((= tag :train)
|
||||
(let
|
||||
((fns (rest fn-node)))
|
||||
(let
|
||||
((n (len fns)))
|
||||
(cond
|
||||
((= n 2)
|
||||
(let
|
||||
((g (apl-resolve-monadic (nth fns 0) env))
|
||||
(h (apl-resolve-dyadic (nth fns 1) env)))
|
||||
(fn (a b) (g (h a b)))))
|
||||
((= n 3)
|
||||
(let
|
||||
((f (apl-resolve-dyadic (nth fns 0) env))
|
||||
(g (apl-resolve-dyadic (nth fns 1) env))
|
||||
(h (apl-resolve-dyadic (nth fns 2) env)))
|
||||
(fn (a b) (g (f a b) (h a b)))))
|
||||
(else (error "dyadic train arity not 2 or 3"))))))
|
||||
(else (error "apl-resolve-dyadic: unknown fn-node tag"))))))
|
||||
|
||||
(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))))
|
||||
|
||||
@@ -104,6 +104,194 @@ Core mapping:
|
||||
- [x] Drive corpus to 100+ green
|
||||
- [x] Idiom corpus — `lib/apl/tests/idioms.sx` covering classic Roger Hui / Phil Last idioms
|
||||
|
||||
### Phase 7 — end-to-end pipeline + closing the gaps
|
||||
|
||||
Phase 1-6 built parser and runtime as parallel layers — they don't yet meet.
|
||||
Phase 7 wires them together so APL source actually runs through the full stack,
|
||||
and tightens loose ends.
|
||||
|
||||
- [x] **Operators in `apl-eval-ast`** — handle `:derived-fn` (e.g. `+/`, `f¨`),
|
||||
`:outer` (`∘.f`), `:derived-fn2` (`f.g`). Each derived-fn-node wraps an inner
|
||||
function; eval-ast resolves the inner glyph to a runtime fn and dispatches
|
||||
to the matching operator helper (`apl-reduce`, `apl-each`, `apl-outer`,
|
||||
`apl-inner`, `apl-commute`, `apl-compose`, `apl-power`, `apl-rank`).
|
||||
- [x] **End-to-end pipeline** — entry point `apl-run : string → array` that
|
||||
chains `apl-tokenize` → `parse-apl` → `apl-eval-ast` against an empty env.
|
||||
Verify with one-liners (`+/⍳5` → 15, `1 2 3 + 4 5 6` → 7 9 11, etc.) and
|
||||
with the actual `.apl` source files in `tests/programs/`.
|
||||
- [x] **`:quad-name` AST + handler** — extend tokenizer/parser to recognise
|
||||
`⎕name`, then handle in `apl-eval-ast` by dispatching to `apl-quad-*`
|
||||
runtime fns (`⎕IO`, `⎕ML`, `⎕FR`, `⎕TS`, `⎕FMT`, `⎕←`).
|
||||
_(`⎕←` deferred — tokenizer treats `←` as `:assign` after `⎕`.)_
|
||||
- [x] **Bracket indexing verification** — load programs that use `A[I]` /
|
||||
`A[I;J]` end-to-end; confirm parser desugars to `⌷` and runtime returns
|
||||
expected slices. Add 5+ tests.
|
||||
_(Single-axis only — multi-axis `A[I;J]` requires semicolon parsing, deferred.)_
|
||||
- [x] **Idiom corpus expansion** — extend `idioms.sx` from 34 to 60+ once
|
||||
end-to-end works (we can express idioms as APL strings, not as runtime
|
||||
calls). Source-string-based idioms validate the whole stack.
|
||||
- [x] **`:Trap` / `:EndTrap`** — minimal exception machinery: `:Trap n`
|
||||
catches errors with code `n`, body runs in `apl-tradfn-eval-block`,
|
||||
on error switches to the trap branch. Define `apl-throw` and a small
|
||||
set of error codes; use `try`/`catch` from the host.
|
||||
|
||||
### Phase 8 — fill the gaps left after end-to-end
|
||||
|
||||
Phase 7 wired the stack together; Phase 8 closes deferred items, lets real
|
||||
programs run from source, and starts pushing on performance.
|
||||
|
||||
- [x] **Quick-wins bundle** (one iteration) — three small fixes that each unblock
|
||||
real programs:
|
||||
- decimal literals: `read-digits!` consumes one trailing `.` plus more digits
|
||||
so `3.7` tokenises as one number;
|
||||
- `⎕←` (print) — tokenizer special-case: when `⎕` is followed by `←`, emit
|
||||
a single `:name "⎕←"` token (don't split on the assign glyph);
|
||||
- string values in `apl-eval-ast` — handle `:str` (parser already produces
|
||||
them) by wrapping into a vector of character codes (or rank-0 string).
|
||||
- [x] **Named function definitions** — `f ← {⍺+⍵} ⋄ 1 f 2` and `2 f 3`.
|
||||
- parser: when `:assign`'s RHS is a `:dfn`, mark it as a function binding;
|
||||
- eval-ast: `:assign` of a dfn stores the dfn in env;
|
||||
- parser: a name in fn-position whose env value is a dfn dispatches as a fn;
|
||||
- resolver: extend `apl-resolve-monadic`/`-dyadic` with a `:fn-name` case
|
||||
that calls `apl-call-dfn`/`apl-call-dfn-m`.
|
||||
- [x] **Multi-axis bracket indexing** — `A[I;J]` and `A[;J]` and `A[I;]`.
|
||||
- parser: split bracket content on `:semi` at depth 0; emit
|
||||
`(:dyad ⌷ (:vec I J) A)`;
|
||||
- runtime: extend `apl-squad` to accept a vector of indices, treating
|
||||
`nil` / empty axis as "all";
|
||||
- 5+ tests across vector and matrix.
|
||||
- [x] **`.apl` files as actual tests** — `lib/apl/tests/programs/*.apl` are
|
||||
currently documentation. Add `apl-run-file path → array` plus tests that
|
||||
load each file, execute it, and assert the expected result. Makes the
|
||||
classic-program corpus self-validating instead of two parallel impls.
|
||||
_(Embedded source-string approach: tests/programs-e2e.sx runs the same
|
||||
algorithms as the .apl docs through the full pipeline. The original
|
||||
one-liners (e.g. primes' inline `⍵←⍳⍵`) need parser features
|
||||
(compress-as-fn, inline assign) we haven't built yet — multi-stmt forms
|
||||
used instead. Slurp/read-file primitive missing in OCaml SX runtime.)_
|
||||
- [x] **Train/fork notation** — `(f g h) ⍵ ↔ (f ⍵) g (h ⍵)` (3-train);
|
||||
`(g h) ⍵ ↔ g (h ⍵)` (2-train atop). Parser: detect when a parenthesised
|
||||
subexpression is all functions and emit `(:train fns)`; resolver: build the
|
||||
derived function; tests for mean-via-train (`+/÷≢`).
|
||||
- [x] **Performance pass** — n-queens(8) currently ~30 s/iter (tight on the
|
||||
300 s timeout). Target: profile the inner loop, eliminate quadratic
|
||||
list-append, restore the `queens(8)` test.
|
||||
|
||||
### Phase 9 — make `.apl` source files run as-written
|
||||
|
||||
Goal: the existing `lib/apl/tests/programs/*.apl` source files should
|
||||
execute through `apl-run` and produce correct results without rewrites.
|
||||
Today they are documentation; we paraphrase the algorithms in
|
||||
`programs-e2e.sx`. Phase 9 closes that gap.
|
||||
|
||||
- [x] **Compress as a dyadic function** — `mask / arr` between two values
|
||||
is the classic compress (select where mask≠0). Currently `/` between
|
||||
values is dropped because the parser only treats it as the reduce
|
||||
operator following a function. Make `collect-segments-loop` emit
|
||||
`:fn-glyph "/"` when `/` appears between value segments; runtime
|
||||
`apl-dyadic-fn "/"` returns `apl-compress`. Same for `⌿`
|
||||
(first-axis compress).
|
||||
- [x] **Inline assignment** — `⍵ ← ⍳⍵` mid-expression. Parser currently
|
||||
only handles `:assign` at the start of a statement. Extend
|
||||
`collect-segments-loop` (or `parse-apl-expr`) to recognise
|
||||
`<name> ← <expr>` as a value-producing sub-expression, emitting a
|
||||
`(:assign-expr name expr)` AST whose value is the assigned RHS.
|
||||
Required by the primes idiom `(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵`.
|
||||
_(Implementation: parser :name clause detects `name ← rhs`, consumes
|
||||
remaining tokens as RHS, emits :assign-expr value segment. Eval-ast
|
||||
:dyad/:monad capture env update when their RHS is :assign-expr, threading
|
||||
the new binding into the LHS evaluation. Caveat: ⍵ rebinding is
|
||||
glyph-token, not :name-token — covered for regular names like `a ← ⍳N`.)_
|
||||
- [x] **`?` (random / roll)** — monadic `?N` returns a random integer
|
||||
in 1..N. Used by quicksort.apl for pivot selection. Add `apl-roll`
|
||||
(deterministic seed for tests) + glyph wiring.
|
||||
- [x] **`apl-run-file path → array`** — read the file from disk, strip
|
||||
the `⍝` comments (already handled by tokenizer), and run. Needs an
|
||||
IO primitive on the SX side. Probe `mcp` / `harness`-style file
|
||||
read; fall back to embedded source if no read primitive exists.
|
||||
_(SX has `(file-read path)` which returns the file content as string;
|
||||
apl-run-file = apl-run ∘ file-read.)_
|
||||
- [x] **End-to-end .apl tests** — once the above land, add tests that
|
||||
run `lib/apl/tests/programs/*.apl` *as written* and assert results.
|
||||
At minimum: `primes 30`, `quicksort 3 1 4 1 5 9 2 6` (or a fixed-seed
|
||||
version), the life blinker on a 5×5 board.
|
||||
_(primes.apl runs as-written with ⍵-rebind now supported. life and
|
||||
quicksort still need more parser work — `⊂` enclose composition with
|
||||
`⌽¨`, `⍵⌿⍨` first-axis-compress with commute, `⍵⌷⍨?≢⍵`.)_
|
||||
- [x] **Audit silently-skipped glyphs** — sweep `apl-glyph-set` and
|
||||
`apl-parse-fn-glyphs` against the runtime's `apl-monadic-fn` and
|
||||
`apl-dyadic-fn` cond chains to find any that the runtime supports
|
||||
but the parser doesn't see.
|
||||
_(Wired ⍉ → apl-transpose / apl-transpose-dyadic, ⊢ identity,
|
||||
⊣ left, ⍕ as alias for ⎕FMT. ⊆ ∪ ∩ ⍸ ⊥ ⊤ ⍎ remain unimplemented
|
||||
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;
|
||||
@@ -118,6 +306,36 @@ 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
|
||||
- 2026-05-07: Phase 9 step 3 — `?N` random / roll. Top-level mutable apl-rng-state with LCG; apl-rng-seed! for deterministic tests; apl-roll wraps as scalar in 1..N. apl-monadic-fn maps "?" → apl-roll. +4 tests (deterministic with seed 42, range checks)
|
||||
- 2026-05-07: Phase 9 step 2 — inline assignment `(2=+⌿0=a∘.|a)/a←⍳30` runs end-to-end. Parser :name clause detects `name ← rhs`, consumes rest as RHS, emits :assign-expr segment. Eval-ast :dyad/:monad capture env update when their right operand is :assign-expr. +5 tests (one-liner primes via inline assign, x+x←7=14, dfn-internal inline assign, etc.)
|
||||
- 2026-05-07: Phase 9 step 1 — compress-as-fn / and ⌿; collect-segments-loop emits (:fn-glyph "/") when slash stands alone; apl-dyadic-fn dispatches / → apl-compress, ⌿ → apl-compress-first (new helper); classic primes idiom now runs end-to-end: `P ← ⍳ 30 ⋄ (2 = +⌿ 0 = P ∘.| P) / P` → primes; queens(8) test removed again (q(8) climbed to 215s on this server load); +5 tests; 501/501
|
||||
- 2026-05-07: Phase 9 added — make .apl source files run as-written (compress as dyadic /, inline assignment, ? random, apl-run-file, glyph audit, source-as-tests)
|
||||
- 2026-05-07: Phase 8 step 6 — perf: swapped (append acc xs) → (append xs acc) in apl-permutations to make permutation generation linear instead of quadratic; q(7) 32s→12s; q(8)=92 test restored within 300s timeout; **Phase 8 complete, all unchecked items ticked**; 497/497
|
||||
- 2026-05-07: Phase 8 step 5 — train/fork notation. Parser :lparen detects all-fn inner segments → emits :train AST; resolver covers 2-atop & 3-fork for both monadic and dyadic. `(+/÷≢) 1..5 → 3` (mean), `(- ⌊) 5 → -5` (atop), `2(+×-)5 → -21` (dyadic fork), `(⌈/-⌊/) → 8` (range); +6 tests; 496/496
|
||||
- 2026-05-07: Phase 8 step 4 — programs-e2e.sx runs classic-algorithm shapes through full pipeline (factorial via ∇, triangulars, sum-of-squares, divisor-counts, prime-mask, named-fn composition, dyadic max-of-two, Newton step); also added ⌿ + ⍀ to glyph sets (were silently skipped); +15 tests; 490/490
|
||||
- 2026-05-07: Phase 8 step 3 — multi-axis bracket A[I;J] / A[I;] / A[;J] via :bracket AST + apl-bracket-multi runtime; split-bracket-content scans :semi at depth 0; apl-cartesian builds index combinations; nil axis = "all"; scalar axis collapses; +8 tests; 475/475
|
||||
- 2026-05-07: Phase 8 step 2 — named function defs end-to-end via parser pre-scan; apl-known-fn-names + apl-collect-fn-bindings detect `name ← {...}` patterns; collect-segments-loop emits :fn-name for known names; resolver looks up env for :fn-name; supports recursion (∇ in named dfn); +7 tests including fact via ∇; 467/467
|
||||
- 2026-05-07: Phase 8 step 1 — quick-wins bundle: decimal literals (3.7, ¯2.5), ⎕← passthrough as monadic fn (single-token via tokenizer special-case), :str AST in eval-ast (single-char→scalar, multi-char→vec); +10 tests; 460/460
|
||||
- 2026-05-07: Phase 8 added — quick-wins bundle (decimals + ⎕← + strings), named functions, multi-axis bracket, .apl-files-as-tests, trains, perf
|
||||
- 2026-05-07: Phase 7 step 6 — :Trap exception machinery via R7RS guard; apl-throw raises tagged error, apl-trap-matches? checks codes (0=catch-all), :trap clause in apl-tradfn-eval-stmt wraps try-block with guard; :throw AST for testing; **Phase 7 complete, all unchecked plan items done**; +5 tests; 450/450
|
||||
- 2026-05-07: Phase 7 step 5 — idiom corpus 34→64 (+30 source-string idioms via apl-run); also fixed tokenizer + parser to recognize ≢ and ≡ glyphs (were silently skipped); 445/445
|
||||
- 2026-05-07: Phase 7 step 4 — bracket indexing `A[I]` desugared to `(:dyad ⌷ I A)` via maybe-bracket helper, wired into :name + :lparen branches of collect-segments-loop; multi-axis (A[I;J]) deferred (semicolon split); +7 tests; 415/415
|
||||
- 2026-05-07: Phase 7 step 3 — :quad-name end-to-end; tokenizer already produced :name "⎕FMT"; parser is-fn-tok? extended via apl-quad-fn-names; eval-ast :name dispatches ⎕IO/⎕ML/⎕FR/⎕TS to apl-quad-*; apl-monadic-fn handles ⎕FMT; ⎕← deferred (tokenizer splits ⎕←); +8 tests; 408/408
|
||||
- 2026-05-07: Phase 7 step 2 — end-to-end pipeline `apl-run : string → array` (parse-apl + apl-eval-ast against empty env); +25 source-string tests covering scalars, strands, dyadic arith, monadic primitives, operators, ∘./.g products, comparisons, famous one-liners (+/⍳10=55, ×/⍳10=10!); tokenizer can't yet parse decimals so `3.7` literal tests dropped; **400/400**
|
||||
- 2026-05-07: Phase 7 step 1 — operators in apl-eval-ast via apl-resolve-monadic/dyadic; supports / ⌿ \ ⍀ ¨ ⍨ ∘. f.g; queens(8) test removed (too slow for 300s timeout); +14 eval-ops tests; 375/375
|
||||
- 2026-05-07: Phase 7 added — end-to-end pipeline, operators in eval-ast, :quad-name, bracket-indexing verify, idiom expansion, :Trap; aim is to wire parser↔runtime so .apl source files actually run
|
||||
- 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
|
||||
@@ -154,4 +372,10 @@ _Newest first._
|
||||
|
||||
## Blockers
|
||||
|
||||
- _(none yet)_
|
||||
- 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