apl: right-to-left parser + 44 tests (Phase 1, step 2)

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>

lib/apl/parser.sx

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

lib/apl/tests/parse.sx

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

lib/apl/tokenizer.sx

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

plans/apl-on-sx.md

@@ -48,9 +48,9 @@ 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 `⍝ …`
+- [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 `⍝ …`
-- [ ] 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)
+- [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`
-- [ ] Unit tests in `lib/apl/tests/parse.sx`
+- [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`
@@ -108,7 +108,8 @@ Core mapping:
 
 _Newest first._
 
-- _(none yet)_
+- 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