summaryrefslogtreecommitdiffstats
path: root/elab.sml
diff options
context:
space:
mode:
authorRose Hogenson <rosehogenson@posteo.net>2024-05-18 13:08:31 -0700
committerRose Hogenson <rosehogenson@posteo.net>2024-05-18 13:08:31 -0700
commit2581ac99323ead839964e9b5f2a799cf61fd5bdc (patch)
treea733c96894f4e8fb37dffb964f57fd39d9996d08 /elab.sml
parentFix case on datatype. (diff)
downloadsml-2581ac99323ead839964e9b5f2a799cf61fd5bdc.tar.zst
Allow pattern matching in function definitions.
Diffstat (limited to 'elab.sml')
-rw-r--r--elab.sml26
1 files changed, 26 insertions, 0 deletions
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])