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