giles
da8ba104a6
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>
341 lines
11 KiB
Plaintext
341 lines
11 KiB
Plaintext
(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))))
|