diff src/elaborate.sml @ 188:8e9f97508f0d

Datatype representation optimization
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 19:49:21 -0400
parents d11754ffe252
children aa54250f58ac
line wrap: on
line diff
--- a/src/elaborate.sml	Sun Aug 03 19:01:16 2008 -0400
+++ b/src/elaborate.sml	Sun Aug 03 19:49:21 2008 -0400
@@ -933,22 +933,21 @@
         val pterror = (perror, terror)
         val rerror = (pterror, (env, bound))
 
-        fun pcon (pc, po, to, dn) =
-
-                case (po, to) of
-                    (NONE, SOME _) => (expError env (PatHasNoArg loc);
-                                       rerror)
-                  | (SOME _, NONE) => (expError env (PatHasArg loc);
-                                       rerror)
-                  | (NONE, NONE) => (((L'.PCon (pc, NONE), loc), dn),
-                                     (env, bound))
-                  | (SOME p, SOME t) =>
-                    let
-                        val ((p', pt), (env, bound)) = elabPat (p, (env, denv, bound))
-                    in
-                        (((L'.PCon (pc, SOME p'), loc), dn),
-                         (env, bound))
-                    end
+        fun pcon (pc, po, to, dn, dk) =
+            case (po, to) of
+                (NONE, SOME _) => (expError env (PatHasNoArg loc);
+                                   rerror)
+              | (SOME _, NONE) => (expError env (PatHasArg loc);
+                                   rerror)
+              | (NONE, NONE) => (((L'.PCon (dk, pc, NONE), loc), dn),
+                                 (env, bound))
+              | (SOME p, SOME t) =>
+                let
+                    val ((p', pt), (env, bound)) = elabPat (p, (env, denv, bound))
+                in
+                    (((L'.PCon (dk, pc, SOME p'), loc), dn),
+                     (env, bound))
+                end
     in
         case p of
             L.PWild => (((L'.PWild, loc), cunif (loc, (L'.KType, loc))),
@@ -970,7 +969,7 @@
             (case E.lookupConstructor env x of
                  NONE => (expError env (UnboundConstructor (loc, [], x));
                           rerror)
-               | SOME (n, to, dn) => pcon (L'.PConVar n, po, to, (L'.CNamed dn, loc)))
+               | SOME (dk, n, to, dn) => pcon (L'.PConVar n, po, to, (L'.CNamed dn, loc), dk))
           | L.PCon (m1 :: ms, x, po) =>
             (case E.lookupStr env m1 of
                  NONE => (expError env (UnboundStrInExp (loc, m1));
@@ -986,7 +985,7 @@
                      case E.projectConstructor env {str = str, sgn = sgn, field = x} of
                          NONE => (expError env (UnboundConstructor (loc, m1 :: ms, x));
                                   rerror)
-                       | SOME (_, to, dn) => pcon (L'.PConProj (n, ms, x), po, to, dn)
+                       | SOME (dk, _, to, dn) => pcon (L'.PConProj (n, ms, x), po, to, dn, dk)
                  end)
 
           | L.PRecord (xps, flex) =>
@@ -1036,7 +1035,7 @@
                 in
                     case E.projectConstructor env {str = str, sgn = sgn, field = x} of
                         NONE => raise Fail "exhaustive: Can't project constructor"
-                      | SOME (n, _, _) => n
+                      | SOME (_, n, _, _) => n
                 end
 
         fun coverage (p, _) =
@@ -1044,8 +1043,8 @@
                 L'.PWild => Wild
               | L'.PVar _ => Wild
               | L'.PPrim _ => None
-              | L'.PCon (pc, NONE) => Datatype (IM.insert (IM.empty, pcCoverage pc, Wild))
-              | L'.PCon (pc, SOME p) => Datatype (IM.insert (IM.empty, pcCoverage pc, coverage p))
+              | L'.PCon (_, pc, NONE) => Datatype (IM.insert (IM.empty, pcCoverage pc, Wild))
+              | L'.PCon (_, pc, SOME p) => Datatype (IM.insert (IM.empty, pcCoverage pc, coverage p))
               | L'.PRecord xps => Record [foldl (fn ((x, p, _), fmap) =>
                                                     SM.insert (fmap, x, coverage p)) SM.empty xps]