5 Commits

Author SHA1 Message Date
a14fe05632 apl: tick Phase 2 checkboxes + progress log
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-26 14:25:17 +00:00
4f4b735958 apl: array model + scalar primitives Phase 2 (+82 tests)
Implement lib/apl/runtime.sx — APL array model and scalar primitive library:
- make-array/apl-scalar/apl-vector/enclose/disclose constructors
- array-rank/scalar?/array-ref accessors; apl-io=1 (⎕IO default)
- broadcast-monadic/broadcast-dyadic engine (scalar↔scalar, scalar↔array, array↔array)
- Arithmetic: + - × ÷ ⌈ ⌊ * ⍟ | ! ○ (all monadic+dyadic per APL convention)
- Comparison: < ≤ = ≥ > ≠ (return 0/1)
- Logical: ~ ∧ ∨ ⍱ ⍲
- Shape: ⍴ (apl-shape), , (apl-ravel), ≢ (apl-tally), ≡ (apl-depth)
- ⍳ (apl-iota) with ⎕IO=1 — vector 1..n

82 tests in lib/apl/tests/scalar.sx covering all primitive groups;
includes lists-eq helper for ListRef-aware comparison.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-26 14:24:49 +00:00
da8ba104a6 apl: right-to-left parser + 44 tests (Phase 1, step 2)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 17s
Implement lib/apl/parser.sx — APL expression parser:
- Segment-based algorithm: scan L→R collecting {fn,val} segments
- build-tree constructs AST with leftmost-fn = root (right-to-left semantics)
- Handles: monadic/dyadic fns, strands (:vec), assignment (:assign)
- Operators: derived-fn (:derived-fn op fn), inner product (:derived-fn2)
- Outer product ∘.f (:outer), dfns {:dfn stmt...}, guards (:guard cond expr)
- split-statements is bracket-aware (depth tracking prevents splitting inside {})

44 new parser tests + 46 existing tokenizer = 90/90 green.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-26 14:05:43 +00:00
dbba2fe418 apl: tick Phase 1 tokenizer checkbox + progress log
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 11s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 18:23:06 +00:00
c73b696494 apl: tokenizer + 46 tests (Phase 1, step 1)
Unicode-aware byte scanner using starts-with?/consume! for multi-byte
APL glyphs. Handles numbers (¯-negative), string literals, identifiers
(⎕ system names), all APL function/operator glyphs, :Keywords,
comments ⍝, diamond ⋄, assignment ←.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 18:22:30 +00:00
13 changed files with 1695 additions and 1137 deletions

436
lib/apl/parser.sx Normal file
View File

@@ -0,0 +1,436 @@
; APL Parser — right-to-left expression parser
;
; Takes a token list (output of apl-tokenize) and produces an AST.
; APL evaluates right-to-left with no precedence among functions.
; Operators bind to the function immediately to their left in the source.
;
; AST node types:
; (:num n) number literal
; (:str s) string literal
; (:vec n1 n2 ...) strand (juxtaposed literals)
; (:name "x") name reference / alpha / omega
; (:assign "x" expr) assignment x←expr
; (:monad fn arg) monadic function call
; (:dyad fn left right) dyadic function call
; (:derived-fn op fn) derived function: f/ f¨ f⍨
; (:derived-fn2 "." f g) inner product: f.g
; (:outer "∘." fn) outer product: ∘.f
; (:fn-glyph "") function reference
; (:fn-name "foo") named-function reference (dfn variable)
; (:dfn stmt...) {+⍵} anonymous function
; (:guard cond expr) cond:expr guard inside dfn
; (:program stmt...) multi-statement sequence
; ============================================================
; Glyph classification sets
; ============================================================
(define apl-parse-op-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-parse-fn-glyph?
(fn (v)
(some (fn (g) (= g v)) apl-parse-fn-glyphs)))
; ============================================================
; Token accessors
; ============================================================
(define tok-type
(fn (tok)
(get tok :type)))
(define tok-val
(fn (tok)
(get tok :value)))
(define is-op-tok?
(fn (tok)
(and (= (tok-type tok) :glyph)
(apl-parse-op-glyph? (tok-val tok)))))
(define is-fn-tok?
(fn (tok)
(and (= (tok-type tok) :glyph)
(apl-parse-fn-glyph? (tok-val tok)))))
; ============================================================
; 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 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})))))
; ============================================================
; 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)))))
; ============================================================
; 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 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)))))))
; ============================================================
; Segment collection: scan tokens left-to-right, building
; a list of {:kind "val"/"fn" :node ast} segments.
; Operators following function glyphs are merged into
; derived-fn nodes during this pass.
; ============================================================
(define collect-segments
(fn (tokens)
(collect-segments-loop tokens 0 (list))))
(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))))))))
; ============================================================
; Build tree from segment list
;
; The segments are in left-to-right order.
; APL evaluates right-to-left, so the LEFTMOST function is
; the outermost (last-evaluated) node.
;
; Patterns:
; [val] → val node
; [fn val ...] → (:monad fn (build-tree rest))
; [val fn val ...] → (:dyad fn val (build-tree rest))
; [val val ...] → (:vec val1 val2 ...) — strand
; ============================================================
; 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-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))))))
; 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 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))))))))))
; ============================================================
; Split token list on statement separators (diamond / newline)
; Only splits at depth 0 (ignores separators inside { } or ( ) )
; ============================================================
(define split-statements
(fn (tokens)
(split-statements-loop tokens (list) (list) 0)))
(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)))))))
; ============================================================
; 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 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 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))))
(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)))))))
; ============================================================
; 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))))
; ============================================================
; 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)))))
; ============================================================
; 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))))))))

349
lib/apl/runtime.sx Normal file
View File

