A multi-parameter datatype all the way through

5 files changed, 62 insertions, 33 deletions

diff --git a/src/core_print.sml b/src/core_print.sml
index e4eae55e..52c7648d 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -199,13 +199,15 @@ fun p_exp' par env (e, _) =
               string (#1 (E.lookupERel env n)))
          handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
       | ENamed n => p_enamed env n
-      | ECon (_, pc, _, NONE) => box [string "[",
-                                      p_patCon env pc,
-                                      string "]"]
-      | ECon (_, pc, _, SOME e) => box [string "[",
+      | ECon (_, pc, ts, NONE) => box [string "[",
+                                       p_patCon env pc,
+                                       p_list_sep (box []) (fn t => box [space, string "[", p_con env t, string "]"]) ts,
+                                       string "]"]
+      | ECon (_, pc, ts, SOME e) => box [string "[",
                                         p_patCon env pc,
                                         space,
                                         p_exp' true env e,
+                                        p_list_sep (box []) (fn t => box [space, string "[", p_con env t, string "]"]) ts,
                                         string "]"]
       | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
       | EFfiApp (m, x, es) => box [string "FFI(",
diff --git a/src/corify.sml b/src/corify.sml
index 075939bf..9c350aee 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -534,11 +534,12 @@ structure St : sig
 
              val dk = CoreUtil.classifyDatatype xncs
              val t = (L'.CNamed n, loc)
-             val t = ListUtil.foldli (fn (i, _, t) => (L'.CApp (t, (L'.CRel i, loc)), loc)) t xs
+             val nxs = length xs - 1
+             val t = ListUtil.foldli (fn (i, _, t) => (L'.CApp (t, (L'.CRel (nxs - i), loc)), loc)) t xs
              val k = (L'.KType, loc)
              val dcons = map (fn (x, n, to) =>
                                  let
-                                     val args = ListUtil.mapi (fn (i, _) => (L'.CRel i, loc)) xs
+                                     val args = ListUtil.mapi (fn (i, _) => (L'.CRel (nxs - i), loc)) xs
                                      val (e, t) =
                                          case to of
                                              NONE => ((L'.ECon (dk, L'.PConVar n, args, NONE), loc), t)
@@ -575,7 +576,8 @@ structure St : sig
                                                         ((x, n, co), st)
                                                     end) st xncs
 
-             val c = ListUtil.foldli (fn (i, _, c) => (L'.CApp (c, (L'.CRel i, loc)), loc)) c xs
+             val nxs = length xs - 1
+             val c = ListUtil.foldli (fn (i, _, c) => (L'.CApp (c, (L'.CRel (nxs - i), loc)), loc)) c xs
              val k = (L'.KType, loc)
              val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
 
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 94c51701..976db303 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -954,7 +954,8 @@ fun elabPat (pAll as (p, loc), (env, denv, bound)) =
 
                     val k = (L'.KType, loc)
                     val unifs = map (fn _ => cunif (loc, k)) xs
-                    val t = ListUtil.foldli (fn (i, u, t) => subConInCon (i, u) t) t unifs
+                    val nxs = length unifs - 1
+                    val t = ListUtil.foldli (fn (i, u, t) => subConInCon (nxs - i, u) t) t unifs
                     val dn = foldl (fn (u, dn) => (L'.CApp (dn, u), loc)) dn unifs
                 in
                     ignore (checkPatCon (env, denv) p' pt t);
@@ -1600,7 +1601,8 @@ fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
             val (env, n) = E.pushCNamed env x k' NONE
             val t = (L'.CNamed n, loc)
-            val t = ListUtil.foldli (fn (i, _, t) => (L'.CApp (t, (L'.CRel i, loc)), loc)) t xs
+            val nxs = length xs - 1
+            val t = ListUtil.foldli (fn (i, _, t) => (L'.CApp (t, (L'.CRel (nxs - i), loc)), loc)) t xs
 
             val (xcs, (used, env, gs)) =
                 ListUtil.foldlMap
@@ -2269,7 +2271,8 @@ fun elabDecl ((d, loc), (env, denv, gs)) =
             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
             val (env, n) = E.pushCNamed env x k' NONE
             val t = (L'.CNamed n, loc)
-            val t = ListUtil.foldli (fn (i, _, t) => (L'.CApp (t, (L'.CRel i, loc)), loc)) t xs
+            val nxs = length xs - 1
+            val t = ListUtil.foldli (fn (i, _, t) => (L'.CApp (t, (L'.CRel (nxs - i), loc)), loc)) t xs
 
             val (env', denv') = foldl (fn (x, (env', denv')) =>
                                           (E.pushCRel env' x k,
diff --git a/src/specialize.sml b/src/specialize.sml
index 9690f6e7..c8af5199 100644
--- a/src/specialize.sml
+++ b/src/specialize.sml
@@ -77,10 +77,13 @@ fun considerSpecialization (st : state, n, args, dt : datatyp) =
         SOME dt' => (#name dt', #constructors dt', st)
       | NONE =>
         let
+            (*val () = Print.prefaces "Args" [("args", Print.p_list (CorePrint.p_con CoreEnv.empty) args)]*)
+
             val n' = #count st
 
+            val nxs = length args - 1
             fun sub t = ListUtil.foldli (fn (i, arg, t) =>
-                                            subConInCon (i, arg) t) t args
+                                            subConInCon (nxs - i, arg) t) t args
 
             val (cons, (count, cmap)) =
                 ListUtil.foldlMap (fn ((x, n, to), (count, cmap)) =>
@@ -240,28 +243,32 @@ val specDecl = U.Decl.foldMap {kind = kind, con = con, exp = exp, decl = decl}
 fun specialize file =
     let
         fun doDecl (all as (d, _), st : state) =
-            case d of
-                DDatatype (x, n, xs, xnts) =>
-                ([all], {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,
-                         decls = []})
-              | _ =>
-                let
-                    val (d, st) = specDecl st all
-                in
-                    (rev (d :: #decls st),
-                     {count = #count st,
-                      datatypes = #datatypes st,
-                      constructors = #constructors st,
-                      decls = []})
-                end
+            let
+                (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*)
+            in
+                case d of
+                    DDatatype (x, n, xs, xnts) =>
+                    ([all], {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,
+                             decls = []})
+                  | _ =>
+                    let
+                        val (d, st) = specDecl st all
+                    in
+                        (rev (d :: #decls st),
+                         {count = #count st,
+                          datatypes = #datatypes st,
+                          constructors = #constructors st,
+                          decls = []})
+                    end
+            end
 
         val (ds, _) = ListUtil.foldlMapConcat doDecl
                       {count = U.File.maxName file + 1,
diff --git a/tests/datatypeP2.lac b/tests/datatypeP2.lac
new file mode 100644
index 00000000..09cc964a
--- /dev/null
+++ b/tests/datatypeP2.lac
@@ -0,0 +1,15 @@
+datatype sum a b = Left of a | Right of b
+
+val l : sum int string = Left 5
+val r : sum int string = Right "Hi"
+
+val show = fn x : sum int string => case x of Left _ => "Left _" | Right s => s
+
+val page = fn x => <html><body>
+        {cdata (show x)}
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li><a link={page l}>Left</a></li>
+        <li><a link={page r}>Right</a></li>
+</body></html>