erlang: pattern matching + case (+21 tests)

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