@@ -0,0 +1,349 @@
; APL Runtime — array model + scalar primitives
;
; Array = SX dict {:shape (d1 d2 ...) :ravel (v1 v2 ...)}
; Scalar: rank 0, shape (), one element in ravel
; Vector: rank 1, shape (n), n elements in ravel
; Matrix: rank 2, shape (r c), r*c elements in ravel
; ============================================================
; Array constructors
; ============================================================
(define make-array (fn (shape ravel) {:ravel ravel :shape shape}))
(define apl-scalar (fn (v) {:ravel (list v) :shape (list)}))
(define apl-vector (fn (elems) {:ravel elems :shape (list (len elems))}))
; enclose — wrap any value in a rank-0 box
(define enclose (fn (v) (apl-scalar v)))
; disclose — unwrap rank-0 box, returning the first element
(define disclose (fn (arr) (first (get arr :ravel))))
; ============================================================
; Array accessors
; ============================================================
(define array-rank (fn (arr) (len (get arr :shape))))
(define scalar? (fn (arr) (= (len (get arr :shape)) 0)))
(define array-ref (fn (arr i) (nth (get arr :ravel) i)))
; ============================================================
; System variables
; ============================================================
(define apl-io 1)
; ============================================================
; Broadcast engine
; ============================================================
(define
broadcast-monadic
(fn (f arr) (make-array (get arr :shape) (map f (get arr :ravel)))))
(define
broadcast-dyadic
(fn
(f a b)
(cond
((and (scalar? a) (scalar? b))
(apl-scalar (f (first (get a :ravel)) (first (get b :ravel)))))
((scalar? a)
(let
((sv (first (get a :ravel))))
(make-array
(get b :shape)
(map (fn (x) (f sv x)) (get b :ravel)))))
((scalar? b)
(let
((sv (first (get b :ravel))))
(make-array
(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"))))))
; ============================================================
; Arithmetic primitives
; ============================================================
; Monadic + : identity
(define apl-plus-m (fn (a) (broadcast-monadic (fn (x) x) a)))
; Dyadic +
(define apl-add (fn (a b) (broadcast-dyadic (fn (x y) (+ x y)) a b)))
; Monadic - : negate
(define apl-neg-m (fn (a) (broadcast-monadic (fn (x) (- 0 x)) a)))
; Dyadic -
(define apl-sub (fn (a b) (broadcast-dyadic (fn (x y) (- x y)) a b)))
; Monadic × : signum
(define
apl-signum
(fn
(a)
(broadcast-monadic
(fn (x) (cond ((> x 0) 1) ((< x 0) -1) (else 0)))
a)))
; Dyadic ×
(define apl-mul (fn (a b) (broadcast-dyadic (fn (x y) (* x y)) a b)))
; Monadic ÷ : reciprocal
(define apl-recip (fn (a) (broadcast-monadic (fn (x) (/ 1 x)) a)))
; Dyadic ÷
(define apl-div (fn (a b) (broadcast-dyadic (fn (x y) (/ x y)) a b)))
; Monadic ⌈ : ceiling
(define apl-ceil (fn (a) (broadcast-monadic (fn (x) (ceil x)) a)))
; Dyadic ⌈ : max
(define
apl-max
(fn (a b) (broadcast-dyadic (fn (x y) (if (>= x y) x y)) a b)))
; Monadic ⌊ : floor
(define apl-floor (fn (a) (broadcast-monadic (fn (x) (floor x)) a)))
; Dyadic ⌊ : min
(define
apl-min
(fn (a b) (broadcast-dyadic (fn (x y) (if (<= x y) x y)) a b)))
; Monadic * : e^x
(define apl-exp (fn (a) (broadcast-monadic (fn (x) (exp x)) a)))
; Dyadic * : power
(define apl-pow (fn (a b) (broadcast-dyadic (fn (x y) (pow x y)) a b)))
; Monadic ⍟ : natural log
(define apl-ln (fn (a) (broadcast-monadic (fn (x) (log x)) a)))
; Dyadic ⍟ : log base (a⍟b = log base a of b)
(define
apl-log
(fn (a b) (broadcast-dyadic (fn (x y) (/ (log y) (log x))) a b)))
; Monadic | : absolute value
(define
apl-abs
(fn (a) (broadcast-monadic (fn (x) (if (< x 0) (- 0 x) x)) a)))
; Dyadic | : modulo (a|b = b mod a)
(define
apl-mod
(fn
(a b)
(broadcast-dyadic
(fn (x y) (if (= x 0) y (- y (* x (floor (/ y x))))))
a
b)))
; Monadic ! : factorial
(define
apl-fact
(fn
(a)
(broadcast-monadic
(fn
(n)
(let
((loop nil))
(begin
(set!
loop
(fn (i acc) (if (> i n) acc (loop (+ i 1) (* acc i)))))
(loop 1 1))))
a)))
; Dyadic ! : binomial coefficient n!k (a=n, b=k => a choose b)
(define
apl-binomial
(fn
(a b)
(broadcast-dyadic
(fn
(n k)
(let
((loop nil))
(begin
(set!
loop
(fn
(i num den)
(if
(> i k)
(/ num den)
(loop (+ i 1) (* num (- (+ n 1) i)) (* den i)))))
(loop 1 1 1))))
a
b)))
; Monadic ○ : pi times x
(define
apl-pi-times
(fn (a) (broadcast-monadic (fn (x) (* 3.14159 x)) a)))
; Dyadic ○ : trig functions (a○b, a=code, b=value)
(define
apl-trig
(fn
(a b)
(broadcast-dyadic
(fn
(n x)
(cond
((= n 0) (pow (- 1 (* x x)) 0.5))
((= n 1) (sin x))
((= n 2) (cos x))
((= n 3) (tan x))
((= n -1) (asin x))
((= n -2) (acos x))
((= n -3) (atan x))
(else (error "circle: unsupported trig code"))))
a
b)))
; ============================================================
; Comparison primitives (return 0 or 1)
; ============================================================
(define
apl-lt
(fn (a b) (broadcast-dyadic (fn (x y) (if (< x y) 1 0)) a b)))
(define
apl-le
(fn (a b) (broadcast-dyadic (fn (x y) (if (<= x y) 1 0)) a b)))
(define
apl-eq
(fn (a b) (broadcast-dyadic (fn (x y) (if (= x y) 1 0)) a b)))
(define
apl-ge
(fn (a b) (broadcast-dyadic (fn (x y) (if (>= x y) 1 0)) a b)))
(define
apl-gt
(fn (a b) (broadcast-dyadic (fn (x y) (if (> x y) 1 0)) a b)))
(define
apl-ne
(fn (a b) (broadcast-dyadic (fn (x y) (if (= x y) 0 1)) a b)))
; ============================================================
; Logical primitives
; ============================================================
; Monadic ~ : logical not
(define
apl-not
(fn (a) (broadcast-monadic (fn (x) (if (= x 0) 1 0)) a)))
; Dyadic ∧ : logical and
(define
apl-and
(fn
(a b)
(broadcast-dyadic
(fn (x y) (if (and (not (= x 0)) (not (= y 0))) 1 0))
a
b)))
; Dyadic : logical or
(define
apl-or
(fn
(a b)
(broadcast-dyadic
(fn (x y) (if (or (not (= x 0)) (not (= y 0))) 1 0))
a
b)))
; Dyadic ⍱ : logical nor
(define
apl-nor
(fn
(a b)
(broadcast-dyadic
(fn (x y) (if (or (not (= x 0)) (not (= y 0))) 0 1))
a
b)))
; Dyadic ⍲ : logical nand
(define
apl-nand
(fn
(a b)
(broadcast-dyadic
(fn (x y) (if (and (not (= x 0)) (not (= y 0))) 0 1))
a
b)))
; ============================================================
; Shape primitives
; ============================================================
; Monadic : shape — returns shape as a vector array
(define apl-shape (fn (arr) (apl-vector (get arr :shape))))
; Monadic , : ravel — returns a rank-1 vector of all elements
(define apl-ravel (fn (arr) (apl-vector (get arr :ravel))))
; Monadic ≢ : tally — first dimension (1 for scalar)
(define
apl-tally
(fn
(arr)
(if
(scalar? arr)
(apl-scalar 1)
(apl-scalar (first (get arr :shape))))))
; Monadic ≡ : depth
; simple number/string value → 0
; array containing only non-arrays → 0
; array containing arrays → 1 + max depth of elements
(define
apl-depth
(fn
(arr)
(define item-depth nil)
(set!
item-depth
(fn
(v)
(if
(and
(dict? v)
(not (= nil (get v :shape nil)))
(not (= nil (get v :ravel nil))))
(+ 1 (first (get (apl-depth v) :ravel)))
0)))
(let
((depths (map item-depth (get arr :ravel))))
(apl-scalar (reduce (fn (a b) (if (> a b) a b)) 0 depths)))))
; Monadic : iota — vector 1..n (with ⎕IO=1)
(define
apl-iota
(fn
(n-arr)
(let
((n (first (get n-arr :ravel))) (build nil))
(begin
(set!
build
(fn (i acc) (if (< i 1) acc (build (- i 1) (cons i acc)))))
(apl-vector (build n (list)))))))

340
lib/apl/tests/parse.sx Normal file
View File

@@ -0,0 +1,340 @@
(define apl-test-count 0)
(define apl-test-pass 0)
(define apl-test-fails (list))
(define apl-test
(fn (name actual expected)
(begin
(set! apl-test-count (+ apl-test-count 1))
(if (= actual expected)
(set! apl-test-pass (+ apl-test-pass 1))
(append! apl-test-fails {:name name :actual actual :expected expected})))))
(define tok-types
(fn (src)
(map (fn (t) (get t :type)) (apl-tokenize src))))
(define tok-values
(fn (src)
(map (fn (t) (get t :value)) (apl-tokenize src))))
(define tok-count
(fn (src)
(len (apl-tokenize src))))
(define tok-type-at
(fn (src i)
(get (nth (apl-tokenize src) i) :type)))
(define tok-value-at
(fn (src i)
(get (nth (apl-tokenize src) i) :value)))
(apl-test "empty: no tokens" (tok-count "") 0)
(apl-test "empty: whitespace only" (tok-count " ") 0)
(apl-test "num: zero" (tok-values "0") (list 0))
(apl-test "num: positive" (tok-values "42") (list 42))
(apl-test "num: large" (tok-values "12345") (list 12345))
(apl-test "num: negative" (tok-values "¯5") (list -5))
(apl-test "num: negative zero" (tok-values "¯0") (list 0))
(apl-test "num: strand count" (tok-count "1 2 3") 3)
(apl-test "num: strand types" (tok-types "1 2 3") (list :num :num :num))
(apl-test "num: strand values" (tok-values "1 2 3") (list 1 2 3))
(apl-test "num: neg in strand" (tok-values "1 ¯2 3") (list 1 -2 3))
(apl-test "str: empty" (tok-values "''") (list ""))
(apl-test "str: single char" (tok-values "'a'") (list "a"))
(apl-test "str: word" (tok-values "'hello'") (list "hello"))
(apl-test "str: escaped quote" (tok-values "''''") (list "'"))
(apl-test "str: type" (tok-types "'abc'") (list :str))
(apl-test "name: simple" (tok-values "foo") (list "foo"))
(apl-test "name: type" (tok-types "foo") (list :name))
(apl-test "name: mixed case" (tok-values "MyVar") (list "MyVar"))
(apl-test "name: with digits" (tok-values "x1") (list "x1"))
(apl-test "name: system var" (tok-values "⎕IO") (list "⎕IO"))
(apl-test "name: system var type" (tok-types "⎕IO") (list :name))
(apl-test "glyph: plus" (tok-types "+") (list :glyph))
(apl-test "glyph: plus value" (tok-values "+") (list "+"))
(apl-test "glyph: iota" (tok-values "") (list ""))
(apl-test "glyph: reduce" (tok-values "+/") (list "+" "/"))
(apl-test "glyph: floor" (tok-values "⌊") (list "⌊"))
(apl-test "glyph: rho" (tok-values "") (list ""))
(apl-test "glyph: alpha omega" (tok-types " ⍵") (list :glyph :glyph))
(apl-test "punct: lparen" (tok-types "(") (list :lparen))
(apl-test "punct: rparen" (tok-types ")") (list :rparen))
(apl-test "punct: brackets" (tok-types "[42]") (list :lbracket :num :rbracket))
(apl-test "punct: braces" (tok-types "{}") (list :lbrace :rbrace))
(apl-test "punct: semi" (tok-types ";") (list :semi))
(apl-test "assign: arrow" (tok-types "x←1") (list :name :assign :num))
(apl-test "diamond: separator" (tok-types "1⋄2") (list :num :diamond :num))
(apl-test "newline: emitted" (tok-types "1\n2") (list :num :newline :num))
(apl-test "comment: skipped" (tok-count "⍝ ignore me") 0)
(apl-test "comment: rest ignored" (tok-count "1 ⍝ note") 1)
(apl-test "colon: bare" (tok-types ":") (list :colon))
(apl-test "keyword: If" (tok-values ":If") (list ":If"))
(apl-test "keyword: type" (tok-types ":While") (list :keyword))
(apl-test "keyword: EndFor" (tok-values ":EndFor") (list ":EndFor"))
(apl-test "expr: +/ 5" (tok-types "+/ 5") (list :glyph :glyph :glyph :num))
(apl-test "expr: x←42" (tok-count "x←42") 3)
(apl-test "expr: dfn body" (tok-types "{+⍵}")
(list :lbrace :glyph :glyph :glyph :rbrace))
(define apl-tokenize-test-summary
(str "tokenizer " apl-test-pass "/" apl-test-count
(if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails))))
; ===========================================================================
; Parser tests
; ===========================================================================
; Helper: parse an APL source string and return the AST
(define parse
(fn (src) (parse-apl src)))
; Helper: build an expected AST node using keyword-tagged lists
(define num-node (fn (n) (list :num n)))
(define str-node (fn (s) (list :str s)))
(define name-node (fn (n) (list :name n)))
(define fn-node (fn (g) (list :fn-glyph g)))
(define fn-nm (fn (n) (list :fn-name n)))
(define assign-node (fn (nm expr) (list :assign nm expr)))
(define monad-node (fn (f a) (list :monad f a)))
(define dyad-node (fn (f l r) (list :dyad f l r)))
(define derived-fn (fn (op f) (list :derived-fn op f)))
(define derived-fn2 (fn (op f g) (list :derived-fn2 op f g)))
(define outer-node (fn (f) (list :outer "∘." f)))
(define guard-node (fn (c e) (list :guard c e)))
; ---- numeric literals ----
(apl-test "parse: num literal"
(parse "42")
(num-node 42))
(apl-test "parse: negative num"
(parse "¯3")
(num-node -3))
(apl-test "parse: zero"
(parse "0")
(num-node 0))
; ---- string literals ----
(apl-test "parse: str literal"
(parse "'hello'")
(str-node "hello"))
(apl-test "parse: empty str"
(parse "''")
(str-node ""))
; ---- name reference ----
(apl-test "parse: name"
(parse "x")
(name-node "x"))
(apl-test "parse: system name"
(parse "⎕IO")
(name-node "⎕IO"))
; ---- strands (vec nodes) ----
(apl-test "parse: strand 3 nums"
(parse "1 2 3")
(list :vec (num-node 1) (num-node 2) (num-node 3)))
(apl-test "parse: strand 2 nums"
(parse "1 2")
(list :vec (num-node 1) (num-node 2)))
(apl-test "parse: strand with negatives"
(parse "1 ¯2 3")
(list :vec (num-node 1) (num-node -2) (num-node 3)))
; ---- assignment ----
(apl-test "parse: assignment"
(parse "x←42")
(assign-node "x" (num-node 42)))
(apl-test "parse: assignment with spaces"
(parse "x ← 42")
(assign-node "x" (num-node 42)))
(apl-test "parse: assignment of expr"
(parse "r←2+3")
(assign-node "r" (dyad-node (fn-node "+") (num-node 2) (num-node 3))))
; ---- monadic functions ----
(apl-test "parse: monadic iota"
(parse "5")
(monad-node (fn-node "") (num-node 5)))
(apl-test "parse: monadic iota with space"
(parse " 5")
(monad-node (fn-node "") (num-node 5)))
(apl-test "parse: monadic negate"
(parse "-3")
(monad-node (fn-node "-") (num-node 3)))
(apl-test "parse: monadic floor"
(parse "⌊2")
(monad-node (fn-node "⌊") (num-node 2)))
(apl-test "parse: monadic of name"
(parse "x")
(monad-node (fn-node "") (name-node "x")))
; ---- dyadic functions ----
(apl-test "parse: dyadic plus"
(parse "2+3")
(dyad-node (fn-node "+") (num-node 2) (num-node 3)))
(apl-test "parse: dyadic times"
(parse "2×3")
(dyad-node (fn-node "×") (num-node 2) (num-node 3)))
(apl-test "parse: dyadic with names"
(parse "x+y")
(dyad-node (fn-node "+") (name-node "x") (name-node "y")))
; ---- right-to-left evaluation ----
(apl-test "parse: right-to-left 2×3+4"
(parse "2×3+4")
(dyad-node (fn-node "×") (num-node 2)
(dyad-node (fn-node "+") (num-node 3) (num-node 4))))
(apl-test "parse: right-to-left chain"
(parse "1+2×3-4")
(dyad-node (fn-node "+") (num-node 1)
(dyad-node (fn-node "×") (num-node 2)
(dyad-node (fn-node "-") (num-node 3) (num-node 4)))))
; ---- parenthesized subexpressions ----
(apl-test "parse: parens override order"
(parse "(2+3)×4")
(dyad-node (fn-node "×")
(dyad-node (fn-node "+") (num-node 2) (num-node 3))
(num-node 4)))
(apl-test "parse: nested parens"
(parse "((2+3))")
(dyad-node (fn-node "+") (num-node 2) (num-node 3)))
(apl-test "parse: paren in dyadic right"
(parse "2×(3+4)")
(dyad-node (fn-node "×") (num-node 2)
(dyad-node (fn-node "+") (num-node 3) (num-node 4))))
; ---- operators → derived functions ----
(apl-test "parse: reduce +"
(parse "+/x")
(monad-node (derived-fn "/" (fn-node "+")) (name-node "x")))
(apl-test "parse: reduce iota"
(parse "+/5")
(monad-node (derived-fn "/" (fn-node "+"))
(monad-node (fn-node "") (num-node 5))))
(apl-test "parse: scan"
(parse "+\\x")
(monad-node (derived-fn "\\" (fn-node "+")) (name-node "x")))
(apl-test "parse: each"
(parse "¨x")
(monad-node (derived-fn "¨" (fn-node "")) (name-node "x")))
(apl-test "parse: commute"
(parse "-⍨3")
(monad-node (derived-fn "⍨" (fn-node "-")) (num-node 3)))
(apl-test "parse: stacked ops"
(parse "+/¨x")
(monad-node (derived-fn "¨" (derived-fn "/" (fn-node "+"))) (name-node "x")))
; ---- outer product ----
(apl-test "parse: outer product monadic"
(parse "∘.×")
(outer-node (fn-node "×")))
(apl-test "parse: outer product dyadic names"
(parse "x ∘.× y")
(dyad-node (outer-node (fn-node "×")) (name-node "x") (name-node "y")))
(apl-test "parse: outer product dyadic strands"
(parse "1 2 3 ∘.× 4 5 6")
(dyad-node (outer-node (fn-node "×"))
(list :vec (num-node 1) (num-node 2) (num-node 3))
(list :vec (num-node 4) (num-node 5) (num-node 6))))
; ---- inner product ----
(apl-test "parse: inner product"
(parse "+.×")
(derived-fn2 "." (fn-node "+") (fn-node "×")))
(apl-test "parse: inner product applied"
(parse "a +.× b")
(dyad-node (derived-fn2 "." (fn-node "+") (fn-node "×"))
(name-node "a") (name-node "b")))
; ---- dfn (anonymous function) ----
(apl-test "parse: simple dfn"
(parse "{+⍵}")
(list :dfn (dyad-node (fn-node "+") (name-node "") (name-node "⍵"))))
(apl-test "parse: monadic dfn"
(parse "{⍵×2}")
(list :dfn (dyad-node (fn-node "×") (name-node "⍵") (num-node 2))))
(apl-test "parse: dfn self-ref"
(parse "{⍵≤1:1 ⋄ ⍵×∇ ⍵-1}")
(list :dfn
(guard-node (dyad-node (fn-node "≤") (name-node "⍵") (num-node 1)) (num-node 1))
(dyad-node (fn-node "×") (name-node "⍵")
(monad-node (fn-node "∇") (dyad-node (fn-node "-") (name-node "⍵") (num-node 1))))))
; ---- dfn applied ----
(apl-test "parse: dfn as function"
(parse "{+⍵} 3")
(monad-node
(list :dfn (dyad-node (fn-node "+") (name-node "") (name-node "⍵")))
(num-node 3)))
; ---- multi-statement ----
(apl-test "parse: diamond separator"
(let ((result (parse "x←1 ⋄ x+2")))
(= (first result) :program))
true)
(apl-test "parse: diamond first stmt"
(let ((result (parse "x←1 ⋄ x+2")))
(nth result 1))
(assign-node "x" (num-node 1)))
(apl-test "parse: diamond second stmt"
(let ((result (parse "x←1 ⋄ x+2")))
(nth result 2))
(dyad-node (fn-node "+") (name-node "x") (num-node 2)))
; ---- combined summary ----
(define apl-parse-test-count (- apl-test-count 46))
(define apl-parse-test-pass (- apl-test-pass 46))
(define apl-test-summary
(str
"tokenizer 46/46 | "
"parser " apl-parse-test-pass "/" apl-parse-test-count
(if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails))))

369
lib/apl/tests/scalar.sx Normal file
View File

@@ -0,0 +1,369 @@
; APL scalar primitives test suite
; Requires: lib/apl/runtime.sx
; ============================================================
; Test framework
; ============================================================
(define apl-rt-count 0)
(define apl-rt-pass 0)
(define apl-rt-fails (list))
; Element-wise list comparison (handles both List and ListRef)
(define
lists-eq
(fn
(a b)
(if
(and (= (len a) 0) (= (len b) 0))
true
(if
(not (= (len a) (len b)))
false
(if
(not (= (first a) (first b)))
false
(lists-eq (rest a) (rest b)))))))
(define
apl-rt-test
(fn
(name actual expected)
(begin
(set! apl-rt-count (+ apl-rt-count 1))
(if
(equal? actual expected)
(set! apl-rt-pass (+ apl-rt-pass 1))
(append! apl-rt-fails {:actual actual :expected expected :name name})))))
; Test that a ravel equals a plain list (handles ListRef vs List)
(define
ravel-test
(fn
(name arr expected-list)
(begin
(set! apl-rt-count (+ apl-rt-count 1))
(let
((actual (get arr :ravel)))
(if
(lists-eq actual expected-list)
(set! apl-rt-pass (+ apl-rt-pass 1))
(append! apl-rt-fails {:actual actual :expected expected-list :name name}))))))
; Test a scalar ravel value (single-element list)
(define
scalar-test
(fn (name arr expected-val) (ravel-test name arr (list expected-val))))
; ============================================================
; Array constructor tests
; ============================================================
(apl-rt-test
"scalar: shape is empty list"
(get (apl-scalar 5) :shape)
(list))
(apl-rt-test
"scalar: ravel has one element"
(get (apl-scalar 5) :ravel)
(list 5))
(apl-rt-test "scalar: rank 0" (array-rank (apl-scalar 5)) 0)
(apl-rt-test "scalar? returns true for scalar" (scalar? (apl-scalar 5)) true)
(apl-rt-test "scalar: zero" (get (apl-scalar 0) :ravel) (list 0))
(apl-rt-test
"vector: shape is (3)"
(get (apl-vector (list 1 2 3)) :shape)
(list 3))
(apl-rt-test
"vector: ravel matches input"
(get (apl-vector (list 1 2 3)) :ravel)
(list 1 2 3))
(apl-rt-test "vector: rank 1" (array-rank (apl-vector (list 1 2 3))) 1)
(apl-rt-test
"scalar? returns false for vector"
(scalar? (apl-vector (list 1 2 3)))
false)
(apl-rt-test
"make-array: rank 2"
(array-rank (make-array (list 2 3) (list 1 2 3 4 5 6)))
2)
(apl-rt-test
"make-array: shape"
(get (make-array (list 2 3) (list 1 2 3 4 5 6)) :shape)
(list 2 3))
(apl-rt-test
"array-ref: first element"
(array-ref (apl-vector (list 10 20 30)) 0)
10)
(apl-rt-test
"array-ref: last element"
(array-ref (apl-vector (list 10 20 30)) 2)
30)
(apl-rt-test "enclose: wraps in rank-0" (scalar? (enclose 42)) true)
(apl-rt-test
"enclose: ravel contains value"
(get (enclose 42) :ravel)
(list 42))
(apl-rt-test "disclose: unwraps rank-0" (disclose (enclose 42)) 42)
; ============================================================
; Shape primitive tests
; ============================================================
(ravel-test " scalar: returns empty" (apl-shape (apl-scalar 5)) (list))
(ravel-test
" vector: returns (3)"
(apl-shape (apl-vector (list 1 2 3)))
(list 3))
(ravel-test
" matrix: returns (2 3)"
(apl-shape (make-array (list 2 3) (list 1 2 3 4 5 6)))
(list 2 3))
(ravel-test
", ravel scalar: vector of 1"
(apl-ravel (apl-scalar 5))
(list 5))
(apl-rt-test
", ravel vector: same elements"
(get (apl-ravel (apl-vector (list 1 2 3))) :ravel)
(list 1 2 3))
(apl-rt-test
", ravel matrix: all elements"
(get (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6))) :ravel)
(list 1 2 3 4 5 6))
(scalar-test "≢ tally scalar: 1" (apl-tally (apl-scalar 5)) 1)
(scalar-test
"≢ tally vector: first dimension"
(apl-tally (apl-vector (list 1 2 3)))
3)
(scalar-test
"≢ tally matrix: first dimension"
(apl-tally (make-array (list 2 3) (list 1 2 3 4 5 6)))
2)
(scalar-test
"≡ depth flat vector: 0"
(apl-depth (apl-vector (list 1 2 3)))
0)
(scalar-test "≡ depth scalar: 0" (apl-depth (apl-scalar 5)) 0)
(scalar-test
"≡ depth nested (enclose in vector): 1"
(apl-depth (enclose (apl-vector (list 1 2 3))))
1)
; ============================================================
; iota tests
; ============================================================
(apl-rt-test
"5 shape is (5)"
(get (apl-iota (apl-scalar 5)) :shape)
(list 5))
(ravel-test "5 ravel is 1..5" (apl-iota (apl-scalar 5)) (list 1 2 3 4 5))
(ravel-test "1 ravel is (1)" (apl-iota (apl-scalar 1)) (list 1))
(ravel-test "0 ravel is empty" (apl-iota (apl-scalar 0)) (list))
(apl-rt-test "apl-io is 1" apl-io 1)
; ============================================================
; Arithmetic broadcast tests
; ============================================================
(scalar-test
"+ scalar scalar: 3+4=7"
(apl-add (apl-scalar 3) (apl-scalar 4))
7)
(ravel-test
"+ vector scalar: +10"
(apl-add (apl-vector (list 1 2 3)) (apl-scalar 10))
(list 11 12 13))
(ravel-test
"+ scalar vector: 10+"
(apl-add (apl-scalar 10) (apl-vector (list 1 2 3)))
(list 11 12 13))
(ravel-test
"+ vector vector"
(apl-add (apl-vector (list 1 2 3)) (apl-vector (list 4 5 6)))
(list 5 7 9))
(scalar-test "- negate monadic" (apl-neg-m (apl-scalar 5)) -5)
(scalar-test "- dyadic 10-3=7" (apl-sub (apl-scalar 10) (apl-scalar 3)) 7)
(scalar-test "× signum positive" (apl-signum (apl-scalar 7)) 1)
(scalar-test "× signum negative" (apl-signum (apl-scalar -3)) -1)
(scalar-test "× signum zero" (apl-signum (apl-scalar 0)) 0)
(scalar-test "× dyadic 3×4=12" (apl-mul (apl-scalar 3) (apl-scalar 4)) 12)
(scalar-test "÷ reciprocal 1÷4=0.25" (apl-recip (apl-scalar 4)) 0.25)
(scalar-test
"÷ dyadic 10÷4=2.5"
(apl-div (apl-scalar 10) (apl-scalar 4))
2.5)
(scalar-test "⌈ ceiling 2.3→3" (apl-ceil (apl-scalar 2.3)) 3)
(scalar-test "⌈ max 3 5 → 5" (apl-max (apl-scalar 3) (apl-scalar 5)) 5)
(scalar-test "⌊ floor 2.7→2" (apl-floor (apl-scalar 2.7)) 2)
(scalar-test "⌊ min 3 5 → 3" (apl-min (apl-scalar 3) (apl-scalar 5)) 3)
(scalar-test "* exp monadic e^0=1" (apl-exp (apl-scalar 0)) 1)
(scalar-test
"* pow dyadic 2^10=1024"
(apl-pow (apl-scalar 2) (apl-scalar 10))
1024)
(scalar-test "⍟ ln 1=0" (apl-ln (apl-scalar 1)) 0)
(scalar-test "| abs positive" (apl-abs (apl-scalar 5)) 5)
(scalar-test "| abs negative" (apl-abs (apl-scalar -5)) 5)
(scalar-test "| mod 3|7=1" (apl-mod (apl-scalar 3) (apl-scalar 7)) 1)
(scalar-test "! factorial 5!=120" (apl-fact (apl-scalar 5)) 120)
(scalar-test "! factorial 0!=1" (apl-fact (apl-scalar 0)) 1)
(scalar-test
"! binomial 4 choose 2 = 6"
(apl-binomial (apl-scalar 4) (apl-scalar 2))
6)
(scalar-test "○ pi×0=0" (apl-pi-times (apl-scalar 0)) 0)
(scalar-test "○ trig sin(0)=0" (apl-trig (apl-scalar 1) (apl-scalar 0)) 0)
(scalar-test "○ trig cos(0)=1" (apl-trig (apl-scalar 2) (apl-scalar 0)) 1)
; ============================================================
; Comparison tests
; ============================================================
(scalar-test "< less: 3<5 → 1" (apl-lt (apl-scalar 3) (apl-scalar 5)) 1)
(scalar-test "< less: 5<3 → 0" (apl-lt (apl-scalar 5) (apl-scalar 3)) 0)
(scalar-test
"≤ le equal: 3≤3 → 1"
(apl-le (apl-scalar 3) (apl-scalar 3))
1)
(scalar-test "= eq: 5=5 → 1" (apl-eq (apl-scalar 5) (apl-scalar 5)) 1)
(scalar-test "= ne: 5=6 → 0" (apl-eq (apl-scalar 5) (apl-scalar 6)) 0)
(scalar-test "≥ ge: 5≥3 → 1" (apl-ge (apl-scalar 5) (apl-scalar 3)) 1)
(scalar-test "> gt: 5>3 → 1" (apl-gt (apl-scalar 5) (apl-scalar 3)) 1)
(scalar-test "≠ ne: 5≠3 → 1" (apl-ne (apl-scalar 5) (apl-scalar 3)) 1)
(ravel-test
"comparison vector broadcast: 1 2 3 < 2 → 1 0 0"
(apl-lt (apl-vector (list 1 2 3)) (apl-scalar 2))
(list 1 0 0))
; ============================================================
; Logical tests
; ============================================================
(scalar-test "~ not 0 → 1" (apl-not (apl-scalar 0)) 1)
(scalar-test "~ not 1 → 0" (apl-not (apl-scalar 1)) 0)
(ravel-test
"~ not vector: 1 0 1 0 → 0 1 0 1"
(apl-not (apl-vector (list 1 0 1 0)))
(list 0 1 0 1))
(scalar-test
"∧ and 1∧1 → 1"
(apl-and (apl-scalar 1) (apl-scalar 1))
1)
(scalar-test
"∧ and 1∧0 → 0"
(apl-and (apl-scalar 1) (apl-scalar 0))
0)
(scalar-test " or 01 → 1" (apl-or (apl-scalar 0) (apl-scalar 1)) 1)
(scalar-test " or 00 → 0" (apl-or (apl-scalar 0) (apl-scalar 0)) 0)
(scalar-test
"⍱ nor 0⍱0 → 1"
(apl-nor (apl-scalar 0) (apl-scalar 0))
1)
(scalar-test
"⍱ nor 1⍱0 → 0"
(apl-nor (apl-scalar 1) (apl-scalar 0))
0)
(scalar-test
"⍲ nand 1⍲1 → 0"
(apl-nand (apl-scalar 1) (apl-scalar 1))
0)
(scalar-test
"⍲ nand 1⍲0 → 1"
(apl-nand (apl-scalar 1) (apl-scalar 0))
1)
; ============================================================
; plus-m identity test
; ============================================================
(scalar-test "+ monadic identity: +5 → 5" (apl-plus-m (apl-scalar 5)) 5)
; ============================================================
; Summary
; ============================================================
(define
apl-scalar-summary
(str
"scalar "
apl-rt-pass
"/"
apl-rt-count
(if (= (len apl-rt-fails) 0) "" (str " FAILS: " apl-rt-fails))))

168
lib/apl/tokenizer.sx Normal file
View File

@@ -0,0 +1,168 @@
(define apl-glyph-set
(list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~" "<" "≤" "=" "≥" ">" "≠"
"∊" "∧" "" "⍱" "⍲" "," "⍪" "" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
"" "∩" "" "⍸" "⌷" "⍋" "⍒" "⊥" "" "⊣" "⊢" "⍎" "⍕"
"" "⍵" "∇" "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))
(define apl-glyph?
(fn (ch)
(some (fn (g) (= g ch)) apl-glyph-set)))
(define apl-digit?
(fn (ch)
(and (string? ch) (>= ch "0") (<= ch "9"))))
(define apl-alpha?
(fn (ch)
(and (string? ch)
(or (and (>= ch "a") (<= ch "z"))
(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)
(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)))
(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))))
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)))
(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)))
(cond
((or (= ch " ") (= ch "\t") (= ch "\r"))
(begin (advance!) (scan!)))
((= ch "\n")
(begin (advance!) (tok-push! :newline nil) (scan!)))
((cur-sw? "⍝")
(begin (skip-line!) (scan!)))
((cur-sw? "⋄")
(begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
((= ch "(")
(begin (advance!) (tok-push! :lparen nil) (scan!)))
((= ch ")")
(begin (advance!) (tok-push! :rparen nil) (scan!)))
((= ch "[")
(begin (advance!) (tok-push! :lbracket nil) (scan!)))
((= ch "]")
(begin (advance!) (tok-push! :rbracket nil) (scan!)))
((= ch "{")
(begin (advance!) (tok-push! :lbrace nil) (scan!)))
((= ch "}")
(begin (advance!) (tok-push! :rbrace nil) (scan!)))
((= ch ";")
(begin (advance!) (tok-push! :semi nil) (scan!)))
((cur-sw? "←")
(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!)))
((apl-digit? ch)
(begin
(let ((digits (read-digits! "")))
(tok-push! :num (parse-int digits 0)))
(scan!)))
((= ch "'")
(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!))))
(true
(let ((g (find-glyph)))
(if g
(begin (consume! g) (tok-push! :glyph g) (scan!))
(begin (advance!) (scan!))))))))))
(scan!)
tokens)))

