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