erlang: pattern matching + case (+21 tests)

lib/erlang/tests/eval.sx

@@ -123,6 +123,57 @@
   (ev "X = 5, if X > 0 -> 1; true -> 0 end")
   1)
 
+;; ── pattern matching ─────────────────────────────────────────────
+(er-eval-test "match atom literal" (nm (ev "ok = ok, done")) "done")
+(er-eval-test "match int literal" (ev "5 = 5, 42") 42)
+(er-eval-test "match tuple bind"
+  (ev "{ok, V} = {ok, 99}, V") 99)
+(er-eval-test "match tuple nested"
+  (ev "{A, {B, C}} = {1, {2, 3}}, A + B + C") 6)
+(er-eval-test "match cons head"
+  (ev "[H|T] = [1, 2, 3], H") 1)
+(er-eval-test "match cons tail head"
+  (ev "[_, H|_] = [1, 2, 3], H") 2)
+(er-eval-test "match nil"
+  (ev "[] = [], 7") 7)
+(er-eval-test "match wildcard always"
+  (ev "_ = 42, 7") 7)
+(er-eval-test "match var reuse equal"
+  (ev "X = 5, X = 5, X") 5)
+
+;; ── case ─────────────────────────────────────────────────────────
+(er-eval-test "case bind" (ev "case 5 of N -> N end") 5)
+(er-eval-test "case tuple"
+  (ev "case {ok, 42} of {ok, V} -> V end") 42)
+(er-eval-test "case cons"
+  (ev "case [1, 2, 3] of [H|_] -> H end") 1)
+(er-eval-test "case fallthrough"
+  (ev "case error of ok -> 1; error -> 2 end") 2)
+(er-eval-test "case wildcard"
+  (nm (ev "case x of ok -> ok; _ -> err end"))
+  "err")
+(er-eval-test "case guard"
+  (ev "case 5 of N when N > 0 -> pos; _ -> neg end")
+  (er-mk-atom "pos"))
+(er-eval-test "case guard fallthrough"
+  (ev "case -3 of N when N > 0 -> pos; _ -> neg end")
+  (er-mk-atom "neg"))
+(er-eval-test "case bound re-match"
+  (ev "X = 5, case 5 of X -> same; _ -> diff end")
+  (er-mk-atom "same"))
+(er-eval-test "case bound re-match fail"
+  (ev "X = 5, case 6 of X -> same; _ -> diff end")
+  (er-mk-atom "diff"))
+(er-eval-test "case nested tuple"
+  (ev "case {ok, {value, 42}} of {ok, {value, V}} -> V end")
+  42)
+(er-eval-test "case multi-clause"
+  (ev "case 2 of 1 -> one; 2 -> two; _ -> other end")
+  (er-mk-atom "two"))
+(er-eval-test "case leak binding"
+  (ev "case {ok, 7} of {ok, X} -> X end + 1")
+  8)
+
 (define
   er-eval-test-summary
   (str "eval " er-eval-test-pass "/" er-eval-test-count))

lib/erlang/transpile.sx

@@ -95,6 +95,7 @@
         (= ty "unop") (er-eval-unop node env)
         (= ty "block") (er-eval-body (get node :exprs) env)
         (= ty "if") (er-eval-if node env)
+        (= ty "case") (er-eval-case node env)
         (= ty "match") (er-eval-match node env)
         :else (error (str "Erlang eval: unsupported node type '" ty "'"))))))
 
@@ -130,7 +131,7 @@
       (er-eval-expr (get node :head) env)
       (er-eval-expr (get node :tail) env))))
 
