changeset 191:aa54250f58ac

Parametrized datatypes through explify
author Adam Chlipala <adamc@hcoop.net>
date Fri, 08 Aug 2008 10:28:32 -0400
parents 3eb53c957d10
children 9bbf4d383381
files src/corify.sml src/elab.sml src/elab_env.sig src/elab_env.sml src/elab_print.sml src/elab_util.sml src/elaborate.sml src/expl.sml src/expl_env.sml src/expl_print.sml src/expl_util.sml src/explify.sml src/lacweb.grm src/list_util.sig src/list_util.sml src/source.sml src/source_print.sml tests/datatypeP.lac
diffstat 18 files changed, 395 insertions(+), 198 deletions(-) [+]
line wrap: on
line diff
--- a/src/corify.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/corify.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -429,7 +429,7 @@
          L.PWild => (L'.PWild, loc)
        | L.PVar (x, t) => (L'.PVar (x, corifyCon st t), loc)
        | L.PPrim p => (L'.PPrim p, loc)
-       | L.PCon (dk, pc, po) => (L'.PCon (dk, corifyPatCon st pc, Option.map (corifyPat st) po), loc)
+       | L.PCon (dk, pc, ts, po) => raise Fail "Corify PCon" (*(L'.PCon (dk, corifyPatCon st pc, Option.map (corifyPat st) po), loc)*)
        | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, corifyPat st p, corifyCon st t)) xps), loc)
 
  fun corifyExp st (e, loc) =
@@ -512,8 +512,8 @@
          in
              ([(L'.DCon (x, n, corifyKind k, corifyCon st c), loc)], st)
          end
-       | L.DDatatype (x, n, xncs) =>
-         let
+       | L.DDatatype (x, n, xs, xncs) => raise Fail "Corify DDatatype"
+         (*let
              val (st, n) = St.bindCon st x n
              val (xncs, st) = ListUtil.foldlMap (fn ((x, n, co), st) =>
                                                     let
@@ -541,9 +541,9 @@
                                  end) xncs
          in
              ((L'.DDatatype (x, n, xncs), loc) :: dcons, st)
-         end
-       | L.DDatatypeImp (x, n, m1, ms, s, xncs) =>
-         let
+         end*)
+       | L.DDatatypeImp (x, n, m1, ms, s, xs, xncs) => raise Fail "Corify DDatatypeImp"
+         (*let
              val (st, n) = St.bindCon st x n
              val c = corifyCon st (L.CModProj (m1, ms, s), loc)
 
@@ -571,7 +571,7 @@
                                end) xncs
          in
              ((L'.DCon (x, n, (L'.KType, loc), c), loc) :: cds, st)
-         end
+         end*)
        | L.DVal (x, n, t, e) =>
          let
              val (st, n) = St.bindVal st x n
@@ -648,8 +648,8 @@
                                          st)
                                     end
 
-                                  | L.SgiDatatype (x, n, xnts) =>
-                                    let
+                                  | L.SgiDatatype (x, n, xs, xnts) => raise Fail "Corify FFI SgiDatatype"
+                                    (*let
                                         val dk = ExplUtil.classifyDatatype xnts
                                         val (st, n') = St.bindCon st x n
                                         val (xnts, (ds', st, cmap, conmap)) =
@@ -698,7 +698,7 @@
                                         cmap,
                                         conmap,
                                         st)
-                                   end
+                                   end*)
 
                                  | L.SgiVal (x, _, c) =>
                                    (ds,
@@ -811,8 +811,8 @@
 fun maxName ds = foldl (fn ((d, _), n) =>
                            case d of
                                L.DCon (_, n', _, _) => Int.max (n, n')
-                             | L.DDatatype (_, n', _) => Int.max (n, n')
-                             | L.DDatatypeImp (_, n', _, _, _, _) => Int.max (n, n')
+                             | L.DDatatype (_, n', _, _) => Int.max (n, n')
+                             | L.DDatatypeImp (_, n', _, _, _, _, _) => Int.max (n, n')
                              | L.DVal (_, n', _, _) => Int.max (n, n')
                              | L.DValRec vis => foldl (fn ((_, n', _, _), n) => Int.max (n, n)) n vis
                              | L.DSgn (_, n', _) => Int.max (n, n')
--- a/src/elab.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/elab.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -83,7 +83,7 @@
          PWild
        | PVar of string * con
        | PPrim of Prim.t
-       | PCon of datatype_kind * patCon * pat option
+       | PCon of datatype_kind * patCon * con list * pat option
        | PRecord of (string * pat * con) list
 
 withtype pat = pat' located
@@ -112,8 +112,8 @@
 datatype sgn_item' =
          SgiConAbs of string * int * kind
        | SgiCon of string * int * kind * con
-       | SgiDatatype of string * int * (string * int * con option) list
-       | SgiDatatypeImp of string * int * int * string list * string * (string * int * con option) list
+       | SgiDatatype of string * int * string list * (string * int * con option) list
+       | SgiDatatypeImp of string * int * int * string list * string * string list * (string * int * con option) list
        | SgiVal of string * int * con
        | SgiStr of string * int * sgn
        | SgiSgn of string * int * sgn
@@ -132,8 +132,8 @@
 
 datatype decl' =
          DCon of string * int * kind * con
-       | DDatatype of string * int * (string * int * con option) list
-       | DDatatypeImp of string * int * int * string list * string * (string * int * con option) list
+       | DDatatype of string * int * string list * (string * int * con option) list
+       | DDatatypeImp of string * int * int * string list * string * string list * (string * int * con option) list
        | DVal of string * int * con * exp
        | DValRec of (string * int * con * exp) list
        | DSgn of string * int * sgn
--- a/src/elab_env.sig	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/elab_env.sig	Fri Aug 08 10:28:32 2008 -0400
@@ -51,13 +51,14 @@
 
     val lookupC : env -> string -> Elab.kind var
 
-    val pushDatatype : env -> int -> (string * int * Elab.con option) list -> env
+    val pushDatatype : env -> int -> string list -> (string * int * Elab.con option) list -> env
     type datatyp
     val lookupDatatype : env -> int -> datatyp
     val lookupDatatypeConstructor : datatyp -> int -> string * Elab.con option
+    val datatypeArgs : datatyp -> string list
     val constructors : datatyp -> (string * int * Elab.con option) list
 
-    val lookupConstructor : env -> string -> (Elab.datatype_kind * int * Elab.con option * int) option
+    val lookupConstructor : env -> string -> (Elab.datatype_kind * int * string list * Elab.con option * int) option
 
     val pushERel : env -> string -> Elab.con -> env
     val lookupERel : env -> int -> string * Elab.con
@@ -87,9 +88,9 @@
 
     val projectCon : env -> { sgn : Elab.sgn, str : Elab.str, field : string } -> (Elab.kind * Elab.con option) option
     val projectDatatype : env -> { sgn : Elab.sgn, str : Elab.str, field : string }
-                          -> (string * int * Elab.con option) list option
+                          -> (string list * (string * int * Elab.con option) list) option
     val projectConstructor : env -> { sgn : Elab.sgn, str : Elab.str, field : string }
-                             -> (Elab.datatype_kind * int * Elab.con option * Elab.con) option
+                             -> (Elab.datatype_kind * int * string list * Elab.con option * Elab.con) option
     val projectVal : env -> { sgn : Elab.sgn, str : Elab.str, field : string } -> Elab.con option
     val projectSgn : env -> { sgn : Elab.sgn, str : Elab.str, field : string } -> Elab.sgn option
     val projectStr : env -> { sgn : Elab.sgn, str : Elab.str, field : string } -> Elab.sgn option
--- a/src/elab_env.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/elab_env.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -73,7 +73,7 @@
        | Rel of int * 'a
        | Named of int * 'a
 
-type datatyp = (string * con option) IM.map
+type datatyp = string list * (string * con option) IM.map
 
 type env = {
      renameC : kind var' SM.map,
@@ -81,7 +81,7 @@
      namedC : (string * kind * con option) IM.map,
 
      datatypes : datatyp IM.map,
-     constructors : (datatype_kind * int * con option * int) SM.map,
+     constructors : (datatype_kind * int * string list * con option * int) SM.map,
 
      renameE : con var' SM.map,
      relE : (string * con) list,
@@ -188,7 +188,7 @@
       | SOME (Rel' x) => Rel x
       | SOME (Named' x) => Named x
 
-fun pushDatatype (env : env) n xncs =
+fun pushDatatype (env : env) n xs xncs =
     let
         val dk = U.classifyDatatype xncs
     in
@@ -197,10 +197,10 @@
          namedC = #namedC env,
 
          datatypes = IM.insert (#datatypes env, n,
-                                foldl (fn ((x, n, to), cons) =>
-                                          IM.insert (cons, n, (x, to))) IM.empty xncs),
+                                (xs, foldl (fn ((x, n, to), cons) =>
+                                               IM.insert (cons, n, (x, to))) IM.empty xncs)),
          constructors = foldl (fn ((x, n', to), cmap) =>
-                                  SM.insert (cmap, x, (dk, n', to, n)))
+                                  SM.insert (cmap, x, (dk, n', xs, to, n)))
                               (#constructors env) xncs,
 
          renameE = #renameE env,
@@ -219,14 +219,15 @@
         NONE => raise UnboundNamed n
       | SOME x => x
 
-fun lookupDatatypeConstructor dt n =
+fun lookupDatatypeConstructor (_, dt) n =
     case IM.find (dt, n) of
         NONE => raise UnboundNamed n
       | SOME x => x
 
 fun lookupConstructor (env : env) s = SM.find (#constructors env, s)
 
-fun constructors dt = IM.foldri (fn (n, (x, to), ls) => (x, n, to) :: ls) [] dt
+fun datatypeArgs (xs, _) = xs
+fun constructors (_, dt) = IM.foldri (fn (n, (x, to), ls) => (x, n, to) :: ls) [] dt
 
 fun pushERel (env : env) x t =
     let
@@ -362,20 +363,40 @@
     case sgi of
         SgiConAbs (x, n, k) => pushCNamedAs env x n k NONE
       | SgiCon (x, n, k, c) => pushCNamedAs env x n k (SOME c)
-      | SgiDatatype (x, n, xncs) =>
+      | SgiDatatype (x, n, xs, xncs) =>
         let
             val env = pushCNamedAs env x n (KType, loc) NONE
         in
-            foldl (fn ((x', n', NONE), env) => pushENamedAs env x' n' (CNamed n, loc)
-                    | ((x', n', SOME t), env) => pushENamedAs env x' n' (TFun (t, (CNamed n, loc)), loc))
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (Explicit, x, k, t), loc)) t xs
+                      in
+                          pushENamedAs env x' n' t
+                      end)
             env xncs
         end
-      | SgiDatatypeImp (x, n, m1, ms, x', xncs) =>
+      | SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
         let
             val env = pushCNamedAs env x n (KType, loc) (SOME (CModProj (m1, ms, x'), loc))
         in
-            foldl (fn ((x', n', NONE), env) => pushENamedAs env x' n' (CNamed n, loc)
-                    | ((x', n', SOME t), env) => pushENamedAs env x' n' (TFun (t, (CNamed n, loc)), loc))
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (Explicit, x, k, t), loc)) t xs
+                      in
+                          pushENamedAs env x' n' t
+                      end)
             env xncs
         end
       | SgiVal (x, n, t) => pushENamedAs env x n t
@@ -394,8 +415,8 @@
                     let
                         val cons =
                             case sgi of
-                                SgiDatatype (x, n, _) => IM.insert (cons, n, x)
-                              | SgiDatatypeImp (x, n, _, _, _, _) => IM.insert (cons, n, x)
+                                SgiDatatype (x, n, _, _) => IM.insert (cons, n, x)
+                              | SgiDatatypeImp (x, n, _, _, _, _, _) => IM.insert (cons, n, x)
                               | _ => cons
                     in
                         SOME (v, (sgns, strs, cons))
@@ -404,8 +425,8 @@
                     case sgi of
                         SgiConAbs (x, n, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x))
                       | SgiCon (x, n, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x))
-                      | SgiDatatype (x, n, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x))
-                      | SgiDatatypeImp (x, n, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x))
+                      | SgiDatatype (x, n, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x))
+                      | SgiDatatypeImp (x, n, _, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x))
                       | SgiVal _ => seek (sgis, sgns, strs, cons)
                       | SgiSgn (x, n, _) => seek (sgis, IM.insert (sgns, n, x), strs, cons)
                       | SgiStr (x, n, _) => seek (sgis, sgns, IM.insert (strs, n, x), cons)
@@ -552,8 +573,8 @@
         SgnConst sgis =>
         (case sgnSeek (fn SgiConAbs (x, _, k) => if x = field then SOME (k, NONE) else NONE
                         | SgiCon (x, _, k, c) => if x = field then SOME (k, SOME c) else NONE
-                        | SgiDatatype (x, _, _) => if x = field then SOME ((KType, #2 sgn), NONE) else NONE
-                        | SgiDatatypeImp (x, _, m1, ms, x', _) =>
+                        | SgiDatatype (x, _, _, _) => if x = field then SOME ((KType, #2 sgn), NONE) else NONE
+                        | SgiDatatypeImp (x, _, m1, ms, x', _, _) =>
                           if x = field then
                               SOME ((KType, #2 sgn), SOME (CModProj (m1, ms, x'), #2 sgn))
                           else
@@ -567,30 +588,31 @@
 fun projectDatatype env {sgn, str, field} =
     case #1 (hnormSgn env sgn) of
         SgnConst sgis =>
-        (case sgnSeek (fn SgiDatatype (x, _, xncs) => if x = field then SOME xncs else NONE
-                        | SgiDatatypeImp (x, _, _, _, _, xncs) => if x = field then SOME xncs else NONE
+        (case sgnSeek (fn SgiDatatype (x, _, xs, xncs) => if x = field then SOME (xs, xncs) else NONE
+                        | SgiDatatypeImp (x, _, _, _, _, xs, xncs) => if x = field then SOME (xs, xncs) else NONE
                         | _ => NONE) sgis of
              NONE => NONE
-           | SOME (xncs, subs) => SOME (map (fn (x, n, to) => (x, n, Option.map (sgnSubCon (str, subs)) to)) xncs))
+           | SOME ((xs, xncs), subs) => SOME (xs,
+                                              map (fn (x, n, to) => (x, n, Option.map (sgnSubCon (str, subs)) to)) xncs))
       | _ => NONE
 
 fun projectConstructor env {sgn, str, field} =
     case #1 (hnormSgn env sgn) of
         SgnConst sgis =>
         let
-            fun consider (n, xncs) =
+            fun consider (n, xs, xncs) =
                 ListUtil.search (fn (x, n', to) =>
                                     if x <> field then
                                         NONE
                                     else
-                                        SOME (U.classifyDatatype xncs, n', to, (CNamed n, #2 str))) xncs
+                                        SOME (U.classifyDatatype xncs, n', xs, to, (CNamed n, #2 str))) xncs
         in
-            case sgnSeek (fn SgiDatatype (_, n, xncs) => consider (n, xncs)
-                           | SgiDatatypeImp (_, n, _, _, _, xncs) => consider (n, xncs)
+            case sgnSeek (fn SgiDatatype (_, n, xs, xncs) => consider (n, xs, xncs)
+                           | SgiDatatypeImp (_, n, _, _, _, xs, xncs) => consider (n, xs, xncs)
                            | _ => NONE) sgis of
                 NONE => NONE
-              | SOME ((dk, n, to, t), subs) => SOME (dk, n, Option.map (sgnSubCon (str, subs)) to,
-                                                     sgnSubCon (str, subs) t)
+              | SOME ((dk, n, xs, to, t), subs) => SOME (dk, n, xs, Option.map (sgnSubCon (str, subs)) to,
+                                                         sgnSubCon (str, subs) t)
         end
       | _ => NONE
 
@@ -598,18 +620,25 @@
     case #1 (hnormSgn env sgn) of
         SgnConst sgis =>
         let
-            fun seek (n, xncs) =
+            fun seek (n, xs, xncs) =
                 ListUtil.search (fn (x, _, to) =>
                                     if x = field then
-                                        SOME (case to of
-                                                  NONE => (CNamed n, #2 sgn)
-                                                | SOME t => (TFun (t, (CNamed n, #2 sgn)), #2 sgn))
+                                        SOME (let
+                                                  val t =
+                                                      case to of
+                                                          NONE => (CNamed n, #2 sgn)
+                                                        | SOME t => (TFun (t, (CNamed n, #2 sgn)), #2 sgn)
+                                                  val k = (KType, #2 sgn)
+                                              in
+                                                  foldr (fn (x, t) => (TCFun (Explicit, x, k, t), #2 sgn))
+                                                  t xs
+                                              end)
                                     else
                                         NONE) xncs
         in
             case sgnSeek (fn SgiVal (x, _, c) => if x = field then SOME c else NONE
-                           | SgiDatatype (_, n, xncs) => seek (n, xncs)
-                           | SgiDatatypeImp (_, n, _, _, _, xncs) => seek (n, xncs)
+                           | SgiDatatype (_, n, xs, xncs) => seek (n, xs, xncs)
+                           | SgiDatatypeImp (_, n, _, _, _, xs, xncs) => seek (n, xs, xncs)
                            | _ => NONE) sgis of
                 NONE => NONE
               | SOME (c, subs) => SOME (sgnSubCon (str, subs) c)
@@ -632,8 +661,8 @@
                     end
                   | SgiConAbs (x, n, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
                   | SgiCon (x, n, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
-                  | SgiDatatype (x, n, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
-                  | SgiDatatypeImp (x, n, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
+                  | SgiDatatype (x, n, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
+                  | SgiDatatypeImp (x, n, _, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
                   | SgiVal _ => seek (sgis, sgns, strs, cons, acc)
                   | SgiSgn (x, n, _) => seek (sgis, IM.insert (sgns, n, x), strs, cons, acc)
                   | SgiStr (x, n, _) => seek (sgis, sgns, IM.insert (strs, n, x), cons, acc)
@@ -650,26 +679,44 @@
 fun declBinds env (d, loc) =
     case d of
         DCon (x, n, k, c) => pushCNamedAs env x n k (SOME c)
-      | DDatatype (x, n, xncs) =>
+      | DDatatype (x, n, xs, xncs) =>
         let
             val env = pushCNamedAs env x n (KType, loc) NONE
-            val env = pushDatatype env n xncs
+            val env = pushDatatype env n xs xncs
         in
-            foldl (fn ((x', n', NONE), env) => pushENamedAs env x' n' (CNamed n, loc)
-                    | ((x', n', SOME t), env) => pushENamedAs env x' n' (TFun (t, (CNamed n, loc)), loc))
-            env xncs
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (Explicit, x, k, t), loc)) t xs
+                      in
+                          pushENamedAs env x' n' t
+                      end)
+                  env xncs
         end
-      | DDatatypeImp (x, n, m, ms, x', xncs) =>
+      | DDatatypeImp (x, n, m, ms, x', xs, xncs) =>
         let
             val t = (CModProj (m, ms, x'), loc)
             val env = pushCNamedAs env x n (KType, loc) (SOME t)
-            val env = pushDatatype env n xncs
+            val env = pushDatatype env n xs xncs
 
             val t = (CNamed n, loc)
         in
-            foldl (fn ((x', n', NONE), env) => pushENamedAs env x' n' t
-                    | ((x', n', SOME t'), env) => pushENamedAs env x' n' (TFun (t', t), loc))
-            env xncs
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (Explicit, x, k, t), loc)) t xs
+                      in
+                          pushENamedAs env x' n' t
+                      end)
+                  env xncs
         end
       | DVal (x, n, t, _) => pushENamedAs env x n t
       | DValRec vis => foldl (fn ((x, n, t, _), env) => pushENamedAs env x n t) env vis
--- a/src/elab_print.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/elab_print.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -216,8 +216,8 @@
         PWild => string "_"
       | PVar (s, _) => string s
       | PPrim p => Prim.p_t p
-      | PCon (_, pc, NONE) => p_patCon env pc
-      | PCon (_, pc, SOME p) => parenIf par (box [p_patCon env pc,
+      | PCon (_, pc, _, NONE) => p_patCon env pc
+      | PCon (_, pc, _, SOME p) => parenIf par (box [p_patCon env pc,
                                                   space,
                                                   p_pat' true env p])
       | PRecord xps =>
@@ -364,13 +364,16 @@
     else
         string x
 
-fun p_datatype env (x, n, cons) =
+fun p_datatype env (x, n, xs, cons) =
     let
-        val env = E.pushCNamedAs env x n (KType, ErrorMsg.dummySpan) NONE
+        val k = (KType, ErrorMsg.dummySpan)
+        val env = E.pushCNamedAs env x n k NONE
+        val env = foldl (fn (x, env) => E.pushCRel env x k) env xs
     in
         box [string "datatype",
              space,
              string x,
+             p_list_sep (box []) (fn x => box [space, string x]) xs,
              space,
              string "=",
              space,
@@ -401,7 +404,7 @@
                                     space,
                                     p_con env c]
       | SgiDatatype x => p_datatype env x
-      | SgiDatatypeImp (x, _, m1, ms, x', _) =>
+      | SgiDatatypeImp (x, _, m1, ms, x', _, _) =>
         let
             val m1x = #1 (E.lookupStrNamed env m1)
                 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
@@ -523,7 +526,7 @@
                                   space,
                                   p_con env c]
       | DDatatype x => p_datatype env x
-      | DDatatypeImp (x, _, m1, ms, x', _) =>
+      | DDatatypeImp (x, _, m1, ms, x', _, _) =>
         let
             val m1x = #1 (E.lookupStrNamed env m1)
                 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
--- a/src/elab_util.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/elab_util.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -396,7 +396,7 @@
                         S.map2 (con ctx c,
                              fn c' =>
                                 (SgiCon (x, n, k', c'), loc)))
-              | SgiDatatype (x, n, xncs) =>
+              | SgiDatatype (x, n, xs, xncs) =>
                 S.map2 (ListUtil.mapfold (fn (x, n, c) =>
                                              case c of
                                                  NONE => S.return2 (x, n, c)
@@ -404,8 +404,8 @@
                                                  S.map2 (con ctx c,
                                                       fn c' => (x, n, SOME c'))) xncs,
                         fn xncs' =>
-                           (SgiDatatype (x, n, xncs'), loc))
-              | SgiDatatypeImp (x, n, m1, ms, s, xncs) =>
+                           (SgiDatatype (x, n, xs, xncs'), loc))
+              | SgiDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
                 S.map2 (ListUtil.mapfold (fn (x, n, c) =>
                                              case c of
                                                  NONE => S.return2 (x, n, c)
@@ -413,7 +413,7 @@
                                                  S.map2 (con ctx c,
                                                       fn c' => (x, n, SOME c'))) xncs,
                         fn xncs' =>
-                           (SgiDatatypeImp (x, n, m1, ms, s, xncs'), loc))
+                           (SgiDatatypeImp (x, n, m1, ms, s, xs, xncs'), loc))
               | SgiVal (x, n, c) =>
                 S.map2 (con ctx c,
                      fn c' =>
@@ -445,9 +445,9 @@
                                                    bind (ctx, NamedC (x, k))
                                                  | SgiCon (x, _, k, _) =>
                                                    bind (ctx, NamedC (x, k))
-                                                 | SgiDatatype (x, n, xncs) =>
+                                                 | SgiDatatype (x, n, _, xncs) =>
                                                    bind (ctx, NamedC (x, (KType, loc)))
-                                                 | SgiDatatypeImp (x, _, _, _, _, _) =>
+                                                 | SgiDatatypeImp (x, _, _, _, _, _, _) =>
                                                    bind (ctx, NamedC (x, (KType, loc)))
                                                  | SgiVal _ => ctx
                                                  | SgiStr (x, _, sgn) =>
@@ -553,7 +553,7 @@
                                               (case #1 d of
                                                    DCon (x, _, k, _) =>
                                                    bind (ctx, NamedC (x, k))
-                                                 | DDatatype (x, n, xncs) =>
+                                                 | DDatatype (x, n, xs, xncs) =>
                                                    let
                                                        val ctx = bind (ctx, NamedC (x, (KType, loc)))
                                                    in
@@ -563,12 +563,21 @@
                                                                          case co of
                                                                              NONE => CNamed n
                                                                            | SOME t => TFun (t, (CNamed n, loc))
+
+                                                                     val k = (KType, loc)
+                                                                     val t = (t, loc)
+                                                                     val t = foldr (fn (x, t) =>
+                                                                                       (TCFun (Explicit,
+                                                                                               x,
+                                                                                               k,
+                                                                                               t), loc))
+                                                                             t xs
                                                                  in
-                                                                     bind (ctx, NamedE (x, (t, loc)))
+                                                                     bind (ctx, NamedE (x, t))
                                                                  end)
                                                        ctx xncs
                                                    end
-                                                 | DDatatypeImp (x, n, m, ms, x', _) =>
+                                                 | DDatatypeImp (x, n, m, ms, x', _, _) =>
                                                    bind (ctx, NamedC (x, (KType, loc)))
                                                  | DVal (x, _, c, _) =>
                                                    bind (ctx, NamedE (x, c))
@@ -616,7 +625,7 @@
                             S.map2 (mfc ctx c,
                                     fn c' =>
                                        (DCon (x, n, k', c'), loc)))
-              | DDatatype (x, n, xncs) =>
+              | DDatatype (x, n, xs, xncs) =>
                 S.map2 (ListUtil.mapfold (fn (x, n, c) =>
                                              case c of
                                                  NONE => S.return2 (x, n, c)
@@ -624,8 +633,8 @@
                                                  S.map2 (mfc ctx c,
                                                       fn c' => (x, n, SOME c'))) xncs,
                         fn xncs' =>
-                           (DDatatype (x, n, xncs'), loc))
-              | DDatatypeImp (x, n, m1, ms, s, xncs) =>
+                           (DDatatype (x, n, xs, xncs'), loc))
+              | DDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
                 S.map2 (ListUtil.mapfold (fn (x, n, c) =>
                                              case c of
                                                  NONE => S.return2 (x, n, c)
@@ -633,7 +642,7 @@
                                                  S.map2 (mfc ctx c,
                                                       fn c' => (x, n, SOME c'))) xncs,
                         fn xncs' =>
-                           (DDatatypeImp (x, n, m1, ms, s, xncs'), loc))
+                           (DDatatypeImp (x, n, m1, ms, s, xs, xncs'), loc))
               | DVal vi =>
                 S.map2 (mfvi ctx vi,
                      fn vi' =>
--- a/src/elaborate.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/elaborate.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -933,19 +933,32 @@
         val pterror = (perror, terror)
         val rerror = (pterror, (env, bound))
 
-        fun pcon (pc, po, to, dn, dk) =
+        fun pcon (pc, po, xs, 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))
+              | (NONE, NONE) =>
+                let
+                    val k = (L'.KType, loc)
+                    val unifs = map (fn _ => cunif (loc, k)) xs
+                    val dn = foldl (fn (u, dn) => (L'.CApp (dn, u), loc)) dn unifs
+                in
+                    (((L'.PCon (dk, pc, unifs, NONE), loc), dn),
+                     (env, bound))
+                end
               | (SOME p, SOME t) =>
                 let
                     val ((p', pt), (env, bound)) = elabPat (p, (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 dn = foldl (fn (u, dn) => (L'.CApp (dn, u), loc)) dn unifs
                 in
-                    (((L'.PCon (dk, pc, SOME p'), loc), dn),
+                    ignore (checkPatCon (env, denv) p' pt t);
+                    (((L'.PCon (dk, pc, unifs, SOME p'), loc), dn),
                      (env, bound))
                 end
     in
@@ -969,7 +982,7 @@
             (case E.lookupConstructor env x of
                  NONE => (expError env (UnboundConstructor (loc, [], x));
                           rerror)
-               | SOME (dk, n, to, dn) => pcon (L'.PConVar n, po, to, (L'.CNamed dn, loc), dk))
+               | SOME (dk, n, xs, to, dn) => pcon (L'.PConVar n, po, xs, to, (L'.CNamed dn, loc), dk))
           | L.PCon (m1 :: ms, x, po) =>
             (case E.lookupStr env m1 of
                  NONE => (expError env (UnboundStrInExp (loc, m1));
@@ -985,7 +998,7 @@
                      case E.projectConstructor env {str = str, sgn = sgn, field = x} of
                          NONE => (expError env (UnboundConstructor (loc, m1 :: ms, x));
                                   rerror)
-                       | SOME (dk, _, to, dn) => pcon (L'.PConProj (n, ms, x), po, to, dn, dk)
+                       | SOME (dk, _, xs, to, dn) => pcon (L'.PConProj (n, ms, x), po, xs, to, dn, dk)
                  end)
 
           | L.PRecord (xps, flex) =>
@@ -1035,7 +1048,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, _) =
@@ -1043,8 +1056,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]
 
@@ -1158,8 +1171,13 @@
                                               (total, gs' @ gs)
                                           end)
                               (true, gs) cons
+
+                    fun unapp t =
+                        case t of
+                            L'.CApp ((t, _), _) => unapp t
+                          | _ => t
                 in
-                    case t of
+                    case unapp t of
                         L'.CNamed n =>
                         let
                             val dt = E.lookupDatatype env n
@@ -1173,7 +1191,7 @@
                         in
                             case E.projectDatatype env {str = str, sgn = sgn, field = x} of
                                 NONE => raise Fail "isTotal: Can't project datatype"
-                              | SOME cons => dtype cons
+                              | SOME (_, cons) => dtype cons
                         end
                       | L'.CError => (true, gs)
                       | _ => raise Fail "isTotal: Not a datatype"
@@ -1206,7 +1224,11 @@
                  (expError env (UnboundExp (loc, s));
                   (eerror, cerror, []))
                | E.Rel (n, t) => ((L'.ERel n, loc), t, [])
-               | E.Named (n, t) => ((L'.ENamed n, loc), t, []))
+               | E.Named (n, t) =>
+                 if Char.isUpper (String.sub (s, 0)) then
+                     elabHead (env, denv) (L'.ENamed n, loc) t
+                 else
+                     ((L'.ENamed n, loc), t, []))
           | L.EVar (m1 :: ms, s) =>
             (case E.lookupStr env m1 of
                  NONE => (expError env (UnboundStrInExp (loc, m1));
@@ -1572,11 +1594,13 @@
             ([(L'.SgiCon (x, n, k', c'), loc)], (env', denv, gs' @ gs))
         end
 
-      | L.SgiDatatype (x, xcs) =>
+      | L.SgiDatatype (x, xs, xcs) =>
         let
             val k = (L'.KType, loc)
-            val (env, n) = E.pushCNamed env x k NONE
+            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 (xcs, (used, env, gs)) =
                 ListUtil.foldlMap
@@ -1591,6 +1615,7 @@
                                                checkKind env t' tk k;
                                                (SOME t', (L'.TFun (t', t), loc), gs' @ gs)
                                            end
+                        val t = foldl (fn (x, t) => (L'.TCFun (L'.Implicit, x, k, t), loc)) t xs
 
                         val (env, n') = E.pushENamed env x t
                     in
@@ -1601,8 +1626,10 @@
                         ((x, n', to), (SS.add (used, x), env, gs'))
                     end)
                 (SS.empty, env, []) xcs
+
+            val env = E.pushDatatype env n xs xcs
         in
-            ([(L'.SgiDatatype (x, n, xcs), loc)], (env, denv, gs))
+            ([(L'.SgiDatatype (x, n, xs, xcs), loc)], (env, denv, gs))
         end
 
       | L.SgiDatatypeImp (_, [], _) => raise Fail "Empty SgiDatatypeImp"
@@ -1625,12 +1652,14 @@
                      (case E.projectDatatype env {sgn = sgn, str = str, field = s} of
                           NONE => (conError env (UnboundDatatype (loc, s));
                                    ([], (env, denv, gs)))
-                        | SOME xncs =>
+                        | SOME (xs, xncs) =>
                           let
                               val k = (L'.KType, loc)
+                              val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+
                               val t = (L'.CModProj (n, ms, s), loc)
-                              val (env, n') = E.pushCNamed env x k (SOME t)
-                              val env = E.pushDatatype env n' xncs
+                              val (env, n') = E.pushCNamed env x k' (SOME t)
+                              val env = E.pushDatatype env n' xs xncs
 
                               val t = (L'.CNamed n', loc)
                               val env = foldl (fn ((x, n, to), env) =>
@@ -1638,11 +1667,15 @@
                                                       val t = case to of
                                                                   NONE => t
                                                                 | SOME t' => (L'.TFun (t', t), loc)
+
+                                                      val t = foldr (fn (x, t) =>
+                                                                        (L'.TCFun (L'.Implicit, x, k, t), loc))
+                                                              t xs
                                                   in
                                                       E.pushENamedAs env x n t
                                                   end) env xncs
                           in
-                              ([(L'.SgiDatatypeImp (x, n', n, ms, s, xncs), loc)], (env, denv, gs))
+                              ([(L'.SgiDatatypeImp (x, n', n, ms, s, xs, xncs), loc)], (env, denv, gs))
                           end)
                    | _ => (strError env (NotDatatype loc);
                            ([], (env, denv, [])))
@@ -1720,7 +1753,7 @@
                                    else
                                        ();
                                    (SS.add (cons, x), vals, sgns, strs))
-                                | L'.SgiDatatype (x, _, xncs) =>
+                                | L'.SgiDatatype (x, _, _, xncs) =>
                                   let
                                       val vals = foldl (fn ((x, _, _), vals) =>
                                                            (if SS.member (vals, x) then
@@ -1736,7 +1769,7 @@
                                           ();
                                       (SS.add (cons, x), vals, sgns, strs)
                                   end
-                                | L'.SgiDatatypeImp (x, _, _, _, _, _) =>
+                                | L'.SgiDatatypeImp (x, _, _, _, _, _, _) =>
                                   (if SS.member (cons, x) then
                                        sgnError env (DuplicateCon (loc, x))
                                    else
@@ -1828,8 +1861,8 @@
       | L'.SgnConst sgis =>
         (L'.SgnConst (map (fn (L'.SgiConAbs (x, n, k), loc) =>
                               (L'.SgiCon (x, n, k, (L'.CModProj (str, strs, x), loc)), loc)
-                            | (L'.SgiDatatype (x, n, xncs), loc) =>
-                              (L'.SgiDatatypeImp (x, n, str, strs, x, xncs), loc)
+                            | (L'.SgiDatatype (x, n, xs, xncs), loc) =>
+                              (L'.SgiDatatypeImp (x, n, str, strs, x, xs, xncs), loc)
                             | (L'.SgiStr (x, n, sgn), loc) =>
                               (L'.SgiStr (x, n, selfify env {str = str, strs = strs @ [x], sgn = sgn}), loc)
                             | x => x) sgis), #2 sgn)
@@ -1878,10 +1911,10 @@
                                               end
                                             | L'.SgiCon (x, n, k, c) =>
                                               (L'.DCon (x, n, k, (L'.CModProj (str, strs, x), loc)), loc)
-                                            | L'.SgiDatatype (x, n, xncs) =>
-                                              (L'.DDatatypeImp (x, n, str, strs, x, xncs), loc)
-                                            | L'.SgiDatatypeImp (x, n, m1, ms, x', xncs) =>
-                                              (L'.DDatatypeImp (x, n, m1, ms, x', xncs), loc)
+                                            | L'.SgiDatatype (x, n, xs, xncs) =>
+                                              (L'.DDatatypeImp (x, n, str, strs, x, xs, xncs), loc)
+                                            | L'.SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
+                                              (L'.DDatatypeImp (x, n, m1, ms, x', xs, xncs), loc)
                                             | L'.SgiVal (x, n, t) =>
                                               (L'.DVal (x, n, t, (L'.EModProj (str, strs, x), loc)), loc)
                                             | L'.SgiStr (x, n, sgn) =>
@@ -1998,9 +2031,20 @@
                                      case sgi1 of
                                          L'.SgiConAbs (x', n1, k1) => found (x', n1, k1, NONE)
                                        | L'.SgiCon (x', n1, k1, c1) => found (x', n1, k1, SOME c1)
-                                       | L'.SgiDatatype (x', n1, _) => found (x', n1, (L'.KType, loc), NONE)
-                                       | L'.SgiDatatypeImp (x', n1, m1, ms, s, _) =>
-                                         found (x', n1, (L'.KType, loc), SOME (L'.CModProj (m1, ms, s), loc))
+                                       | L'.SgiDatatype (x', n1, xs, _) =>
+                                         let
+                                             val k = (L'.KType, loc)
+                                             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+                                         in
+                                             found (x', n1, k', NONE)
+                                         end
+                                       | L'.SgiDatatypeImp (x', n1, m1, ms, s, xs, _) =>
+                                         let
+                                             val k = (L'.KType, loc)
+                                             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+                                         in
+                                             found (x', n1, k', SOME (L'.CModProj (m1, ms, s), loc))
+                                         end
                                        | _ => NONE
                                  end)
 
@@ -2023,15 +2067,18 @@
                                          NONE
                                    | _ => NONE)
 
-                      | L'.SgiDatatype (x, n2, xncs2) =>
+                      | L'.SgiDatatype (x, n2, xs2, xncs2) =>
                         seek (fn sgi1All as (sgi1, _) =>
                                  let
-                                     fun found (n1, xncs1) =
+                                     fun found (n1, xs1, xncs1) =
                                          let
                                              fun mismatched ue =
                                                  (sgnError env (SgiMismatchedDatatypes (sgi1All, sgi2All, ue));
                                                   SOME (env, denv))
 
+                                             val k = (L'.KType, loc)
+                                             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs1
+
                                              fun good () =
                                                  let
                                                      val env = E.sgiBinds env sgi2All
@@ -2044,6 +2091,7 @@
                                                      SOME (env, denv)
                                                  end
 
+                                             val env = foldl (fn (x, env) => E.pushCRel env x k) env xs1
                                              fun xncBad ((x1, _, t1), (x2, _, t2)) =
                                                  String.compare (x1, x2) <> EQUAL
                                                  orelse case (t1, t2) of
@@ -2052,7 +2100,8 @@
                                                             not (List.null (unifyCons (env, denv) t1 t2))
                                                           | _ => true
                                          in
-                                             (if length xncs1 <> length xncs2
+                                             (if xs1 <> xs2
+                                                 orelse length xncs1 <> length xncs2
                                                  orelse ListPair.exists xncBad (xncs1, xncs2) then
                                                   mismatched NONE
                                               else
@@ -2061,33 +2110,34 @@
                                          end
                                  in
                                      case sgi1 of
-                                         L'.SgiDatatype (x', n1, xncs1) =>
+                                         L'.SgiDatatype (x', n1, xs, xncs1) =>
                                          if x' = x then
-                                             found (n1, xncs1)
+                                             found (n1, xs, xncs1)
                                          else
                                              NONE
-                                       | L'.SgiDatatypeImp (x', n1, _, _, _, xncs1) =>
+                                       | L'.SgiDatatypeImp (x', n1, _, _, _, xs, xncs1) =>
                                          if x' = x then
-                                             found (n1, xncs1)
+                                             found (n1, xs, xncs1)
                                          else
                                              NONE
                                        | _ => NONE
                                  end)
 
-                      | L'.SgiDatatypeImp (x, n2, m12, ms2, s2, _) =>
+                      | L'.SgiDatatypeImp (x, n2, m12, ms2, s2, xs, _) =>
                         seek (fn sgi1All as (sgi1, _) =>
                                  case sgi1 of
-                                     L'.SgiDatatypeImp (x', n1, m11, ms1, s1, _) =>
+                                     L'.SgiDatatypeImp (x', n1, m11, ms1, s1, _, _) =>
                                      if x = x' then
                                          let
                                              val k = (L'.KType, loc)
+                                             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
                                              val t1 = (L'.CModProj (m11, ms1, s1), loc)
                                              val t2 = (L'.CModProj (m12, ms2, s2), loc)
 
                                              fun good () =
                                                  let
-                                                     val env = E.pushCNamedAs env x n1 k (SOME t1)
-                                                     val env = E.pushCNamedAs env x n2 k (SOME t2)
+                                                     val env = E.pushCNamedAs env x n1 k' (SOME t1)
+                                                     val env = E.pushCNamedAs env x n2 k' (SOME t2)
                                                  in
                                                      SOME (env, denv)
                                                  end
@@ -2213,11 +2263,17 @@
 
             ([(L'.DCon (x, n, k', c'), loc)], (env', denv, gs' @ gs))
         end
-      | L.DDatatype (x, xcs) =>
+      | L.DDatatype (x, xs, xcs) =>
         let
             val k = (L'.KType, loc)
-            val (env, n) = E.pushCNamed env x k NONE
+            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 (env', denv') = foldl (fn (x, (env', denv')) =>
+                                          (E.pushCRel env' x k,
+                                           D.enter denv')) (env, denv) xs
 
             val (xcs, (used, env, gs)) =
                 ListUtil.foldlMap
@@ -2227,11 +2283,12 @@
                                            NONE => (NONE, t, gs)
                                          | SOME t' =>
                                            let
-                                               val (t', tk, gs') = elabCon (env, denv) t'
+                                               val (t', tk, gs') = elabCon (env', denv') t'
                                            in
-                                               checkKind env t' tk k;
+                                               checkKind env' t' tk k;
                                                (SOME t', (L'.TFun (t', t), loc), gs' @ gs)
                                            end
+                        val t = foldr (fn (x, t) => (L'.TCFun (L'.Implicit, x, k, t), loc)) t xs
 
                         val (env, n') = E.pushENamed env x t
                     in
@@ -2243,9 +2300,9 @@
                     end)
                 (SS.empty, env, []) xcs
 
-            val env = E.pushDatatype env n xcs
+            val env = E.pushDatatype env n xs xcs
         in
-            ([(L'.DDatatype (x, n, xcs), loc)], (env, denv, gs))
+            ([(L'.DDatatype (x, n, xs, xcs), loc)], (env, denv, gs))
         end
 
       | L.DDatatypeImp (_, [], _) => raise Fail "Empty DDatatypeImp"
@@ -2268,12 +2325,13 @@
                      (case E.projectDatatype env {sgn = sgn, str = str, field = s} of
                           NONE => (conError env (UnboundDatatype (loc, s));
                                    ([], (env, denv, gs)))
-                        | SOME xncs =>
+                        | SOME (xs, xncs) =>
                           let
                               val k = (L'.KType, loc)
+                              val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
                               val t = (L'.CModProj (n, ms, s), loc)
-                              val (env, n') = E.pushCNamed env x k (SOME t)
-                              val env = E.pushDatatype env n' xncs
+                              val (env, n') = E.pushCNamed env x k' (SOME t)
+                              val env = E.pushDatatype env n' xs xncs
 
                               val t = (L'.CNamed n', loc)
                               val env = foldl (fn ((x, n, to), env) =>
@@ -2281,11 +2339,15 @@
                                                       val t = case to of
                                                                   NONE => t
                                                                 | SOME t' => (L'.TFun (t', t), loc)
+
+                                                      val t = foldr (fn (x, t) =>
+                                                                        (L'.TCFun (L'.Implicit, x, k, t), loc))
+                                                              t xs
                                                   in
                                                       E.pushENamedAs env x n t
                                                   end) env xncs
                           in
-                              ([(L'.DDatatypeImp (x, n', n, ms, s, xncs), loc)], (env, denv, gs))
+                              ([(L'.DDatatypeImp (x, n', n, ms, s, xs, xncs), loc)], (env, denv, gs))
                           end)
                    | _ => (strError env (NotDatatype loc);
                            ([], (env, denv, [])))
@@ -2544,7 +2606,7 @@
                               in
                                   ((L'.SgiCon (x, n, k, c), loc) :: sgis, cons, vals, sgns, strs)
                               end
-                            | L'.SgiDatatype (x, n, xncs) =>
+                            | L'.SgiDatatype (x, n, xs, xncs) =>
                               let
                                   val (cons, x) =
                                       if SS.member (cons, x) then
@@ -2561,9 +2623,9 @@
                                                   ((x, n, t), SS.add (vals, x)))
                                       vals xncs
                               in
-                                  ((L'.SgiDatatype (x, n, xncs), loc) :: sgis, cons, vals, sgns, strs)
+                                  ((L'.SgiDatatype (x, n, xs, xncs), loc) :: sgis, cons, vals, sgns, strs)
                               end
-                            | L'.SgiDatatypeImp (x, n, m1, ms, x', xncs) =>
+                            | L'.SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
                               let
                                   val (cons, x) =
                                       if SS.member (cons, x) then
@@ -2571,7 +2633,7 @@
                                       else
                                           (SS.add (cons, x), x)
                               in
-                                  ((L'.SgiDatatypeImp (x, n, m1, ms, x', xncs), loc) :: sgis, cons, vals, sgns, strs)
+                                  ((L'.SgiDatatypeImp (x, n, m1, ms, x', xs, xncs), loc) :: sgis, cons, vals, sgns, strs)
                               end
                             | L'.SgiVal (x, n, c) =>
                               let
--- a/src/expl.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/expl.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -69,7 +69,7 @@
          PWild
        | PVar of string * con
        | PPrim of Prim.t
-       | PCon of datatype_kind * patCon * pat option
+       | PCon of datatype_kind * patCon * con list * pat option
        | PRecord of (string * pat * con) list
 
 withtype pat = pat' located
@@ -98,8 +98,8 @@
 datatype sgn_item' =
          SgiConAbs of string * int * kind
        | SgiCon of string * int * kind * con
-       | SgiDatatype of string * int * (string * int * con option) list
-       | SgiDatatypeImp of string * int * int * string list * string * (string * int * con option) list
+       | SgiDatatype of string * int * string list * (string * int * con option) list
+       | SgiDatatypeImp of string * int * int * string list * string * string list * (string * int * con option) list
        | SgiVal of string * int * con
        | SgiSgn of string * int * sgn
        | SgiStr of string * int * sgn
@@ -116,8 +116,8 @@
 
 datatype decl' =
          DCon of string * int * kind * con
-       | DDatatype of string * int * (string * int * con option) list
-       | DDatatypeImp of string * int * int * string list * string * (string * int * con option) list
+       | DDatatype of string * int * string list * (string * int * con option) list
+       | DDatatypeImp of string * int * int * string list * string * string list * (string * int * con option) list
        | DVal of string * int * con * exp
        | DValRec of (string * int * con * exp) list
        | DSgn of string * int * sgn
--- a/src/expl_env.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/expl_env.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -239,24 +239,42 @@
 fun declBinds env (d, loc) =
     case d of
         DCon (x, n, k, c) => pushCNamed env x n k (SOME c)
-      | DDatatype (x, n, xncs) =>
+      | DDatatype (x, n, xs, xncs) =>
         let
             val env = pushCNamed env x n (KType, loc) NONE
         in
-            foldl (fn ((x', n', NONE), env) => pushENamed env x' n' (CNamed n, loc)
-                    | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, (CNamed n, loc)), loc))
-            env xncs
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (x, k, t), loc)) t xs
+                      in
+                          pushENamed env x' n' t
+                      end)
+                  env xncs
         end
-      | DDatatypeImp (x, n, m, ms, x', xncs) =>
+      | DDatatypeImp (x, n, m, ms, x', xs, xncs) =>
         let
             val t = (CModProj (m, ms, x'), loc)
             val env = pushCNamed env x n (KType, loc) (SOME t)
 
             val t = (CNamed n, loc)
         in
-            foldl (fn ((x', n', NONE), env) => pushENamed env x' n' t
-                    | ((x', n', SOME t'), env) => pushENamed env x' n' (TFun (t', t), loc))
-            env xncs
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (x, k, t), loc)) t xs
+                      in
+                          pushENamed env x' n' t
+                      end)
+                  env xncs
         end
       | DVal (x, n, t, _) => pushENamed env x n t
       | DValRec vis => foldl (fn ((x, n, t, _), env) => pushENamed env x n t) env vis
@@ -269,21 +287,42 @@
     case sgi of
         SgiConAbs (x, n, k) => pushCNamed env x n k NONE
       | SgiCon (x, n, k, c) => pushCNamed env x n k (SOME c)
-      | SgiDatatype (x, n, xncs) =>
+      | SgiDatatype (x, n, xs, xncs) =>
         let
             val env = pushCNamed env x n (KType, loc) NONE
         in
-            foldl (fn ((x', n', NONE), env) => pushENamed env x' n' (CNamed n, loc)
-                    | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, (CNamed n, loc)), loc))
-            env xncs
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (x, k, t), loc)) t xs
+                      in
+                          pushENamed env x' n' t
+                      end)
+                  env xncs
         end
-      | SgiDatatypeImp (x, n, m1, ms, x', xncs) =>
+      | SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
         let
-            val env = pushCNamed env x n (KType, loc) (SOME (CModProj (m1, ms, x'), loc))
+            val t = (CModProj (m1, ms, x'), loc)
+            val env = pushCNamed env x n (KType, loc) (SOME t)
+
+            val t = (CNamed n, loc)
         in
-            foldl (fn ((x', n', NONE), env) => pushENamed env x' n' (CNamed n, loc)
-                    | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, (CNamed n, loc)), loc))
-            env xncs
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (x, k, t), loc)) t xs
+                      in
+                          pushENamed env x' n' t
+                      end)
+                  env xncs
         end
       | SgiVal (x, n, t) => pushENamed env x n t
       | SgiSgn (x, n, sgn) => pushSgnNamed env x n sgn
--- a/src/expl_print.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/expl_print.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -181,10 +181,10 @@
         PWild => string "_"
       | PVar (s, _) => string s
       | PPrim p => Prim.p_t p
-      | PCon (_, pc, NONE) => p_patCon env pc
-      | PCon (_, pc, SOME p) => parenIf par (box [p_patCon env pc,
-                                                  space,
-                                                  p_pat' true env p])
+      | PCon (_, pc, _, NONE) => p_patCon env pc
+      | PCon (_, pc, _, SOME p) => parenIf par (box [p_patCon env pc,
+                                                     space,
+                                                     p_pat' true env p])
       | PRecord xps =>
         box [string "{",
              p_list_sep (box [string ",", space]) (fn (x, p, _) =>
@@ -329,13 +329,16 @@
     else
         string x
 
-fun p_datatype env (x, n, cons) =
+fun p_datatype env (x, n, xs, cons) =
     let
-        val env = E.pushCNamed env x n (KType, ErrorMsg.dummySpan) NONE
+        val k = (KType, ErrorMsg.dummySpan)
+        val env = E.pushCNamed env x n k NONE
+        val env = foldl (fn (x, env) => E.pushCRel env x k) env xs
     in
         box [string "datatype",
              space,
              string x,
+             p_list_sep (box []) (fn x => box [space, string x]) xs,
              space,
              string "=",
              space,
@@ -368,7 +371,7 @@
                                     space,
                                     p_con env c]
       | SgiDatatype x => p_datatype env x
-      | SgiDatatypeImp (x, _, m1, ms, x', _) =>
+      | SgiDatatypeImp (x, _, m1, ms, x', _, _) =>
         let
             val m1x = #1 (E.lookupStrNamed env m1)
                 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
@@ -482,7 +485,7 @@
                                   space,
                                   p_con env c]
       | DDatatype x => p_datatype env x
-      | DDatatypeImp (x, _, m1, ms, x', _) =>
+      | DDatatypeImp (x, _, m1, ms, x', _, _) =>
         let
             val m1x = #1 (E.lookupStrNamed env m1)
                 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
--- a/src/expl_util.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/expl_util.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -373,7 +373,7 @@
                         S.map2 (con ctx c,
                              fn c' =>
                                 (SgiCon (x, n, k', c'), loc)))
-              | SgiDatatype (x, n, xncs) =>
+              | SgiDatatype (x, n, xs, xncs) =>
                 S.map2 (ListUtil.mapfold (fn (x, n, c) =>
                                              case c of
                                                  NONE => S.return2 (x, n, c)
@@ -381,8 +381,8 @@
                                                  S.map2 (con ctx c,
                                                       fn c' => (x, n, SOME c'))) xncs,
                         fn xncs' =>
-                           (SgiDatatype (x, n, xncs'), loc))
-              | SgiDatatypeImp (x, n, m1, ms, s, xncs) =>
+                           (SgiDatatype (x, n, xs, xncs'), loc))
+              | SgiDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
                 S.map2 (ListUtil.mapfold (fn (x, n, c) =>
                                              case c of
                                                  NONE => S.return2 (x, n, c)
@@ -390,7 +390,7 @@
                                                  S.map2 (con ctx c,
                                                       fn c' => (x, n, SOME c'))) xncs,
                         fn xncs' =>
-                           (SgiDatatypeImp (x, n, m1, ms, s, xncs'), loc))
+                           (SgiDatatypeImp (x, n, m1, ms, s, xs, xncs'), loc))
               | SgiVal (x, n, c) =>
                 S.map2 (con ctx c,
                      fn c' =>
@@ -416,9 +416,9 @@
                                                    bind (ctx, NamedC (x, k))
                                                  | SgiCon (x, _, k, _) =>
                                                    bind (ctx, NamedC (x, k))
-                                                 | SgiDatatype (x, n, xncs) =>
+                                                 | SgiDatatype (x, n, _, xncs) =>
                                                    bind (ctx, NamedC (x, (KType, loc)))
-                                                 | SgiDatatypeImp (x, _, _, _, _, _) =>
+                                                 | SgiDatatypeImp (x, _, _, _, _, _, _) =>
                                                    bind (ctx, NamedC (x, (KType, loc)))
                                                  | SgiVal _ => ctx
                                                  | SgiStr (x, _, sgn) =>
--- a/src/explify.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/explify.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -81,7 +81,7 @@
         L.PWild => (L'.PWild, loc)
       | L.PVar (x, t) => (L'.PVar (x, explifyCon t), loc)
       | L.PPrim p => (L'.PPrim p, loc)
-      | L.PCon (dk, pc, po) => (L'.PCon (dk, explifyPatCon pc, Option.map explifyPat po), loc)
+      | L.PCon (dk, pc, cs, po) => (L'.PCon (dk, explifyPatCon pc, map explifyCon cs, Option.map explifyPat po), loc)
       | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, explifyPat p, explifyCon t)) xps), loc)
 
 fun explifyExp (e, loc) =
@@ -113,11 +113,12 @@
     case sgi of
         L.SgiConAbs (x, n, k) => SOME (L'.SgiConAbs (x, n, explifyKind k), loc)
       | L.SgiCon (x, n, k, c) => SOME (L'.SgiCon (x, n, explifyKind k, explifyCon c), loc)
-      | L.SgiDatatype (x, n, xncs) => SOME (L'.SgiDatatype (x, n, map (fn (x, n, co) =>
-                                                                          (x, n, Option.map explifyCon co)) xncs), loc)
-      | L.SgiDatatypeImp (x, n, m1, ms, s, xncs) =>
-        SOME (L'.SgiDatatypeImp (x, n, m1, ms, s, map (fn (x, n, co) =>
-                                                          (x, n, Option.map explifyCon co)) xncs), loc)
+      | L.SgiDatatype (x, n, xs, xncs) => SOME (L'.SgiDatatype (x, n, xs,
+                                                                map (fn (x, n, co) =>
+                                                                        (x, n, Option.map explifyCon co)) xncs), loc)
+      | L.SgiDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
+        SOME (L'.SgiDatatypeImp (x, n, m1, ms, s, xs, map (fn (x, n, co) =>
+                                                              (x, n, Option.map explifyCon co)) xncs), loc)
       | L.SgiVal (x, n, c) => SOME (L'.SgiVal (x, n, explifyCon c), loc)
       | L.SgiStr (x, n, sgn) => SOME (L'.SgiStr (x, n, explifySgn sgn), loc)
       | L.SgiSgn (x, n, sgn) => SOME (L'.SgiSgn (x, n, explifySgn sgn), loc)
@@ -135,11 +136,13 @@
 fun explifyDecl (d, loc : EM.span) =
     case d of
         L.DCon (x, n, k, c) => SOME (L'.DCon (x, n, explifyKind k, explifyCon c), loc)
-      | L.DDatatype (x, n, xncs) => SOME (L'.DDatatype (x, n, map (fn (x, n, co) =>
-                                                                      (x, n, Option.map explifyCon co)) xncs), loc)
-      | L.DDatatypeImp (x, n, m1, ms, s, xncs) =>
-        SOME (L'.DDatatypeImp (x, n, m1, ms, s, map (fn (x, n, co) =>
-                                                        (x, n, Option.map explifyCon co)) xncs), loc)
+      | L.DDatatype (x, n, xs, xncs) => SOME (L'.DDatatype (x, n, xs,
+                                                            map (fn (x, n, co) =>
+                                                                    (x, n, Option.map explifyCon co)) xncs), loc)
+      | L.DDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
+        SOME (L'.DDatatypeImp (x, n, m1, ms, s, xs,
+                               map (fn (x, n, co) =>
+                                       (x, n, Option.map explifyCon co)) xncs), loc)
       | L.DVal (x, n, t, e) => SOME (L'.DVal (x, n, explifyCon t, explifyExp e), loc)
       | L.DValRec vis => SOME (L'.DValRec (map (fn (x, n, t, e) => (x, n, explifyCon t, explifyExp e)) vis), loc)
 
--- a/src/lacweb.grm	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/lacweb.grm	Fri Aug 08 10:28:32 2008 -0400
@@ -64,6 +64,7 @@
  | vali of string * con option * exp
  | valis of (string * con option * exp) list
 
+ | dargs of string list
  | barOpt of unit
  | dcons of (string * con option) list
  | dcon of string * con option
@@ -142,9 +143,11 @@
        | CON SYMBOL DCOLON kind EQ cexp (DCon (SYMBOL, SOME kind, cexp), s (CONleft, cexpright))
        | LTYPE SYMBOL EQ cexp           (DCon (SYMBOL, SOME (KType, s (LTYPEleft, cexpright)), cexp),
                                          s (LTYPEleft, cexpright))
-       | DATATYPE SYMBOL EQ barOpt dcons(DDatatype (SYMBOL, dcons), s (DATATYPEleft, dconsright))
-       | DATATYPE SYMBOL EQ DATATYPE CSYMBOL DOT path
-                (DDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
+       | DATATYPE SYMBOL dargs EQ barOpt dcons(DDatatype (SYMBOL, dargs, dcons), s (DATATYPEleft, dconsright))
+       | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
+                (case dargs of
+                     [] => (DDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
+                   | _ => raise Fail "Arguments specified for imported datatype")
        | VAL vali                       (DVal vali, s (VALleft, valiright))
        | VAL REC valis                  (DValRec valis, s (VALleft, valisright))
 
@@ -169,6 +172,9 @@
        | CONSTRAINT cterm TWIDDLE cterm (DConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))
        | EXPORT spath                   (DExport spath, s (EXPORTleft, spathright))
 
+dargs  :                                ([])
+       | SYMBOL dargs                   (SYMBOL :: dargs)
+
 barOpt :                                ()
        | BAR                            ()
 
@@ -207,9 +213,11 @@
        | CON SYMBOL DCOLON kind EQ cexp (SgiCon (SYMBOL, SOME kind, cexp), s (CONleft, cexpright))
        | LTYPE SYMBOL EQ cexp           (SgiCon (SYMBOL, SOME (KType, s (LTYPEleft, cexpright)), cexp),
                                          s (LTYPEleft, cexpright))
-       | DATATYPE SYMBOL EQ barOpt dcons(SgiDatatype (SYMBOL, dcons), s (DATATYPEleft, dconsright))
-       | DATATYPE SYMBOL EQ DATATYPE CSYMBOL DOT path
-                (SgiDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
+       | DATATYPE SYMBOL dargs EQ barOpt dcons(SgiDatatype (SYMBOL, dargs, dcons), s (DATATYPEleft, dconsright))
+       | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
+                (case dargs of
+                     [] => (SgiDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
+                   | _ => raise Fail "Arguments specified for imported datatype")
        | VAL SYMBOL COLON cexp          (SgiVal (SYMBOL, cexp), s (VALleft, cexpright))
 
        | STRUCTURE CSYMBOL COLON sgn    (SgiStr (CSYMBOL, sgn), s (STRUCTUREleft, sgnright))
--- a/src/list_util.sig	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/list_util.sig	Fri Aug 08 10:28:32 2008 -0400
@@ -41,5 +41,6 @@
     val search : ('a -> 'b option) -> 'a list -> 'b option
 
     val mapi : (int * 'a -> 'b) -> 'a list -> 'b list
+    val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a list -> 'b
 
 end
--- a/src/list_util.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/list_util.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -146,4 +146,14 @@
         m 0 []
     end
 
+fun foldli f =
+    let
+        fun m i acc ls =
+            case ls of
+                [] => acc
+              | h :: t => m (i + 1) (f (i, h, acc)) t
+    in
+        m 0
+    end
+
 end
--- a/src/source.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/source.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -71,7 +71,7 @@
 datatype sgn_item' =
          SgiConAbs of string * kind
        | SgiCon of string * kind option * con
-       | SgiDatatype of string * (string * con option) list
+       | SgiDatatype of string * string list * (string * con option) list
        | SgiDatatypeImp of string * string list * string
        | SgiVal of string * con
        | SgiStr of string * sgn
@@ -120,7 +120,7 @@
 
 datatype decl' =
          DCon of string * kind option * con
-       | DDatatype of string * (string * con option) list
+       | DDatatype of string * string list * (string * con option) list
        | DDatatypeImp of string * string list * string
        | DVal of string * con option * exp
        | DValRec of (string * con option * exp) list
--- a/src/source_print.sml	Thu Aug 07 13:09:26 2008 -0400
+++ b/src/source_print.sml	Fri Aug 08 10:28:32 2008 -0400
@@ -278,10 +278,11 @@
 
 and p_exp e = p_exp' false e
 
-fun p_datatype (x, cons) =
+fun p_datatype (x, xs, cons) =
     box [string "datatype",
          space,
          string x,
+         p_list_sep (box []) (fn x => box [space, string x]) xs,
          space,
          string "=",
          space,
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/datatypeP.lac	Fri Aug 08 10:28:32 2008 -0400
@@ -0,0 +1,10 @@
+datatype option a = None | Some of a
+
+val none : option int = None
+val some_1 : option int = Some 1
+
+val f = fn t ::: Type => fn x : option t =>
+        case x of None => None | Some x => Some (Some x)
+
+val none_again = f none
+val some_1_again = f some_1