summaryrefslogtreecommitdiffstats
path: root/elab.sml
diff options
context:
space:
mode:
Diffstat (limited to 'elab.sml')
-rw-r--r--elab.sml22
1 files changed, 14 insertions, 8 deletions
diff --git a/elab.sml b/elab.sml
index cc73c98..f6f2e38 100644
--- a/elab.sml
+++ b/elab.sml
@@ -39,17 +39,23 @@ struct
val v = Gensym.new ()
val env' =
case pat of
- Syntax.PWild => env
- | Syntax.PVar name => StringMap.insert name v env
+ Syntax.PVar name => StringMap.insert name v env
+ | _ => env
in Syntax.LFn (v, elab env' body)
end
| Syntax.ECase (expr, []) => raise Fail "nonexhaustive match"
- | Syntax.ECase (expr, (pat, body) :: rest) =>
- if not (null rest) then raise Fail "redundant match" else
- let val v = Gensym.new () in
- case pat of
- Syntax.PWild => Syntax.LApp (Syntax.LFn (v, elab env body), elab env expr)
- | Syntax.PVar name => Syntax.LApp (Syntax.LFn (v, elab (StringMap.insert name v env) body), elab env expr)
+ | Syntax.ECase (expr, arms) =>
+ let
+ fun go [] _ = raise Fail "nonexhaustive match"
+ | go ((Syntax.PWild, body) :: []) acc = Syntax.LSwitch (elab env expr, rev acc, elab env body)
+ | go ((Syntax.PVar name, body) :: []) acc =
+ let val v = Gensym.new () in
+ Syntax.LApp (Syntax.LFn (v, Syntax.LSwitch (Syntax.LVar v, rev acc, elab (StringMap.insert name v env) body)), elab env expr)
+ end
+ | go ((Syntax.PInt i, body) :: rest) acc =
+ go rest ((i, elab env body) :: acc)
+ | go _ _ = raise Fail "redundant match"
+ in go arms []
end
fun elaborate (p : Syntax.expr) : Syntax.lexp = elab StringMap.empty p