diff src/monoize.sml @ 188:8e9f97508f0d

Datatype representation optimization
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 19:49:21 -0400
parents 88d46972de53
children 3eb53c957d10
line wrap: on
line diff
--- a/src/monoize.sml	Sun Aug 03 19:01:16 2008 -0400
+++ b/src/monoize.sml	Sun Aug 03 19:49:21 2008 -0400
@@ -33,7 +33,7 @@
 structure L = Core
 structure L' = Mono
 
-val dummyTyp = (L'.TDatatype (0, []), E.dummySpan)
+val dummyTyp = (L'.TDatatype (L'.Enum, 0, []), E.dummySpan)
 
 fun monoName env (all as (c, loc)) =
     let
@@ -73,7 +73,7 @@
 
                 val xncs = map (fn (x, n, to) => (x, n, Option.map (monoType env) to)) xncs
             in
-                (L'.TDatatype (n, xncs), loc)
+                (L'.TDatatype (MonoUtil.classifyDatatype xncs, n, xncs), loc)
             end
           | L.CFfi mx => (L'.TFfi mx, loc)
           | L.CApp _ => poly ()
@@ -202,7 +202,7 @@
                     L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [e]), loc), fm)
                   | L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm)
 
-                  | L'.TDatatype (i, _) =>
+                  | L'.TDatatype (dk, i, _) =>
                     let
                         fun makeDecl n fm =
                             let
@@ -213,7 +213,7 @@
                                         (fn ((x, n, to), fm) =>
                                             case to of
                                                 NONE =>
-                                                (((L'.PCon (L'.PConVar n, NONE), loc),
+                                                (((L'.PCon (dk, L'.PConVar n, NONE), loc),
                                                   (L'.EPrim (Prim.String x), loc)),
                                                  fm)
                                               | SOME t =>
@@ -221,7 +221,7 @@
                                                     val t = monoType env t
                                                     val (arg, fm) = fooify fm ((L'.ERel 0, loc), t)
                                                 in
-                                                    (((L'.PCon (L'.PConVar n, SOME (L'.PVar ("a", t), loc)), loc),
+                                                    (((L'.PCon (dk, L'.PConVar n, SOME (L'.PVar ("a", t), loc)), loc),
                                                       (L'.EStrcat ((L'.EPrim (Prim.String (x ^ "/")), loc),
                                                                    arg), loc)),
                                                      fm)
@@ -289,15 +289,15 @@
 fun monoPatCon env pc =
     case pc of
         L.PConVar n => L'.PConVar n
-      | L.PConFfi {mod = m, datatyp, con, arg} => L'.PConFfi {mod = m, datatyp = datatyp, con = con,
-                                                              arg = Option.map (monoType env) arg}
+      | L.PConFfi {mod = m, datatyp, con, arg, ...} => L'.PConFfi {mod = m, datatyp = datatyp, con = con,
+                                                                   arg = Option.map (monoType env) arg}
 
 fun monoPat env (p, loc) =
     case p of
         L.PWild => (L'.PWild, loc)
       | L.PVar (x, t) => (L'.PVar (x, monoType env t), loc)
       | L.PPrim p => (L'.PPrim p, loc)
-      | L.PCon (pc, po) => (L'.PCon (monoPatCon env pc, Option.map (monoPat env) po), loc)
+      | L.PCon (dk, pc, po) => (L'.PCon (dk, monoPatCon env pc, Option.map (monoPat env) po), loc)
       | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc)
 
 fun monoExp (env, st, fm) (all as (e, loc)) =
@@ -311,7 +311,7 @@
             L.EPrim p => ((L'.EPrim p, loc), fm)
           | L.ERel n => ((L'.ERel n, loc), fm)
           | L.ENamed n => ((L'.ENamed n, loc), fm)
-          | L.ECon (pc, eo) =>
+          | L.ECon (dk, pc, eo) =>
             let
                 val (eo, fm) =
                     case eo of
@@ -323,7 +323,7 @@
                             (SOME e, fm)
                         end
             in
-                ((L'.ECon (monoPatCon env pc, eo), loc), fm)
+                ((L'.ECon (dk, monoPatCon env pc, eo), loc), fm)
             end
           | L.EFfi mx => ((L'.EFfi mx, loc), fm)
           | L.EFfiApp (m, x, es) =>