-;; ── match (bare-var LHS only; full pattern matching comes next) ────
+;; ── match expression ─────────────────────────────────────────────
 (define
   er-eval-match
   (fn
@@ -138,20 +139,122 @@
     (let
       ((lhs (get node :lhs))
         (rhs-val (er-eval-expr (get node :rhs) env)))
+      (if
+        (er-match! lhs rhs-val env)
+        rhs-val
+        (error "Erlang: badmatch")))))
+
+;; ── pattern matching ─────────────────────────────────────────────
+;; Unifies PAT against VAL, binding fresh vars into ENV.
+;; Returns true on success, false otherwise. On failure ENV may hold
+;; partial bindings — callers trying multiple clauses must snapshot
+;; ENV and restore it between attempts.
+(define
+  er-match!
+  (fn
+    (pat val env)
+    (let
+      ((ty (get pat :type)))
       (cond
-        (= (get lhs :type) "var")
-        (let
-          ((name (get lhs :name)))
-          (cond
-            (= name "_") rhs-val
-            (dict-has? env name)
-            (if
-              (er-equal? (get env name) rhs-val)
-              rhs-val
-              (error "Erlang: badmatch (rebind mismatch)"))
-            :else (do (er-env-bind! env name rhs-val) rhs-val)))
-        :else (error
-          "Erlang: pattern matching not yet supported (next Phase 2 step)")))))
+        (= ty "var") (er-match-var pat val env)
+        (= ty "integer")
+        (and (= (type-of val) "number") (= (parse-number (get pat :value)) val))
+        (= ty "float")
+        (and (= (type-of val) "number") (= (parse-number (get pat :value)) val))
+        (= ty "atom") (and (er-atom? val) (= (get val :name) (get pat :value)))
+        (= ty "string")
+        (and (= (type-of val) "string") (= val (get pat :value)))
+        (= ty "nil") (er-nil? val)
+        (= ty "tuple") (er-match-tuple pat val env)
+        (= ty "cons") (er-match-cons pat val env)
+        :else (error (str "Erlang match: unsupported pattern type '" ty "'"))))))
+
+(define
+  er-match-var
+  (fn
+    (pat val env)
+    (let
+      ((name (get pat :name)))
+      (cond
+        (= name "_") true
+        (dict-has? env name) (er-equal? (get env name) val)
+        :else (do (er-env-bind! env name val) true)))))
+
+(define
+  er-match-tuple
+  (fn
+    (pat val env)
+    (and
+      (er-tuple? val)
+      (let
+        ((ps (get pat :elements)) (vs (get val :elements)))
+        (if (not (= (len ps) (len vs))) false (er-match-all ps vs 0 env))))))
+
+(define
+  er-match-all
+  (fn
+    (ps vs i env)
+    (if
+      (>= i (len ps))
+      true
+      (if
+        (er-match! (nth ps i) (nth vs i) env)
+        (er-match-all ps vs (+ i 1) env)
+        false))))
+
+(define
+  er-match-cons
+  (fn
+    (pat val env)
+    (and
+      (er-cons? val)
+      (and
+        (er-match! (get pat :head) (get val :head) env)
+        (er-match! (get pat :tail) (get val :tail) env)))))
+
+;; ── env snapshot / restore ────────────────────────────────────────
+(define
+  er-env-copy
+  (fn
+    (env)
+    (let
+      ((out {}))
+      (for-each (fn (k) (dict-set! out k (get env k))) (keys env))
+      out)))
+
+(define
+  er-env-restore!
+  (fn
+    (env snap)
+    (for-each (fn (k) (dict-delete! env k)) (keys env))
+    (for-each (fn (k) (dict-set! env k (get snap k))) (keys snap))))
+
+;; ── case ─────────────────────────────────────────────────────────
+(define
+  er-eval-case
+  (fn
+    (node env)
+    (let
+      ((subject (er-eval-expr (get node :expr) env)))
+      (er-eval-case-clauses (get node :clauses) 0 subject env))))
+
+(define
+  er-eval-case-clauses
+  (fn
+    (clauses i subject env)
+    (if
+      (>= i (len clauses))
+      (error "Erlang: case_clause: no matching clause")
+      (let
+        ((c (nth clauses i)) (snap (er-env-copy env)))
+        (if
+          (and
+            (er-match! (get c :pattern) subject env)
+            (er-eval-guards (get c :guards) env))
+          (er-eval-body (get c :body) env)
+          (do
+            (er-env-restore! env snap)
+            (er-eval-case-clauses clauses (+ i 1) subject env)))))))
 
 ;; ── operators ─────────────────────────────────────────────────────
 (define