Some standard library reorgs and additions; handle mutual datatypes better in Specialize

2 files changed, 26 insertions, 58 deletions

diff --git a/src/monoize.sml b/src/monoize.sml
index e0795b84..d3eb4874 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -778,47 +778,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                  (L'.TFfi ("Basis", "bool"), loc),
                                  (L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
              fm)
-          | L.ECApp ((L.EFfi ("Basis", "eq_option"), _), t) =>
-            let
-                val t = monoType env t
-                val t' = (L'.TOption t, loc)
-                val bool = (L'.TFfi ("Basis", "bool"), loc)
-            in
-                ((L'.EAbs ("f", (L'.TFun (t, (L'.TFun (t, bool), loc)), loc),
-                           (L'.TFun (t', (L'.TFun (t', bool), loc)), loc),
-                           (L'.EAbs ("x", t', (L'.TFun (t', bool), loc),
-                                     (L'.EAbs ("y", t', bool,
-                                               (L'.ECase ((L'.ERecord [("1", (L'.ERel 1, loc), t'),
-                                                                       ("2", (L'.ERel 0, loc), t')], loc),
-                                                          [((L'.PRecord [("1", (L'.PNone t, loc), t'),
-                                                                         ("2", (L'.PNone t, loc), t')], loc),
-                                                            (L'.ECon (L'.Enum, L'.PConFfi {mod = "Basis",
-                                                                                           datatyp = "bool",
-                                                                                           con = "True",
-                                                                                           arg = NONE},
-                                                                      NONE), loc)),
-                                                           ((L'.PRecord [("1", (L'.PSome (t,
-                                                                                          (L'.PVar ("x1",
-                                                                                                    t), loc)),
-                                                                                loc), t'),
-                                                                         ("2", (L'.PSome (t,
-                                                                                          (L'.PVar ("x2",
-                                                                                                    t), loc)),
-                                                                                loc), t')], loc),
-                                                            (L'.EApp ((L'.EApp ((L'.ERel 4, loc),
-                                                                                (L'.ERel 1, loc)), loc),
-                                                                      (L'.ERel 0, loc)), loc)),
-                                                           ((L'.PWild, loc),
-                                                            (L'.ECon (L'.Enum, L'.PConFfi {mod = "Basis",
-                                                                                           datatyp = "bool",
-                                                                                           con = "False",
-                                                                                           arg = NONE},
-                                                                      NONE), loc))],
-                                                          {disc = (L'.TRecord [("1", t'), ("2", t')], loc),
-                                                           result = (L'.TFfi ("Basis", "bool"), loc)}),
-                                                loc)), loc)), loc)), loc),
-                 fm)
-            end
 
           | L.ECApp ((L.EFfi ("Basis", "mkEq"), _), t) =>
             let
diff --git a/src/specialize.sml b/src/specialize.sml
index b0e0aeae..b740ec8c 100644
--- a/src/specialize.sml
+++ b/src/specialize.sml
@@ -61,7 +61,7 @@ type state = {
      count : int,
      datatypes : datatyp IM.map,
      constructors : int IM.map,
-     decls : decl list     
+     decls : (string * int * string list * (string * int * con option) list) list     
 }
 
 fun kind (k, st) = (k, st)
@@ -115,15 +115,15 @@ fun considerSpecialization (st : state, n, args, dt : datatyp) =
                                                        ((x, n, SOME t), st)
                                                    end) st cons
 
-            val d = (DDatatype [(#name dt ^ "_s",
-                                 n',
-                                 [],
-                                 cons)], #2 (List.hd args))
+            val dt = (#name dt ^ "_s",
+                      n',
+                      [],
+                      cons)
         in
             (n', cmap, {count = #count st,
                         datatypes = #datatypes st,
                         constructors = #constructors st,
-                        decls = d :: #decls st})
+                        decls = dt :: #decls st})
         end
 
 and con (c, st : state) =
@@ -246,22 +246,31 @@ fun specialize file =
             let
                 (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*)
                 val (d, st) = specDecl st d
+
+                val ds =
+                    case #decls st of
+                        [] => []
+                      | dts => [(DDatatype dts, #2 d)]
             in
                 case #1 d of
-                    DDatatype [(x, n, xs, xnts)] =>
-                    (rev (d :: #decls st),
+                    DDatatype dts =>
+                    (rev (d :: ds),
                      {count = #count st,
-                      datatypes = IM.insert (#datatypes st, n,
-                                             {name = x,
-                                              params = length xs,
-                                              constructors = xnts,
-                                              specializations = CM.empty}),
-                      constructors = foldl (fn ((_, n', _), constructors) =>
-                                               IM.insert (constructors, n', n))
-                                           (#constructors st) xnts,
+                      datatypes = foldl (fn ((x, n, xs, xnts), dts) =>
+                                            IM.insert (dts, n,
+                                                       {name = x,
+                                                        params = length xs,
+                                                        constructors = xnts,
+                                                        specializations = CM.empty}))
+                                        (#datatypes st) dts,
+                      constructors = foldl (fn ((x, n, xs, xnts), cs) =>
+                                               foldl (fn ((_, n', _), constructors) =>
+                                                         IM.insert (constructors, n', n))
+                                                     cs xnts)
+                                           (#constructors st) dts,
                       decls = []})
                   | _ =>
-                    (rev (d :: #decls st),
+                    (rev (d :: ds),
                      {count = #count st,
                       datatypes = #datatypes st,
                       constructors = #constructors st,