From 2581ac99323ead839964e9b5f2a799cf61fd5bdc Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rosehogenson@posteo.net>
Date: Sat, 18 May 2024 13:08:31 -0700
Subject: Allow pattern matching in function definitions.

---
 elab.sml | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

(limited to 'elab.sml')

diff --git a/elab.sml b/elab.sml
index eb168c5..2895894 100644
--- a/elab.sml
+++ b/elab.sml
@@ -330,6 +330,32 @@ struct
           Syntax.LFix ([(n, arg, fnBody)], elab env (Syntax.ELet (decls, body)))
         end
     | Syntax.ELet (Syntax.DValRec _ :: _, _) => raise Fail "invalid val rec"
+    | Syntax.ELet (Syntax.DFun (name, cases) :: decls, body) =>
+        let
+          val (ps1, _) = hd cases
+          val nPats = length ps1
+        in if not (List.all (fn (ps, _) => length ps = nPats) cases)
+        then raise Fail "clauses do not all have same number of patterns"
+        else let
+          val n = Gensym.new ()
+          val temps = List.tabulate (nPats, fn _ => Gensym.new ())
+          val env = bindVar name n env
+          val t = Gensym.new ()
+          val innerCase = elabCase env (Syntax.LVar t) (map (fn (ps, b) => (Syntax.PTuple ps, b)) cases)
+        in
+          Syntax.LFix
+            ( [ ( n
+                , hd temps
+                , foldr
+                    Syntax.LFn
+                    (Syntax.LApp (Syntax.LFn (t, innerCase), Syntax.LRecord (map Syntax.LVar temps)))
+                    (tl temps)
+                )
+              ]
+            , elab env (Syntax.ELet (decls, body))
+            )
+        end
+        end
     | Syntax.ELambda body =>
         let val v = Gensym.new ()
         in Syntax.LFn (v, elabCase env (Syntax.LVar v) [body])
-- 
cgit v1.3.1