Add case over int.

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