View File

@@ -49,8 +49,6 @@ trap "rm -f $TMPFILE" EXIT
echo '(load "lib/js/transpile.sx")'
echo '(epoch 5)'
echo '(load "lib/js/runtime.sx")'
echo '(epoch 6)'
echo '(load "lib/js/regex.sx")'
epoch=100
for f in "${FIXTURES[@]}"; do

View File

@@ -1,943 +0,0 @@
;; lib/js/regex.sx — pure-SX recursive backtracking regex engine
;;
;; Installed via (js-regex-platform-override! ...) at load time.
;; Covers: character classes (\d\w\s . [abc] [^abc] [a-z]),
;; anchors (^ $ \b \B), quantifiers (* + ? {n,m} lazy variants),
;; groups (capturing + non-capturing), alternation (a|b),
;; flags: i (case-insensitive), g (global), m (multiline).
;;
;; Architecture:
;; 1. rx-parse-pattern — pattern string → compiled node list
;; 2. rx-match-nodes — recursive backtracker
;; 3. rx-exec / rx-test — public interface
;; 4. Install as {:test rx-test :exec rx-exec}
;; ── Utilities ─────────────────────────────────────────────────────
(define
rx-char-at
(fn (s i) (if (and (>= i 0) (< i (len s))) (char-at s i) "")))
(define
rx-digit?
(fn
(c)
(and (not (= c "")) (>= (char-code c) 48) (<= (char-code c) 57))))
(define
rx-word?
(fn
(c)
(and
(not (= c ""))
(or
(and (>= (char-code c) 65) (<= (char-code c) 90))
(and (>= (char-code c) 97) (<= (char-code c) 122))
(and (>= (char-code c) 48) (<= (char-code c) 57))
(= c "_")))))
(define
rx-space?
(fn
(c)
(or (= c " ") (= c "\t") (= c "\n") (= c "\r") (= c "\\f") (= c ""))))
(define rx-newline? (fn (c) (or (= c "\n") (= c "\r"))))
(define
rx-downcase-char
(fn
(c)
(let
((cc (char-code c)))
(if (and (>= cc 65) (<= cc 90)) (char-from-code (+ cc 32)) c))))
(define
rx-char-eq?
(fn
(a b ci?)
(if ci? (= (rx-downcase-char a) (rx-downcase-char b)) (= a b))))
(define
rx-parse-int
(fn
(pat i acc)
(let
((c (rx-char-at pat i)))
(if
(rx-digit? c)
(rx-parse-int pat (+ i 1) (+ (* acc 10) (- (char-code c) 48)))
(list acc i)))))
(define
rx-hex-digit-val
(fn
(c)
(cond
((and (>= (char-code c) 48) (<= (char-code c) 57))
(- (char-code c) 48))
((and (>= (char-code c) 65) (<= (char-code c) 70))
(+ 10 (- (char-code c) 65)))
((and (>= (char-code c) 97) (<= (char-code c) 102))
(+ 10 (- (char-code c) 97)))
(else -1))))
(define
rx-parse-hex-n
(fn
(pat i n acc)
(if
(= n 0)
(list (char-from-code acc) i)
(let
((v (rx-hex-digit-val (rx-char-at pat i))))
(if
(< v 0)
(list (char-from-code acc) i)
(rx-parse-hex-n pat (+ i 1) (- n 1) (+ (* acc 16) v)))))))
;; ── Pattern compiler ──────────────────────────────────────────────
;; Node types (stored in dicts with "__t__" key):
;; literal : {:__t__ "literal" :__c__ char}
;; any : {:__t__ "any"}
;; class-d : {:__t__ "class-d" :__neg__ bool}
;; class-w : {:__t__ "class-w" :__neg__ bool}
;; class-s : {:__t__ "class-s" :__neg__ bool}
;; char-class: {:__t__ "char-class" :__neg__ bool :__items__ list}
;; anchor-start / anchor-end / anchor-word / anchor-nonword
;; quant : {:__t__ "quant" :__node__ n :__min__ m :__max__ mx :__lazy__ bool}
;; group : {:__t__ "group" :__idx__ i :__nodes__ list}
;; ncgroup : {:__t__ "ncgroup" :__nodes__ list}
;; alt : {:__t__ "alt" :__branches__ list-of-node-lists}
;; parse one escape after `\`, returns (node new-i)
(define
rx-parse-escape
(fn
(pat i)
(let
((c (rx-char-at pat i)))
(cond
((= c "d") (list (dict "__t__" "class-d" "__neg__" false) (+ i 1)))
((= c "D") (list (dict "__t__" "class-d" "__neg__" true) (+ i 1)))
((= c "w") (list (dict "__t__" "class-w" "__neg__" false) (+ i 1)))
((= c "W") (list (dict "__t__" "class-w" "__neg__" true) (+ i 1)))
((= c "s") (list (dict "__t__" "class-s" "__neg__" false) (+ i 1)))
((= c "S") (list (dict "__t__" "class-s" "__neg__" true) (+ i 1)))
((= c "b") (list (dict "__t__" "anchor-word") (+ i 1)))
((= c "B") (list (dict "__t__" "anchor-nonword") (+ i 1)))
((= c "n") (list (dict "__t__" "literal" "__c__" "\n") (+ i 1)))
((= c "r") (list (dict "__t__" "literal" "__c__" "\r") (+ i 1)))
((= c "t") (list (dict "__t__" "literal" "__c__" "\t") (+ i 1)))
((= c "f") (list (dict "__t__" "literal" "__c__" "\\f") (+ i 1)))
((= c "v") (list (dict "__t__" "literal" "__c__" "") (+ i 1)))
((= c "u")
(let
((res (rx-parse-hex-n pat (+ i 1) 4 0)))
(list (dict "__t__" "literal" "__c__" (nth res 0)) (nth res 1))))
((= c "x")
(let
((res (rx-parse-hex-n pat (+ i 1) 2 0)))
(list (dict "__t__" "literal" "__c__" (nth res 0)) (nth res 1))))
(else (list (dict "__t__" "literal" "__c__" c) (+ i 1)))))))
;; parse a char-class item inside [...], returns (item new-i)
(define
rx-parse-class-item
(fn
(pat i)
(let
((c (rx-char-at pat i)))
(cond
((= c "\\")
(let
((esc (rx-parse-escape pat (+ i 1))))
(let
((node (nth esc 0)) (ni (nth esc 1)))
(let
((t (get node "__t__")))
(cond
((= t "class-d")
(list
(dict "kind" "class-d" "neg" (get node "__neg__"))
ni))
((= t "class-w")
(list
(dict "kind" "class-w" "neg" (get node "__neg__"))
ni))
((= t "class-s")
(list
(dict "kind" "class-s" "neg" (get node "__neg__"))
ni))
(else
(let
((lc (get node "__c__")))
(if
(and
(= (rx-char-at pat ni) "-")
(not (= (rx-char-at pat (+ ni 1)) "]")))
(let
((hi-c (rx-char-at pat (+ ni 1))))
(list
(dict "kind" "range" "lo" lc "hi" hi-c)
(+ ni 2)))
(list (dict "kind" "lit" "c" lc) ni)))))))))
(else
(if
(and
(not (= c ""))
(= (rx-char-at pat (+ i 1)) "-")
(not (= (rx-char-at pat (+ i 2)) "]"))
(not (= (rx-char-at pat (+ i 2)) "")))
(let
((hi-c (rx-char-at pat (+ i 2))))
(list (dict "kind" "range" "lo" c "hi" hi-c) (+ i 3)))
(list (dict "kind" "lit" "c" c) (+ i 1))))))))
(define
rx-parse-class-items
(fn
(pat i items)
(let
((c (rx-char-at pat i)))
(if
(or (= c "]") (= c ""))
(list items i)
(let
((res (rx-parse-class-item pat i)))
(begin
(append! items (nth res 0))
(rx-parse-class-items pat (nth res 1) items)))))))
;; parse a sequence until stop-ch or EOF; returns (nodes new-i groups-count)
(define
rx-parse-seq
(fn
(pat i stop-ch ds)
(let
((c (rx-char-at pat i)))
(cond
((= c "") (list (get ds "nodes") i (get ds "groups")))
((= c stop-ch) (list (get ds "nodes") i (get ds "groups")))
((= c "|") (rx-parse-alt-rest pat i ds))
(else
(let
((res (rx-parse-atom pat i ds)))
(let
((node (nth res 0)) (ni (nth res 1)) (ds2 (nth res 2)))
(let
((qres (rx-parse-quant pat ni node)))
(begin
(append! (get ds2 "nodes") (nth qres 0))
(rx-parse-seq pat (nth qres 1) stop-ch ds2))))))))))
;; when we hit | inside a sequence, collect all alternatives
(define
rx-parse-alt-rest
(fn
(pat i ds)
(let
((left-branch (get ds "nodes")) (branches (list)))
(begin
(append! branches left-branch)
(rx-parse-alt-branches pat i (get ds "groups") branches)))))
(define
rx-parse-alt-branches
(fn
(pat i n-groups branches)
(let
((new-nodes (list)) (ds2 (dict "groups" n-groups "nodes" new-nodes)))
(let
((res (rx-parse-seq pat (+ i 1) "|" ds2)))
(begin
(append! branches (nth res 0))
(let
((ni2 (nth res 1)) (g2 (nth res 2)))
(if
(= (rx-char-at pat ni2) "|")
(rx-parse-alt-branches pat ni2 g2 branches)
(list
(list (dict "__t__" "alt" "__branches__" branches))
ni2
g2))))))))
;; parse quantifier suffix, returns (node new-i)
(define
rx-parse-quant
(fn
(pat i node)
(let
((c (rx-char-at pat i)))
(cond
((= c "*")
(let
((lazy? (= (rx-char-at pat (+ i 1)) "?")))
(list
(dict
"__t__"
"quant"
"__node__"
node
"__min__"
0
"__max__"
-1
"__lazy__"
lazy?)
(if lazy? (+ i 2) (+ i 1)))))
((= c "+")
(let
((lazy? (= (rx-char-at pat (+ i 1)) "?")))
(list
(dict
"__t__"
"quant"
"__node__"
node
"__min__"
1
"__max__"
-1
"__lazy__"
lazy?)
(if lazy? (+ i 2) (+ i 1)))))
((= c "?")
(let
((lazy? (= (rx-char-at pat (+ i 1)) "?")))
(list
(dict
"__t__"
"quant"
"__node__"
node
"__min__"
0
"__max__"
1
"__lazy__"
lazy?)
(if lazy? (+ i 2) (+ i 1)))))
((= c "{")
(let
((mres (rx-parse-int pat (+ i 1) 0)))
(let
((mn (nth mres 0)) (mi (nth mres 1)))
(let
((sep (rx-char-at pat mi)))
(cond
((= sep "}")
(let
((lazy? (= (rx-char-at pat (+ mi 1)) "?")))
(list
(dict
"__t__"
"quant"
"__node__"
node
"__min__"
mn
"__max__"
mn
"__lazy__"
lazy?)
(if lazy? (+ mi 2) (+ mi 1)))))
((= sep ",")
(let
((c2 (rx-char-at pat (+ mi 1))))
(if
(= c2 "}")
(let
((lazy? (= (rx-char-at pat (+ mi 2)) "?")))
(list
(dict
"__t__"
"quant"
"__node__"
node
"__min__"
mn
"__max__"
-1
"__lazy__"
lazy?)
(if lazy? (+ mi 3) (+ mi 2))))
(let
((mxres (rx-parse-int pat (+ mi 1) 0)))
(let
((mx (nth mxres 0)) (mxi (nth mxres 1)))
(let
((lazy? (= (rx-char-at pat (+ mxi 1)) "?")))
(list
(dict
"__t__"
"quant"
"__node__"
node
"__min__"
mn
"__max__"
mx
"__lazy__"
lazy?)
(if lazy? (+ mxi 2) (+ mxi 1)))))))))
(else (list node i)))))))
(else (list node i))))))
;; parse one atom, returns (node new-i new-ds)
(define
rx-parse-atom
(fn
(pat i ds)
(let
((c (rx-char-at pat i)))
(cond
((= c ".") (list (dict "__t__" "any") (+ i 1) ds))
((= c "^") (list (dict "__t__" "anchor-start") (+ i 1) ds))
((= c "$") (list (dict "__t__" "anchor-end") (+ i 1) ds))
((= c "\\")
(let
((esc (rx-parse-escape pat (+ i 1))))
(list (nth esc 0) (nth esc 1) ds)))
((= c "[")
(let
((neg? (= (rx-char-at pat (+ i 1)) "^")))
(let
((start (if neg? (+ i 2) (+ i 1))) (items (list)))
(let
((res (rx-parse-class-items pat start items)))
(let
((ci (nth res 1)))
(list
(dict
"__t__"
"char-class"
"__neg__"
neg?
"__items__"
items)
(+ ci 1)
ds))))))
((= c "(")
(let
((c2 (rx-char-at pat (+ i 1))))
(if
(and (= c2 "?") (= (rx-char-at pat (+ i 2)) ":"))
(let
((inner-nodes (list))
(inner-ds
(dict "groups" (get ds "groups") "nodes" inner-nodes)))
(let
((res (rx-parse-seq pat (+ i 3) ")" inner-ds)))
(list
(dict "__t__" "ncgroup" "__nodes__" (nth res 0))
(+ (nth res 1) 1)
(dict "groups" (nth res 2) "nodes" (get ds "nodes")))))
(let
((gidx (+ (get ds "groups") 1)) (inner-nodes (list)))
(let
((inner-ds (dict "groups" gidx "nodes" inner-nodes)))
(let
((res (rx-parse-seq pat (+ i 1) ")" inner-ds)))
(list
(dict
"__t__"
"group"
"__idx__"
gidx
"__nodes__"
(nth res 0))
(+ (nth res 1) 1)
(dict "groups" (nth res 2) "nodes" (get ds "nodes")))))))))
(else (list (dict "__t__" "literal" "__c__" c) (+ i 1) ds))))))
;; top-level compile
(define
rx-compile
(fn
(pattern)
(let
((nodes (list)) (ds (dict "groups" 0 "nodes" nodes)))
(let
((res (rx-parse-seq pattern 0 "" ds)))
(dict "nodes" (nth res 0) "ngroups" (nth res 2))))))
;; ── Matcher ───────────────────────────────────────────────────────
;; Match a char-class item against character c
(define
rx-item-matches?
(fn
(item c ci?)
(let
((kind (get item "kind")))
(cond
((= kind "lit") (rx-char-eq? c (get item "c") ci?))
((= kind "range")
(let
((lo (if ci? (rx-downcase-char (get item "lo")) (get item "lo")))
(hi
(if ci? (rx-downcase-char (get item "hi")) (get item "hi")))
(dc (if ci? (rx-downcase-char c) c)))
(and
(>= (char-code dc) (char-code lo))
(<= (char-code dc) (char-code hi)))))
((= kind "class-d")
(let ((m (rx-digit? c))) (if (get item "neg") (not m) m)))
((= kind "class-w")
(let ((m (rx-word? c))) (if (get item "neg") (not m) m)))
((= kind "class-s")
(let ((m (rx-space? c))) (if (get item "neg") (not m) m)))
(else false)))))
(define
rx-class-items-any?
(fn
(items c ci?)
(if
(empty? items)
false
(if
(rx-item-matches? (first items) c ci?)
true
(rx-class-items-any? (rest items) c ci?)))))
(define
rx-class-matches?
(fn
(node c ci?)
(let
((neg? (get node "__neg__")) (items (get node "__items__")))
(let
((hit (rx-class-items-any? items c ci?)))
(if neg? (not hit) hit)))))
;; Word boundary check
(define
rx-is-word-boundary?
(fn
(s i slen)
(let
((before (if (> i 0) (rx-word? (char-at s (- i 1))) false))
(after (if (< i slen) (rx-word? (char-at s i)) false)))
(not (= before after)))))
;; ── Core matcher ──────────────────────────────────────────────────
;;
;; rx-match-nodes : nodes s i slen ci? mi? groups → end-pos or -1
;;
;; Matches `nodes` starting at position `i` in string `s`.
;; Returns the position after the last character consumed, or -1 on failure.
;; Mutates `groups` dict to record captures.
(define
rx-match-nodes
(fn
(nodes s i slen ci? mi? groups)
(if
(empty? nodes)
i
(let
((node (first nodes)) (rest-nodes (rest nodes)))
(let
((t (get node "__t__")))
(cond
((= t "literal")
(if
(and
(< i slen)
(rx-char-eq? (char-at s i) (get node "__c__") ci?))
(rx-match-nodes rest-nodes s (+ i 1) slen ci? mi? groups)
-1))
((= t "any")
(if
(and (< i slen) (not (rx-newline? (char-at s i))))
(rx-match-nodes rest-nodes s (+ i 1) slen ci? mi? groups)
-1))
((= t "class-d")
(let
((m (and (< i slen) (rx-digit? (char-at s i)))))
(if
(if (get node "__neg__") (not m) m)
(rx-match-nodes rest-nodes s (+ i 1) slen ci? mi? groups)
-1)))
((= t "class-w")
(let
((m (and (< i slen) (rx-word? (char-at s i)))))
(if
(if (get node "__neg__") (not m) m)
(rx-match-nodes rest-nodes s (+ i 1) slen ci? mi? groups)
-1)))
((= t "class-s")
(let
((m (and (< i slen) (rx-space? (char-at s i)))))
(if
(if (get node "__neg__") (not m) m)
(rx-match-nodes rest-nodes s (+ i 1) slen ci? mi? groups)
-1)))
((= t "char-class")
(if
(and (< i slen) (rx-class-matches? node (char-at s i) ci?))
(rx-match-nodes rest-nodes s (+ i 1) slen ci? mi? groups)
-1))
((= t "anchor-start")
(if
(or
(= i 0)
(and mi? (rx-newline? (rx-char-at s (- i 1)))))
(rx-match-nodes rest-nodes s i slen ci? mi? groups)
-1))
((= t "anchor-end")
(if
(or (= i slen) (and mi? (rx-newline? (rx-char-at s i))))
(rx-match-nodes rest-nodes s i slen ci? mi? groups)
-1))
((= t "anchor-word")
(if
(rx-is-word-boundary? s i slen)
(rx-match-nodes rest-nodes s i slen ci? mi? groups)
-1))
((= t "anchor-nonword")
(if
(not (rx-is-word-boundary? s i slen))
(rx-match-nodes rest-nodes s i slen ci? mi? groups)
-1))
((= t "group")
(let
((gidx (get node "__idx__"))
(inner (get node "__nodes__")))
(let
((g-end (rx-match-nodes inner s i slen ci? mi? groups)))
(if
(>= g-end 0)
(begin
(dict-set!
groups
(js-to-string gidx)
(substring s i g-end))
(let
((final-end (rx-match-nodes rest-nodes s g-end slen ci? mi? groups)))
(if
(>= final-end 0)
final-end
(begin
(dict-set! groups (js-to-string gidx) nil)
-1))))
-1))))
((= t "ncgroup")
(let
((inner (get node "__nodes__")))
(rx-match-nodes
(append inner rest-nodes)
s
i
slen
ci?
mi?
groups)))
((= t "alt")
(let
((branches (get node "__branches__")))
(rx-try-branches branches rest-nodes s i slen ci? mi? groups)))
((= t "quant")
(let
((inner-node (get node "__node__"))
(mn (get node "__min__"))
(mx (get node "__max__"))
(lazy? (get node "__lazy__")))
(if
lazy?
(rx-quant-lazy
inner-node
mn
mx
rest-nodes
s
i
slen
ci?
mi?
groups
0)
(rx-quant-greedy
inner-node
mn
mx
rest-nodes
s
i
slen
ci?
mi?
groups
0))))
(else -1)))))))
(define
rx-try-branches
(fn
(branches rest-nodes s i slen ci? mi? groups)
(if
(empty? branches)
-1
(let
((res (rx-match-nodes (append (first branches) rest-nodes) s i slen ci? mi? groups)))
(if
(>= res 0)
res
(rx-try-branches (rest branches) rest-nodes s i slen ci? mi? groups))))))
;; Greedy: expand as far as possible, then try rest from the longest match
;; Strategy: recurse forward (extend first); only try rest when extension fails
(define
rx-quant-greedy
(fn
(inner-node mn mx rest-nodes s i slen ci? mi? groups count)
(let
((can-extend (and (< i slen) (or (= mx -1) (< count mx)))))
(if
can-extend
(let
((ni (rx-match-one inner-node s i slen ci? mi? groups)))
(if
(>= ni 0)
(let
((res (rx-quant-greedy inner-node mn mx rest-nodes s ni slen ci? mi? groups (+ count 1))))
(if
(>= res 0)
res
(if
(>= count mn)
(rx-match-nodes rest-nodes s i slen ci? mi? groups)
-1)))
(if
(>= count mn)
(rx-match-nodes rest-nodes s i slen ci? mi? groups)
-1)))
(if
(>= count mn)
(rx-match-nodes rest-nodes s i slen ci? mi? groups)
-1)))))
;; Lazy: try rest first, extend only if rest fails
(define
rx-quant-lazy
(fn
(inner-node mn mx rest-nodes s i slen ci? mi? groups count)
(if
(>= count mn)
(let
((res (rx-match-nodes rest-nodes s i slen ci? mi? groups)))
(if
(>= res 0)
res
(if
(and (< i slen) (or (= mx -1) (< count mx)))
(let
((ni (rx-match-one inner-node s i slen ci? mi? groups)))
(if
(>= ni 0)
(rx-quant-lazy
inner-node
mn
mx
rest-nodes
s
ni
slen
ci?
mi?
groups
(+ count 1))
-1))
-1)))
(if
(< i slen)
(let
((ni (rx-match-one inner-node s i slen ci? mi? groups)))
(if
(>= ni 0)
(rx-quant-lazy
inner-node
mn
mx
rest-nodes
s
ni
slen
ci?
mi?
groups
(+ count 1))
-1))
-1))))
;; Match a single node at position i, return new pos or -1
(define
rx-match-one
(fn
(node s i slen ci? mi? groups)
(rx-match-nodes (list node) s i slen ci? mi? groups)))
;; ── Engine entry points ───────────────────────────────────────────
;; Try matching at exactly position i. Returns result dict or nil.
(define
rx-try-at
(fn
(compiled s i slen ci? mi?)
(let
((nodes (get compiled "nodes")) (ngroups (get compiled "ngroups")))
(let
((groups (dict)))
(let
((end (rx-match-nodes nodes s i slen ci? mi? groups)))
(if
(>= end 0)
(dict "start" i "end" end "groups" groups "ngroups" ngroups)
nil))))))
;; Find first match scanning from search-start.
(define
rx-find-from
(fn
(compiled s search-start slen ci? mi?)
(if
(> search-start slen)
nil
(let
((res (rx-try-at compiled s search-start slen ci? mi?)))
(if
res
res
(rx-find-from compiled s (+ search-start 1) slen ci? mi?))))))
;; Build exec result dict from raw match result
(define
rx-build-exec-result
(fn
(s match-res)
(let
((start (get match-res "start"))
(end (get match-res "end"))
(groups (get match-res "groups"))
(ngroups (get match-res "ngroups")))
(let
((matched (substring s start end))
(caps (rx-build-captures groups ngroups 1)))
(dict "match" matched "index" start "input" s "groups" caps)))))
(define
rx-build-captures
(fn
(groups ngroups idx)
(if
(> idx ngroups)
(list)
(let
((cap (get groups (js-to-string idx))))
(cons
(if (= cap nil) :js-undefined cap)
(rx-build-captures groups ngroups (+ idx 1)))))))
;; ── Public interface ──────────────────────────────────────────────
;; Lazy compile: build NFA on first use, cache under "__compiled__"
(define
rx-ensure-compiled!
(fn
(rx)
(if
(dict-has? rx "__compiled__")
(get rx "__compiled__")
(let
((c (rx-compile (get rx "source"))))
(begin (dict-set! rx "__compiled__" c) c)))))
(define
rx-test
(fn
(rx s)
(let
((compiled (rx-ensure-compiled! rx))
(ci? (get rx "ignoreCase"))
(mi? (get rx "multiline"))
(slen (len s)))
(let
((start (if (get rx "global") (let ((li (get rx "lastIndex"))) (if (number? li) li 0)) 0)))
(let
((res (rx-find-from compiled s start slen ci? mi?)))
(if
(get rx "global")
(begin
(dict-set! rx "lastIndex" (if res (get res "end") 0))
(if res true false))
(if res true false)))))))
(define
rx-exec
(fn
(rx s)
(let
((compiled (rx-ensure-compiled! rx))
(ci? (get rx "ignoreCase"))
(mi? (get rx "multiline"))
(slen (len s)))
(let
((start (if (get rx "global") (let ((li (get rx "lastIndex"))) (if (number? li) li 0)) 0)))
(let
((res (rx-find-from compiled s start slen ci? mi?)))
(if
res
(begin
(when
(get rx "global")
(dict-set! rx "lastIndex" (get res "end")))
(rx-build-exec-result s res))
(begin
(when (get rx "global") (dict-set! rx "lastIndex" 0))
nil)))))))
;; match-all for String.prototype.matchAll
(define
js-regex-match-all
(fn
(rx s)
(let
((compiled (rx-ensure-compiled! rx))
(ci? (get rx "ignoreCase"))
(mi? (get rx "multiline"))
(slen (len s))
(results (list)))
(rx-match-all-loop compiled s 0 slen ci? mi? results))))
(define
rx-match-all-loop
(fn
(compiled s i slen ci? mi? results)
(if
(> i slen)
results
(let
((res (rx-find-from compiled s i slen ci? mi?)))
(if
res
(begin
(append! results (rx-build-exec-result s res))
(let
((next (get res "end")))
(rx-match-all-loop
compiled
s
(if (= next i) (+ i 1) next)
slen
ci?
mi?
results)))
results)))))
;; ── Install platform ──────────────────────────────────────────────
(js-regex-platform-override! "test" rx-test)
(js-regex-platform-override! "exec" rx-exec)

View File

@@ -2032,15 +2032,7 @@
(&rest args)
(cond
((= (len args) 0) nil)
((js-regex? (nth args 0))
(let
((rx (nth args 0)))
(let
((impl (get __js_regex_platform__ "exec")))
(if
(js-undefined? impl)
(js-regex-stub-exec rx s)
(impl rx s)))))
((js-regex? (nth args 0)) (js-regex-stub-exec (nth args 0) s))
(else
(let
((needle (js-to-string (nth args 0))))
@@ -2049,7 +2041,7 @@
(if
(= idx -1)
nil
(let ((res (list))) (begin (append! res needle) res)))))))))
(let ((res (list))) (append! res needle) res))))))))
((= name "at")
(fn
(i)
@@ -2107,20 +2099,6 @@
((= name "toWellFormed") (fn () s))
(else js-undefined))))
(define __js_tdz_sentinel__ (dict "__tdz__" true))
(define js-tdz? (fn (v) (and (dict? v) (dict-has? v "__tdz__"))))
(define
js-tdz-check
(fn
(name val)
(if
(js-tdz? val)
(raise
(TypeError (str "Cannot access '" name "' before initialization")))
val)))
(define
js-string-slice
(fn

View File

@@ -33,8 +33,6 @@ cat > "$TMPFILE" << 'EPOCHS'
(load "lib/js/transpile.sx")
(epoch 5)
(load "lib/js/runtime.sx")
(epoch 6)
(load "lib/js/regex.sx")
;; ── Phase 0: stubs still behave ─────────────────────────────────
(epoch 10)
@@ -1325,108 +1323,6 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 3505)
(eval "(js-eval \"var a = {length: 3, 0: 10, 1: 20, 2: 30}; var sum = 0; Array.prototype.forEach.call(a, function(x){sum += x;}); sum\")")
;; ── Phase 12: Regex engine ────────────────────────────────────────
;; Platform is installed (test key is a function, not undefined)
(epoch 5000)
(eval "(js-undefined? (get __js_regex_platform__ \"test\"))")
(epoch 5001)
(eval "(js-eval \"/foo/.test('hi foo bar')\")")
(epoch 5002)
(eval "(js-eval \"/foo/.test('hi bar')\")")
;; Case-insensitive flag
(epoch 5003)
(eval "(js-eval \"/FOO/i.test('hello foo world')\")")
;; Anchors
(epoch 5004)
(eval "(js-eval \"/^hello/.test('hello world')\")")
(epoch 5005)
(eval "(js-eval \"/^hello/.test('say hello')\")")
(epoch 5006)
(eval "(js-eval \"/world$/.test('hello world')\")")
;; Character classes
(epoch 5007)
(eval "(js-eval \"/\\\\d+/.test('abc 123')\")")
(epoch 5008)
(eval "(js-eval \"/\\\\w+/.test('hello')\")")
(epoch 5009)
(eval "(js-eval \"/[abc]/.test('dog')\")")
(epoch 5010)
(eval "(js-eval \"/[abc]/.test('cat')\")")
;; Quantifiers
(epoch 5011)
(eval "(js-eval \"/a*b/.test('b')\")")
(epoch 5012)
(eval "(js-eval \"/a+b/.test('b')\")")
(epoch 5013)
(eval "(js-eval \"/a{2,3}/.test('aa')\")")
(epoch 5014)
(eval "(js-eval \"/a{2,3}/.test('a')\")")
;; Dot
(epoch 5015)
(eval "(js-eval \"/h.llo/.test('hello')\")")
(epoch 5016)
(eval "(js-eval \"/h.llo/.test('hllo')\")")
;; exec result
(epoch 5017)
(eval "(js-eval \"var m = /foo(\\\\w+)/.exec('foobar'); m.match\")")
(epoch 5018)
(eval "(js-eval \"var m = /foo(\\\\w+)/.exec('foobar'); m.index\")")
(epoch 5019)
(eval "(js-eval \"var m = /foo(\\\\w+)/.exec('foobar'); m.groups[0]\")")
;; Alternation
(epoch 5020)
(eval "(js-eval \"/cat|dog/.test('I have a dog')\")")
(epoch 5021)
(eval "(js-eval \"/cat|dog/.test('I have a fish')\")")
;; Non-capturing group
(epoch 5022)
(eval "(js-eval \"/(?:foo)+/.test('foofoo')\")")
;; Negated char class
(epoch 5023)
(eval "(js-eval \"/[^abc]/.test('d')\")")
(epoch 5024)
(eval "(js-eval \"/[^abc]/.test('a')\")")
;; Range inside char class
(epoch 5025)
(eval "(js-eval \"/[a-z]+/.test('hello')\")")
;; Word boundary
(epoch 5026)
(eval "(js-eval \"/\\\\bword\\\\b/.test('a word here')\")")
(epoch 5027)
(eval "(js-eval \"/\\\\bword\\\\b/.test('password')\")")
;; Lazy quantifier
(epoch 5028)
(eval "(js-eval \"var m = /a+?/.exec('aaa'); m.match\")")
;; Global flag exec
(epoch 5029)
(eval "(js-eval \"var r=/\\\\d+/g; r.exec('a1b2'); r.exec('a1b2').match\")")
;; String.prototype.match with regex
(epoch 5030)
(eval "(js-eval \"'hello world'.match(/\\\\w+/).match\")")
;; String.prototype.search
(epoch 5031)
(eval "(js-eval \"'hello world'.search(/world/)\")")
;; String.prototype.replace with regex
(epoch 5032)
(eval "(js-eval \"'hello world'.replace(/world/, 'there')\")")
;; multiline anchor
(epoch 5033)
(eval "(js-eval \"/^bar/m.test('foo\\nbar')\")")
;; ── Phase 13: let/const TDZ infrastructure ───────────────────────
;; The TDZ sentinel and checker are defined in runtime.sx.
;; let/const bindings work normally after initialization.
(epoch 5100)
(eval "(js-eval \"let x = 5; x\")")
(epoch 5101)
(eval "(js-eval \"const y = 42; y\")")
;; TDZ sentinel exists and is detectable
(epoch 5102)
(eval "(js-tdz? __js_tdz_sentinel__)")
;; js-tdz-check passes through non-sentinel values
(epoch 5103)
(eval "(js-tdz-check \"x\" 42)")
EPOCHS
@@ -2146,48 +2042,6 @@ check 3503 "indexOf.call arrLike" '1'
check 3504 "filter.call arrLike" '"2,3"'
check 3505 "forEach.call arrLike sum" '60'
# ── Phase 12: Regex engine ────────────────────────────────────────
check 5000 "regex platform installed" 'false'
check 5001 "/foo/ matches" 'true'
check 5002 "/foo/ no match" 'false'
check 5003 "/FOO/i case-insensitive" 'true'
check 5004 "/^hello/ anchor match" 'true'
check 5005 "/^hello/ anchor no-match" 'false'
check 5006 "/world$/ end anchor" 'true'
check 5007 "/\\d+/ digit class" 'true'
check 5008 "/\\w+/ word class" 'true'
check 5009 "/[abc]/ class no-match" 'false'
check 5010 "/[abc]/ class match" 'true'
check 5011 "/a*b/ zero-or-more" 'true'
check 5012 "/a+b/ one-or-more no-match" 'false'
check 5013 "/a{2,3}/ quant match" 'true'
check 5014 "/a{2,3}/ quant no-match" 'false'
check 5015 "dot matches any" 'true'
check 5016 "dot requires char" 'false'
check 5017 "exec match string" '"foobar"'
check 5018 "exec match index" '0'
check 5019 "exec capture group" '"bar"'
check 5020 "alternation cat|dog match" 'true'
check 5021 "alternation cat|dog no-match" 'false'
check 5022 "non-capturing group" 'true'
check 5023 "negated class match" 'true'
check 5024 "negated class no-match" 'false'
check 5025 "range [a-z]+" 'true'
check 5026 "word boundary match" 'true'
check 5027 "word boundary no-match" 'false'
check 5028 "lazy quantifier" '"a"'
check 5029 "global exec advances" '"2"'
check 5030 "String.match regex" '"hello"'
check 5031 "String.search regex" '6'
check 5032 "String.replace regex" '"hello there"'
check 5033 "multiline anchor" 'true'
# ── Phase 13: let/const TDZ infrastructure ───────────────────────
check 5100 "let binding initialized" '5'
check 5101 "const binding initialized" '42'
check 5102 "TDZ sentinel is detectable" 'true'
check 5103 "tdz-check passes non-sentinel" '42'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "$PASS/$TOTAL JS-on-SX tests passed"

View File

@@ -798,7 +798,6 @@ class ServerSession:
self._run_and_collect(3, '(load "lib/js/parser.sx")', timeout=60.0)
self._run_and_collect(4, '(load "lib/js/transpile.sx")', timeout=60.0)
self._run_and_collect(5, '(load "lib/js/runtime.sx")', timeout=60.0)
self._run_and_collect(50, '(load "lib/js/regex.sx")', timeout=60.0)
# Preload the stub harness — use precomputed SX cache when available
# (huge win: ~15s js-eval HARNESS_STUB → ~0s load precomputed .sx).
cache_rel = _harness_cache_rel_path()

View File

@@ -935,12 +935,12 @@
(define
js-transpile-var
(fn (kind decls) (cons (js-sym "begin") (js-vardecl-forms kind decls))))
(fn (kind decls) (cons (js-sym "begin") (js-vardecl-forms decls))))
(define
js-vardecl-forms
(fn
(kind decls)
(decls)
(cond
((empty? decls) (list))
(else
@@ -953,7 +953,7 @@
(js-sym "define")
(js-sym (nth d 1))
(js-transpile (nth d 2)))
(js-vardecl-forms kind (rest decls))))
(js-vardecl-forms (rest decls))))
((js-tag? d "js-vardecl-obj")
(let
((names (nth d 1))
@@ -964,7 +964,7 @@
(js-vardecl-obj-forms
names
tmp-sym
(js-vardecl-forms kind (rest decls))))))
(js-vardecl-forms (rest decls))))))
((js-tag? d "js-vardecl-arr")
(let
((names (nth d 1))
@@ -976,7 +976,7 @@
names
tmp-sym
0
(js-vardecl-forms kind (rest decls))))))
(js-vardecl-forms (rest decls))))))
(else (error "js-vardecl-forms: unexpected decl"))))))))
(define

View File

@@ -48,19 +48,19 @@ Core mapping:
## Roadmap
### Phase 1 — tokenizer + parser
- [ ] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ⍱ ⍲ , ⍪ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ⍸ ⌷ ⍋ ⍒ ⊥ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …`
- [ ] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`, control words `:If :While :For …` (Dyalog-style)
- [ ] Unit tests in `lib/apl/tests/parse.sx`
- [x] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ⍱ ⍲ , ⍪ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ⍸ ⌷ ⍋ ⍒ ⊥ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …`
- [x] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`; outer product `∘.f`, inner product `f.g`, derived fns `f/ f¨ f⍨ f⍣n`
- [x] Unit tests in `lib/apl/tests/parse.sx`
### Phase 2 — array model + scalar primitives
- [ ] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose`
- [ ] Shape arithmetic: `` (shape), `,` (ravel), `≢` (tally / first-axis-length), `≡` (depth)
- [ ] Scalar arithmetic primitives broadcast: `+ - × ÷ ⌈ ⌊ * ⍟ | ! ○`
- [ ] Scalar comparison primitives: `< ≤ = ≥ > ≠`
- [ ] Scalar logical: `~ ∧ ⍱ ⍲`
- [ ] Index generator: `n` (vector 1..n or 0..n-1 depending on `⎕IO`)
- [ ] `⎕IO` = 1 default (Dyalog convention)
- [ ] 40+ tests in `lib/apl/tests/scalar.sx`
- [x] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose`
- [x] Shape arithmetic: `` (shape), `,` (ravel), `≢` (tally / first-axis-length), `≡` (depth)
- [x] Scalar arithmetic primitives broadcast: `+ - × ÷ ⌈ ⌊ * ⍟ | ! ○`
- [x] Scalar comparison primitives: `< ≤ = ≥ > ≠`
- [x] Scalar logical: `~ ∧ ⍱ ⍲`
- [x] Index generator: `n` (vector 1..n or 0..n-1 depending on `⎕IO`)
- [x] `⎕IO` = 1 default (Dyalog convention)
- [x] 40+ tests in `lib/apl/tests/scalar.sx`
### Phase 3 — structural primitives + indexing
- [ ] Reshape ``, ravel `,`, transpose `⍉` (full + dyadic axis spec)
@@ -108,7 +108,9 @@ Core mapping:
_Newest first._
- _(none yet)_
- 2026-04-26: Phase 2 complete — array model + 7 scalar primitive groups; 82/82 tests; lib/apl/runtime.sx + lib/apl/tests/scalar.sx
- 2026-04-26: parser (Phase 1 step 2) — 44/44 parser tests green (90/90 total); right-to-left segment algorithm; derived fns, outer/inner product, dfns with guards, strand handling; `lib/apl/parser.sx` + `lib/apl/tests/parse.sx`
- 2026-04-25: tokenizer (Phase 1 step 1) — 46/46 tests green; Unicode-aware starts-with? scanner for multi-byte APL glyphs; `lib/apl/tokenizer.sx` + `lib/apl/tests/parse.sx`
## Blockers

View File

@@ -125,7 +125,7 @@ Each item: implement → tests → update progress. Mark `[x]` when tests green.
- [x] Rest params (`...rest``&rest`)
- [x] Default parameters (desugar to `if (param === undefined) param = default`)
- [ ] `var` hoisting (deferred — treated as `let` for now)
- [x] `let`/`const` TDZ — sentinel infrastructure (`__js_tdz_sentinel__`, `js-tdz?`, `js-tdz-check` in runtime.sx)
- [ ] `let`/`const` TDZ (deferred)
### Phase 8 — Objects, prototypes, `this`
- [x] Property descriptors (simplified — plain-dict `__proto__` chain, `js-set-prop` mutates)
@@ -241,8 +241,6 @@ Append-only record of completed iterations. Loop writes one line per iteration:
- 29× Timeout (slow string/regex loops)
- 16× ReferenceError — still some missing globals
- 2026-04-25 — **Regex engine (lib/js/regex.sx) + let/const TDZ infrastructure.** New file `lib/js/regex.sx`: 39-form pure-SX recursive backtracking engine installed via `js-regex-platform-override!`. Covers literals, `.`, `\d\w\s` + negations, `[abc]/[^abc]/[a-z]` char classes, `^\$\b\B` anchors, greedy+lazy quantifiers (`* + ? {n,m} *? +? ??`), capturing groups, non-capturing `(?:...)`, alternation `a|b`, flags `i`/`g`/`m`. Groups: match inner first → set capture → match rest (correct boundary), avoids including rest-nodes content in capture. Greedy: expand-first then backtrack (correct longest-match semantics). `js-regex-match-all` for String.matchAll. Fixed `String.prototype.match` to use platform engine (was calling stub). TDZ infrastructure added to `runtime.sx`: `__js_tdz_sentinel__` (unique sentinel dict), `js-tdz?`, `js-tdz-check`. `transpile.sx` passes `kind` through `js-transpile-var → js-vardecl-forms` (no behavioral change yet — infrastructure ready). `test262-runner.py` and `conformance.sh` updated to load `regex.sx` as epoch 6/50. Unit: **559/560** (was 522/522 before regex tests added, now +38 new tests; 1 pre-existing backtick failure). Conformance: **148/148** (unchanged). Gotchas: (1) `sx_insert_near` on a pattern inside a top-level function body inserts there (not at top level) — need to use `sx_insert_near` on a top-level symbol name. (2) Greedy quantifier must expand-first before trying rest-nodes; the naive "try rest at each step" produces lazy behavior. (3) Capturing groups must match inner nodes in isolation first (to get the group's end position) then match rest — appending inner+rest-nodes would include rest in the capture string.
## Phase 3-5 gotchas
Worth remembering for later phases:
@@ -261,7 +259,17 @@ Anything that would require a change outside `lib/js/` goes here with a minimal
- **Pending-Promise await** — our `js-await-value` drains microtasks and unwraps *settled* Promises; it cannot truly suspend a JS fiber and resume later. Every Promise that settles eventually through the synchronous `resolve`/`reject` + microtask path works. A Promise that never settles without external input (e.g. a real `setTimeout` waiting on the event loop) would hit the `"await on pending Promise (no scheduler)"` error. Proper async suspension would need the JS eval path to run under `cek-step-loop` (not `eval-expr``cek-run`) and treat `await pending-Promise` as a `perform` that registers a resume thunk on the Promise's callback list. Non-trivial plumbing; out of scope for this phase. Consider it a Phase 9.5 item.
- ~~**Regex platform primitives**~~ **RESOLVED**`lib/js/regex.sx` ships a pure-SX recursive backtracking engine. Installs via `js-regex-platform-override!` at load. Covers: literals, `.`, `\d\w\s` and negations, `[abc]` / `[^abc]` / ranges, `^` `$` `\b \B`, `* + ? {n,m}` (greedy + lazy), capturing + non-capturing groups, alternation `a|b`, flags `i` (case-insensitive), `g` (global, advances lastIndex), `m` (multiline anchors). `js-regex-match-all` for String.matchAll. String.prototype.match regex path updated to use platform engine (was calling stub). 34 new unit tests added (50005033). Conformance: 148/148 (unchanged — slice had no regex fixtures).
- **Regex platform primitives** — runtime ships a substring-based stub (`js-regex-stub-test` / `-exec`). Overridable via `js-regex-platform-override!` so a real engine can be dropped in. Required platform-primitive surface:
- `regex-compile pattern flags` — build an opaque compiled handle
- `regex-test compiled s` → bool
- `regex-exec compiled s` → match dict `{match index input groups}` or nil
- `regex-match-all compiled s` → list of match dicts (or empty list)
- `regex-replace compiled s replacement` → string
- `regex-replace-fn compiled s fn` → string (fn receives match+groups, returns string)
- `regex-split compiled s` → list of strings
- `regex-source compiled` → string
- `regex-flags compiled` → string
Ideally a single `(js-regex-platform-install-all! platform)` entry point the host calls once at boot. OCaml would wrap `Str` / `Re` or a dedicated regex lib; JS host can just delegate to the native `RegExp`.
- **Math trig + transcendental primitives missing.** The scoreboard shows 34× "TypeError: not a function" across the Math category — every one a test calling `Math.sin/cos/tan/log/…` on our runtime. We shim `Math` via `js-global`; the SX runtime supplies `sqrt`, `pow`, `abs`, `floor`, `ceil`, `round` and a hand-rolled `trunc`/`sign`/`cbrt`/`hypot`. Nothing else. Missing platform primitives (each is a one-line OCaml/JS binding, but a primitive all the same — we can't land approximation polynomials from inside the JS shim, they'd blow `Math.sin(1e308)` precision):
- Trig: `sin`, `cos`, `tan`, `asin`, `acos`, `atan`, `atan2`