giles
99753580b4
Salvaged from worktree-agent-* branches killed during sx-tree MCP outage: - lua: tokenizer + parser + phase-2 transpile (~157 tests) - prolog: tokenizer + parser + unification (72 tests, plan update lost to WIP) - forth: phase-1 reader/interpreter + phase-2 colon/VARIABLE (134 tests) - erlang: tokenizer + parser (114 tests) - haskell: tokenizer + parse tests (43 tests) Cherry-picked file contents only, not branch history, to avoid pulling in unrelated ocaml-vm merge commits that were in those branches' bases.
231 lines
11 KiB
Plaintext
231 lines
11 KiB
Plaintext
;; Erlang parser tests
|
|
|
|
(define er-parse-test-count 0)
|
|
(define er-parse-test-pass 0)
|
|
(define er-parse-test-fails (list))
|
|
|
|
(define
|
|
deep=
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
(and (= (type-of a) "dict") (= (type-of b) "dict"))
|
|
(let
|
|
((ka (sort (keys a))) (kb (sort (keys b))))
|
|
(and (= ka kb) (every? (fn (k) (deep= (get a k) (get b k))) ka)))
|
|
(and (= (type-of a) "list") (= (type-of b) "list"))
|
|
(and
|
|
(= (len a) (len b))
|
|
(every? (fn (i) (deep= (nth a i) (nth b i))) (range 0 (len a))))
|
|
:else (= a b))))
|
|
|
|
(define
|
|
er-parse-test
|
|
(fn
|
|
(name actual expected)
|
|
(set! er-parse-test-count (+ er-parse-test-count 1))
|
|
(if
|
|
(deep= actual expected)
|
|
(set! er-parse-test-pass (+ er-parse-test-pass 1))
|
|
(append! er-parse-test-fails {:actual actual :expected expected :name name}))))
|
|
(define pe er-parse-expr)
|
|
|
|
;; ── literals ──────────────────────────────────────────────────────
|
|
(define pm er-parse-module)
|
|
|
|
(er-parse-test "int" (pe "42") {:value "42" :type "integer"})
|
|
|
|
(er-parse-test "float" (pe "3.14") {:value "3.14" :type "float"})
|
|
|
|
(er-parse-test "atom" (pe "foo") {:value "foo" :type "atom"})
|
|
|
|
(er-parse-test "quoted atom" (pe "'Hello'") {:value "Hello" :type "atom"})
|
|
|
|
(er-parse-test "var" (pe "X") {:type "var" :name "X"})
|
|
|
|
(er-parse-test "wildcard" (pe "_") {:type "var" :name "_"})
|
|
|
|
(er-parse-test "string" (pe "\"hello\"") {:value "hello" :type "string"})
|
|
|
|
;; ── tuples ────────────────────────────────────────────────────────
|
|
(er-parse-test "nil list" (pe "[]") {:type "nil"})
|
|
|
|
(er-parse-test "empty tuple" (pe "{}") {:elements (list) :type "tuple"})
|
|
|
|
(er-parse-test "pair" (pe "{ok, 1}") {:elements (list {:value "ok" :type "atom"} {:value "1" :type "integer"}) :type "tuple"})
|
|
|
|
;; ── lists ─────────────────────────────────────────────────────────
|
|
(er-parse-test "triple" (pe "{a, b, c}") {:elements (list {:value "a" :type "atom"} {:value "b" :type "atom"} {:value "c" :type "atom"}) :type "tuple"})
|
|
|
|
(er-parse-test "list [1]" (pe "[1]") {:head {:value "1" :type "integer"} :tail {:type "nil"} :type "cons"})
|
|
|
|
(er-parse-test "cons [H|T]" (pe "[H|T]") {:head {:type "var" :name "H"} :tail {:type "var" :name "T"} :type "cons"})
|
|
|
|
;; ── operators / precedence ────────────────────────────────────────
|
|
(er-parse-test "list [1,2]" (pe "[1,2]") {:head {:value "1" :type "integer"} :tail {:head {:value "2" :type "integer"} :tail {:type "nil"} :type "cons"} :type "cons"})
|
|
|
|
(er-parse-test "add" (pe "1 + 2") {:args (list {:value "1" :type "integer"} {:value "2" :type "integer"}) :type "op" :op "+"})
|
|
|
|
(er-parse-test "mul binds tighter" (pe "1 + 2 * 3") {:args (list {:value "1" :type "integer"} {:args (list {:value "2" :type "integer"} {:value "3" :type "integer"}) :type "op" :op "*"}) :type "op" :op "+"})
|
|
|
|
(er-parse-test "parens" (pe "(1 + 2) * 3") {:args (list {:args (list {:value "1" :type "integer"} {:value "2" :type "integer"}) :type "op" :op "+"} {:value "3" :type "integer"}) :type "op" :op "*"})
|
|
|
|
(er-parse-test "neg unary" (pe "-5") {:arg {:value "5" :type "integer"} :type "unop" :op "-"})
|
|
|
|
(er-parse-test "not" (pe "not X") {:arg {:type "var" :name "X"} :type "unop" :op "not"})
|
|
|
|
(er-parse-test "match" (pe "X = 42") {:rhs {:value "42" :type "integer"} :type "match" :lhs {:type "var" :name "X"}})
|
|
|
|
(er-parse-test "cmp" (pe "X > 0") {:args (list {:type "var" :name "X"} {:value "0" :type "integer"}) :type "op" :op ">"})
|
|
|
|
(er-parse-test "eq =:=" (pe "X =:= 1") {:args (list {:type "var" :name "X"} {:value "1" :type "integer"}) :type "op" :op "=:="})
|
|
|
|
(er-parse-test "send" (pe "Pid ! hello") {:msg {:value "hello" :type "atom"} :type "send" :to {:type "var" :name "Pid"}})
|
|
|
|
(er-parse-test "andalso" (pe "X andalso Y") {:args (list {:type "var" :name "X"} {:type "var" :name "Y"}) :type "op" :op "andalso"})
|
|
|
|
(er-parse-test "orelse" (pe "X orelse Y") {:args (list {:type "var" :name "X"} {:type "var" :name "Y"}) :type "op" :op "orelse"})
|
|
|
|
(er-parse-test "++" (pe "A ++ B") {:args (list {:type "var" :name "A"} {:type "var" :name "B"}) :type "op" :op "++"})
|
|
|
|
(er-parse-test "div" (pe "10 div 3") {:args (list {:value "10" :type "integer"} {:value "3" :type "integer"}) :type "op" :op "div"})
|
|
|
|
;; ── calls ─────────────────────────────────────────────────────────
|
|
(er-parse-test "rem" (pe "10 rem 3") {:args (list {:value "10" :type "integer"} {:value "3" :type "integer"}) :type "op" :op "rem"})
|
|
|
|
(er-parse-test "local call 0-arity" (pe "self()") {:args (list) :fun {:value "self" :type "atom"} :type "call"})
|
|
|
|
(er-parse-test "local call 2-arg" (pe "foo(1, 2)") {:args (list {:value "1" :type "integer"} {:value "2" :type "integer"}) :fun {:value "foo" :type "atom"} :type "call"})
|
|
|
|
;; ── if / case / receive / fun / try ───────────────────────────────
|
|
(er-parse-test "remote call" (pe "lists:map(F, L)") {:args (list {:type "var" :name "F"} {:type "var" :name "L"}) :fun {:fun {:value "map" :type "atom"} :mod {:value "lists" :type "atom"} :type "remote"} :type "call"})
|
|
|
|
(er-parse-test "if-else" (pe "if X > 0 -> pos; true -> neg end") {:clauses (list {:body (list {:value "pos" :type "atom"}) :guards (list (list {:args (list {:type "var" :name "X"} {:value "0" :type "integer"}) :type "op" :op ">"}))} {:body (list {:value "neg" :type "atom"}) :guards (list (list {:value "true" :type "atom"}))}) :type "if"})
|
|
|
|
(er-parse-test
|
|
"case 2-clause"
|
|
(pe "case X of 0 -> zero; _ -> nz end")
|
|
{:expr {:type "var" :name "X"} :clauses (list {:pattern {:value "0" :type "integer"} :body (list {:value "zero" :type "atom"}) :guards (list)} {:pattern {:type "var" :name "_"} :body (list {:value "nz" :type "atom"}) :guards (list)}) :type "case"})
|
|
|
|
(er-parse-test
|
|
"case with guard"
|
|
(pe "case X of N when N > 0 -> pos; _ -> other end")
|
|
{:expr {:type "var" :name "X"} :clauses (list {:pattern {:type "var" :name "N"} :body (list {:value "pos" :type "atom"}) :guards (list (list {:args (list {:type "var" :name "N"} {:value "0" :type "integer"}) :type "op" :op ">"}))} {:pattern {:type "var" :name "_"} :body (list {:value "other" :type "atom"}) :guards (list)}) :type "case"})
|
|
|
|
(er-parse-test "receive one clause" (pe "receive X -> X end") {:clauses (list {:pattern {:type "var" :name "X"} :body (list {:type "var" :name "X"}) :guards (list)}) :type "receive" :after-ms nil :after-body (list)})
|
|
|
|
(er-parse-test
|
|
"receive after"
|
|
(pe "receive X -> X after 1000 -> timeout end")
|
|
{:clauses (list {:pattern {:type "var" :name "X"} :body (list {:type "var" :name "X"}) :guards (list)}) :type "receive" :after-ms {:value "1000" :type "integer"} :after-body (list {:value "timeout" :type "atom"})})
|
|
|
|
(er-parse-test
|
|
"receive just after"
|
|
(pe "receive after 0 -> ok end")
|
|
{:clauses (list) :type "receive" :after-ms {:value "0" :type "integer"} :after-body (list {:value "ok" :type "atom"})})
|
|
|
|
(er-parse-test
|
|
"anonymous fun 1-clause"
|
|
(pe "fun (X) -> X * 2 end")
|
|
{:clauses (list {:patterns (list {:type "var" :name "X"}) :body (list {:args (list {:type "var" :name "X"} {:value "2" :type "integer"}) :type "op" :op "*"}) :guards (list) :name nil}) :type "fun"})
|
|
|
|
(er-parse-test "begin/end block" (pe "begin 1, 2, 3 end") {:exprs (list {:value "1" :type "integer"} {:value "2" :type "integer"} {:value "3" :type "integer"}) :type "block"})
|
|
|
|
(er-parse-test "try/catch" (pe "try foo() catch error:X -> X end") {:exprs (list {:args (list) :fun {:value "foo" :type "atom"} :type "call"}) :catch-clauses (list {:pattern {:type "var" :name "X"} :body (list {:type "var" :name "X"}) :class {:value "error" :type "atom"} :guards (list)}) :type "try" :of-clauses (list) :after (list)})
|
|
|
|
;; ── module-level ──────────────────────────────────────────────────
|
|
(er-parse-test
|
|
"try catch default class"
|
|
(pe "try foo() catch X -> X end")
|
|
{:exprs (list {:args (list) :fun {:value "foo" :type "atom"} :type "call"}) :catch-clauses (list {:pattern {:type "var" :name "X"} :body (list {:type "var" :name "X"}) :class {:value "throw" :type "atom"} :guards (list)}) :type "try" :of-clauses (list) :after (list)})
|
|
|
|
(er-parse-test "minimal module" (pm "-module(m).\nfoo(X) -> X.") {:functions (list {:arity 1 :clauses (list {:patterns (list {:type "var" :name "X"}) :body (list {:type "var" :name "X"}) :guards (list) :name "foo"}) :type "function" :name "foo"}) :type "module" :attrs (list) :name "m"})
|
|
|
|
(er-parse-test
|
|
"module with export"
|
|
(let
|
|
((m (pm "-module(m).\n-export([foo/1]).\nfoo(X) -> X.")))
|
|
(list
|
|
(get m :name)
|
|
(len (get m :attrs))
|
|
(get (nth (get m :attrs) 0) :name)
|
|
(len (get m :functions))))
|
|
(list "m" 1 "export" 1))
|
|
|
|
(er-parse-test
|
|
"two-clause function"
|
|
(let
|
|
((m (pm "-module(m).\nf(0) -> z; f(N) -> n.")))
|
|
(list (len (get (nth (get m :functions) 0) :clauses))))
|
|
(list 2))
|
|
|
|
(er-parse-test
|
|
"multi-arg function"
|
|
(let
|
|
((m (pm "-module(m).\nadd(X, Y) -> X + Y.")))
|
|
(list (get (nth (get m :functions) 0) :arity)))
|
|
(list 2))
|
|
|
|
(er-parse-test
|
|
"zero-arity"
|
|
(let
|
|
((m (pm "-module(m).\npi() -> 3.14.")))
|
|
(list (get (nth (get m :functions) 0) :arity)))
|
|
(list 0))
|
|
|
|
(er-parse-test
|
|
"function with guard"
|
|
(let
|
|
((m (pm "-module(m).\nabs(N) when N < 0 -> -N; abs(N) -> N.")))
|
|
(list
|
|
(len (get (nth (get m :functions) 0) :clauses))
|
|
(len
|
|
(get (nth (get (nth (get m :functions) 0) :clauses) 0) :guards))))
|
|
(list 2 1))
|
|
|
|
;; ── combined programs ────────────────────────────────────────────
|
|
(er-parse-test
|
|
"three-function module"
|
|
(let
|
|
((m (pm "-module(m).\na() -> 1.\nb() -> 2.\nc() -> 3.")))
|
|
(list
|
|
(len (get m :functions))
|
|
(get (nth (get m :functions) 0) :name)
|
|
(get (nth (get m :functions) 1) :name)
|
|
(get (nth (get m :functions) 2) :name)))
|
|
(list 3 "a" "b" "c"))
|
|
|
|
(er-parse-test
|
|
"factorial"
|
|
(let
|
|
((m (pm "-module(fact).\n-export([fact/1]).\nfact(0) -> 1;\nfact(N) -> N * fact(N - 1).")))
|
|
(list
|
|
(get m :name)
|
|
(get (nth (get m :functions) 0) :arity)
|
|
(len (get (nth (get m :functions) 0) :clauses))))
|
|
(list "fact" 1 2))
|
|
|
|
(er-parse-test
|
|
"ping-pong snippet"
|
|
(let
|
|
((e (pe "receive ping -> Sender ! pong end")))
|
|
(list (get e :type) (len (get e :clauses))))
|
|
(list "receive" 1))
|
|
|
|
(er-parse-test
|
|
"case with nested tuple"
|
|
(let
|
|
((e (pe "case X of {ok, V} -> V; error -> 0 end")))
|
|
(list (get e :type) (len (get e :clauses))))
|
|
(list "case" 2))
|
|
|
|
;; ── summary ──────────────────────────────────────────────────────
|
|
(er-parse-test
|
|
"deep expression"
|
|
(let ((e (pe "A + B * C - D / E"))) (get e :op))
|
|
"-")
|
|
|
|
(define
|
|
er-parse-test-summary
|
|
(str "parser " er-parse-test-pass "/" er-parse-test-count))
|