Lists all the way through

14 files changed, 218 insertions, 153 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
index d9dc51c1..cda7245a 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -35,7 +35,7 @@ datatype typ' =
          TTop
        | TFun of typ * typ
        | TRecord of int
-       | TDatatype of datatype_kind * int * (string * int * typ option) list
+       | TDatatype of datatype_kind * int * (string * int * typ option) list ref
        | TFfi of string * string
 
 withtype typ = typ' located
@@ -75,6 +75,7 @@ withtype exp = exp' located
 datatype decl' =
          DStruct of int * (string * typ) list
        | DDatatype of datatype_kind * string * int * (string * int * typ option) list
+       | DDatatypeForward of datatype_kind * string * int
        | DVal of string * int * typ * exp
        | DFun of string * int * (string * typ) list * typ * exp
        | DFunRec of (string * int * (string * typ) list * typ * exp) list
diff --git a/src/cjr_env.sml b/src/cjr_env.sml
index 83f0cc30..331af45f 100644
--- a/src/cjr_env.sml
+++ b/src/cjr_env.sml
@@ -140,12 +140,13 @@ fun declBinds env (d, loc) =
         DDatatype (_, x, n, xncs) =>
         let
             val env = pushDatatype env x n xncs
-            val dt = (TDatatype (classifyDatatype xncs, n, xncs), loc)
+            val dt = (TDatatype (classifyDatatype xncs, n, ref xncs), loc)
         in
             foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt
                     | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc))
             env xncs
         end
+      | DDatatypeForward (_, x, n) => pushDatatype env x n []
       | DStruct (n, xts) => pushStruct env n xts
       | DVal (x, n, t, _) => pushENamed env x n t
       | DFun (fx, n, args, ran, _) =>
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 2189a436..4b173aa1 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -53,7 +53,7 @@ structure CM = BinaryMapFn(struct
 
 val debug = ref false
 
-val dummyTyp = (TDatatype (Enum, 0, []), ErrorMsg.dummySpan)
+val dummyTyp = (TDatatype (Enum, 0, ref []), ErrorMsg.dummySpan)
 
 fun p_typ' par env (t, loc) =
     case t of
@@ -106,7 +106,7 @@ fun p_pat_preamble env (p, _) =
                              string (Int.toString (E.countERels env)),
                              string ";",
                              newline],
-                        env)
+                        E.pushERel env x t)
       | PPrim _ => (box [], env)
       | PCon (_, _, NONE) => (box [], env)
       | PCon (_, _, SOME p) => p_pat_preamble env p
@@ -180,7 +180,7 @@ fun p_pat (env, exit, depth) (p, _) =
                                           let
                                               val (x, to, _) = E.lookupConstructor env n
                                           in
-                                              ("__lwc_" ^ x, to)
+                                              ("lw_" ^ x, to)
                                           end
                                         | PConFfi {mod = m, con, arg, ...} =>
                                           ("lw_" ^ m ^ "_" ^ con, arg)
@@ -247,7 +247,7 @@ fun p_pat (env, exit, depth) (p, _) =
                                                        space,
                                                        string "disc",
                                                        string (Int.toString depth),
-                                                       string ".",
+                                                       string ".__lwf_",
                                                        string x,
                                                        string ";",
                                                        newline,
@@ -282,11 +282,13 @@ fun patConInfo env pc =
             val (dx, _) = E.lookupDatatype env dn
         in
             ("__lwd_" ^ dx ^ "_" ^ Int.toString dn,
-             "__lwc_" ^ x ^ "_" ^ Int.toString n)
+             "__lwc_" ^ x ^ "_" ^ Int.toString n,
+             "lw_" ^ x)
         end
       | PConFfi {mod = m, datatyp, con, ...} =>
         ("lw_" ^ m ^ "_" ^ datatyp,
-         "lw_" ^ m ^ "_" ^ con)
+         "lw_" ^ m ^ "_" ^ con,
+         "lw_" ^ con)
 
 fun p_exp' par env (e, loc) =
     case e of
@@ -296,7 +298,7 @@ fun p_exp' par env (e, loc) =
       | ECon (Enum, pc, _) => p_patCon env pc
       | ECon (Default, pc, eo) =>
         let
-            val (xd, xc) = patConInfo env pc
+            val (xd, xc, xn) = patConInfo env pc
         in
             box [string "({",
                  newline,
@@ -322,7 +324,7 @@ fun p_exp' par env (e, loc) =
                  case eo of
                      NONE => box []
                    | SOME e => box [string "tmp->data.",
-                                    string xd,
+                                    string xn,
                                     space,
                                     string "=",
                                     space,
@@ -493,19 +495,23 @@ fun p_fun env (fx, n, args, ran, e) =
 fun p_decl env (dAll as (d, _) : decl) =
     case d of
         DStruct (n, xts) =>
-        box [string "struct",
-             space,
-             string ("__lws_" ^ Int.toString n),
-             space,
-             string "{",
-             newline,
-             p_list_sep (box []) (fn (x, t) => box [p_typ env t,
-                                                    space,
-                                                    string "__lwf_",
-                                                    string x,
-                                                    string ";",
-                                                    newline]) xts,
-             string "};"]
+        let
+            val env = E.declBinds env dAll
+        in
+            box [string "struct",
+                 space,
+                 string ("__lws_" ^ Int.toString n),
+                 space,
+                 string "{",
+                 newline,
+                 p_list_sep (box []) (fn (x, t) => box [p_typ env t,
+                                                        space,
+                                                        string "__lwf_",
+                                                        string x,
+                                                        string ";",
+                                                        newline]) xts,
+                 string "};"]
+        end
       | DDatatype (Enum, x, n, xncs) =>
         box [string "enum",
              space,
@@ -552,7 +558,7 @@ fun p_decl env (dAll as (d, _) : decl) =
                                 newline,
                                 p_list_sep newline (fn (x, n, t) => box [p_typ env t,
                                                                          space,
-                                                                         string ("__lwc_" ^ x),
+                                                                         string ("lw_" ^ x),
                                                                          string ";"]) xncsArgs,
                                 newline,
                                 string "}",
@@ -562,6 +568,8 @@ fun p_decl env (dAll as (d, _) : decl) =
                  string "};"]
         end
 
+      | DDatatypeForward _ => box []
+
       | DVal (x, n, t, e) =>
         box [p_typ env t,
              space,
@@ -1003,18 +1011,6 @@ fun p_file env (ds, ps) =
              newline,
              string "int lw_input_num(char *name) {",
              newline,
-             string "if",
-             space,
-             string "(name[0]",
-             space,
-             string "==",
-             space,
-             string "0)",
-             space,
-             string "return",
-             space,
-             string "-1;",
-             newline,
              makeSwitch (fnums, 0),
              string "}",
              newline,
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 5ba8ccb7..166e5fcc 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -30,6 +30,8 @@ structure Cjrize :> CJRIZE = struct
 structure L = Mono
 structure L' = Cjr
 
+structure IM = IntBinaryMap
+
 structure Sm :> sig
     type t
 
@@ -61,45 +63,57 @@ fun declares (_, _, ds) = ds
 
 end
 
-fun cifyTyp ((t, loc), sm) =
-    case t of
-        L.TFun (t1, t2) =>
-        let
-            val (t1, sm) = cifyTyp (t1, sm)
-            val (t2, sm) = cifyTyp (t2, sm)
-        in
-            ((L'.TFun (t1, t2), loc), sm)
-        end
-      | L.TRecord xts =>
-        let
-            val old_xts = xts
-            val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
-                                                  let
-                                                      val (t, sm) = cifyTyp (t, sm)
-                                                  in
-                                                      ((x, t), sm)
-                                                  end)
-                                              sm xts
-            val (sm, si) = Sm.find (sm, old_xts, xts)
-        in
-            ((L'.TRecord si, loc), sm)
-        end
-      | L.TDatatype (dk, n, xncs) =>
-        let
-            val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) =>
-                                                   case to of
-                                                       NONE => ((x, n, NONE), sm)
-                                                     | SOME t =>
-                                                       let
-                                                           val (t, sm) = cifyTyp (t, sm)
-                                                       in
-                                                           ((x, n, SOME t), sm)
-                                                       end)
-                             sm xncs
-        in
-            ((L'.TDatatype (dk, n, xncs), loc), sm)
-        end
-      | L.TFfi mx => ((L'.TFfi mx, loc), sm)
+fun cifyTyp x =
+    let
+        fun cify dtmap ((t, loc), sm) =
+            case t of
+                L.TFun (t1, t2) =>
+                let
+                    val (t1, sm) = cify dtmap (t1, sm)
+                    val (t2, sm) = cify dtmap (t2, sm)
+                in
+                    ((L'.TFun (t1, t2), loc), sm)
+                end
+              | L.TRecord xts =>
+                let
+                    val old_xts = xts
+                    val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
+                                                          let
+                                                              val (t, sm) = cify dtmap (t, sm)
+                                                          in
+                                                              ((x, t), sm)
+                                                          end)
+                                                      sm xts
+                    val (sm, si) = Sm.find (sm, old_xts, xts)
+                in
+                    ((L'.TRecord si, loc), sm)
+                end
+              | L.TDatatype (n, ref (dk, xncs)) =>
+                (case IM.find (dtmap, n) of
+                     SOME r => ((L'.TDatatype (dk, n, r), loc), sm)
+                   | NONE =>
+                     let
+                         val r = ref []
+                         val dtmap = IM.insert (dtmap, n, r)
+
+                         val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) =>
+                                                                case to of
+                                                                    NONE => ((x, n, NONE), sm)
+                                                                  | SOME t =>
+                                                                    let
+                                                                        val (t, sm) = cify dtmap (t, sm)
+                                                                    in
+                                                                        ((x, n, SOME t), sm)
+                                                                    end)
+                                                            sm xncs
+                     in
+                         r := xncs;
+                         ((L'.TDatatype (dk, n, r), loc), sm)
+                     end)
+              | L.TFfi mx => ((L'.TFfi mx, loc), sm)
+    in
+        cify IM.empty x
+    end
 
 val dummye = (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan)
 
@@ -356,22 +370,26 @@ fun cifyDecl ((d, loc), sm) =
 
 fun cjrize ds =
     let
-        val (ds, ps, sm) = foldl (fn (d, (ds, ps, sm)) =>
-                                     let
-                                         val (dop, pop, sm) = cifyDecl (d, sm)
-                                         val ds = case dop of
-                                                      NONE => ds
-                                                    | SOME d => d :: ds
-                                         val ps = case pop of
-                                                      NONE => ps
-                                                    | SOME p => p :: ps 
-                                     in
-                                         (ds, ps, sm)
-                                     end)
-                           ([], [], Sm.empty) ds
+        val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) =>
+                                          let
+                                              val (dop, pop, sm) = cifyDecl (d, sm)
+                                              val (dsF, ds) = case dop of
+                                                                  NONE => (dsF, ds)
+                                                                | SOME (d as (L'.DDatatype (dk, x, n, _), loc)) =>
+                                                                  ((L'.DDatatypeForward (dk, x, n), loc) :: dsF,
+                                                                   d :: ds)
+                                                                | SOME d => (dsF, d :: ds)
+                                              val ps = case pop of
+                                                           NONE => ps
+                                                         | SOME p => p :: ps
+                                          in
+                                              (dsF, ds, ps, sm)
+                                          end)
+                                      ([], [], [], Sm.empty) ds
     in
-        (List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm),
-                         rev ds),
+        (List.revAppend (dsF,
+                         List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm),
+                                         rev ds)),
          ps)
     end
 
diff --git a/src/core_util.sml b/src/core_util.sml
index 3fc57739..e89a579b 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -571,14 +571,20 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
                               fn c' =>
                                  (DCon (x, n, k', c'), loc)))
               | DDatatype (x, n, xs, xncs) =>
-                S.map2 (ListUtil.mapfold (fn (x, n, c) =>
-                                             case c of
-                                                 NONE => S.return2 (x, n, c)
-                                               | SOME c =>
-                                                 S.map2 (mfc ctx c,
-                                                      fn c' => (x, n, SOME c'))) xncs,
-                        fn xncs' =>
-                           (DDatatype (x, n, xs, xncs'), loc))
+                let
+                    val k = (KType, loc)
+                    val k' = foldl (fn (_, k') => (KArrow (k, k'), loc)) k xs
+                    val ctx' = bind (ctx, NamedC (x, n, k', NONE))
+                in
+                    S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                                 case c of
+                                                     NONE => S.return2 (x, n, c)
+                                                   | SOME c =>
+                                                     S.map2 (mfc ctx' c,
+                                                          fn c' => (x, n, SOME c'))) xncs,
+                         fn xncs' =>
+                            (DDatatype (x, n, xs, xncs'), loc))
+                end
               | DVal vi =>
                 S.map2 (mfvi ctx vi,
                      fn vi' =>
diff --git a/src/lacweb.grm b/src/lacweb.grm
index 7fb7b020..a206182b 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -308,8 +308,8 @@ cterm  : LPAREN cexp RPAREN             (#1 cexp, s (LPARENleft, RPARENright))
        | FOLD                           (CFold, s (FOLDleft, FOLDright))
        | UNIT                           (CUnit, s (UNITleft, UNITright))
 
-ctuple : cterm STAR cterm               ([cterm1, cterm2])
-       | cterm STAR ctuple              (cterm :: ctuple)
+ctuple : capps STAR capps               ([capps1, capps2])
+       | capps STAR ctuple              (capps :: ctuple)
 
 rcon   :                                ([])
        | ident EQ cexp                  ([(ident, cexp)])
@@ -341,9 +341,7 @@ eexp   : eapps                          (eapps)
                                              (EAbs ("_", SOME (TRecord (CRecord [], loc), loc), eexp), loc)
                                          end)
 
-       | LPAREN etuple RPAREN COLON cexp(case etuple of
-                                             [eexp] => (EAnnot (eexp, cexp), s (LPARENleft, cexpright))
-                                           | _ => raise Fail "Multiple arguments to expression type annotation")
+       | eexp COLON cexp                (EAnnot (eexp, cexp), s (eexpleft, cexpright))
        | eexp MINUSMINUS cexp           (ECut (eexp, cexp), s (eexpleft, cexpright))
        | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright))
        | IF eexp THEN eexp ELSE eexp    (let
diff --git a/src/mono.sml b/src/mono.sml
index b19f5af6..9599433c 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -34,7 +34,7 @@ datatype datatype_kind = datatype Core.datatype_kind
 datatype typ' =
          TFun of typ * typ
        | TRecord of (string * typ) list
-       | TDatatype of datatype_kind * int * (string * int * typ option) list
+       | TDatatype of int * (datatype_kind * (string * int * typ option) list) ref
        | TFfi of string * string
 
 withtype typ = typ' located
diff --git a/src/mono_env.sml b/src/mono_env.sml
index 3beced1c..60b22642 100644
--- a/src/mono_env.sml
+++ b/src/mono_env.sml
@@ -98,7 +98,7 @@ fun declBinds env (d, loc) =
         DDatatype (x, n, xncs) =>
         let
             val env = pushDatatype env x n xncs
-            val dt = (TDatatype (MonoUtil.classifyDatatype xncs, n, xncs), loc)
+            val dt = (TDatatype (n, ref (MonoUtil.classifyDatatype xncs, xncs)), loc)
         in
             foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt NONE ""
                     | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc) NONE "")
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 38812167..4b417217 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -135,6 +135,11 @@ fun exp e =
       | ESeq ((EWrite (EPrim (Prim.String s1), _), loc),
               (EWrite (EPrim (Prim.String s2), _), _)) =>
         EWrite (EPrim (Prim.String (s1 ^ s2)), loc)
+      | ESeq ((EWrite (EPrim (Prim.String s1), _), loc),
+              (ESeq ((EWrite (EPrim (Prim.String s2), _), _),
+                     e), _)) =>
+        ESeq ((EWrite (EPrim (Prim.String (s1 ^ s2)), loc), loc),
+              e)
 
       | EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]) =>
         EPrim (Prim.String (htmlifyString s))
@@ -142,6 +147,8 @@ fun exp e =
         EWrite (EPrim (Prim.String (htmlifyString s)), loc)
       | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) =>
         EFfiApp ("Basis", "htmlifyString_w", [e])
+      | EFfiApp ("Basis", "htmlifyString_w", [(EPrim (Prim.String s), loc)]) =>
+        EWrite (EPrim (Prim.String (htmlifyString s)), loc)
 
       | EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]) =>
         EPrim (Prim.String (attrifyInt n))
diff --git a/src/mono_print.sml b/src/mono_print.sml
index fc19d8b5..afa86c18 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -53,7 +53,7 @@ fun p_typ' par env (t, _) =
                                             space,
                                             p_typ env t]) xcs,
                             string "}"]
-      | TDatatype (_, n, _) =>
+      | TDatatype (n, _) =>
         ((if !debug then
               string (#1 (E.lookupDatatype env n) ^ "__" ^ Int.toString n)
           else
diff --git a/src/mono_shake.sml b/src/mono_shake.sml
index 498a1ac6..e694c0dd 100644
--- a/src/mono_shake.sml
+++ b/src/mono_shake.sml
@@ -58,7 +58,7 @@ fun shake file =
 
         fun typ (c, s) =
             case c of
-                TDatatype (_, n, _) =>
+                TDatatype (n, _) =>
                 if IS.member (#con s, n) then
                     s
                 else
diff --git a/src/mono_util.sml b/src/mono_util.sml
index f00db1fd..3c76e029 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -52,7 +52,7 @@ fun compare ((t1, _), (t2, _)) =
         in
             joinL compareFields (xts1, xts2)
         end
-      | (TDatatype (_, n1, _), TDatatype (_, n2, _)) => Int.compare (n1, n2)
+      | (TDatatype (n1, _), TDatatype (n2, _)) => Int.compare (n1, n2)
       | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2))
 
       | (TFun _, _) => LESS
@@ -297,9 +297,13 @@ fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} =
                      fn vi' =>
                         (DVal vi', loc))
               | DValRec vis =>
-                S.map2 (ListUtil.mapfold (mfvi ctx) vis,
-                     fn vis' =>
-                        (DValRec vis', loc))
+                let
+                    val ctx' = foldl (fn ((x, n, t, _, s), ctx') => bind (ctx', NamedE (x, n, t, NONE, s))) ctx vis
+                in
+                    S.map2 (ListUtil.mapfold (mfvi ctx') vis,
+                         fn vis' =>
+                            (DValRec vis', loc))
+                end
               | DExport (ek, s, n, ts) =>
                 S.map2 (ListUtil.mapfold mft ts,
                         fn ts' =>
@@ -350,7 +354,7 @@ fun mapfoldB (all as {bind, ...}) =
                                         DDatatype (x, n, xncs) =>
                                         let
                                             val ctx = bind (ctx, Datatype (x, n, xncs))
-                                            val t = (TDatatype (classifyDatatype xncs, n, xncs), #2 d')
+                                            val t = (TDatatype (n, ref (classifyDatatype xncs, xncs)), #2 d')
                                         in
                                             foldl (fn ((x, n, to), ctx) =>
                                                       let
@@ -364,7 +368,7 @@ fun mapfoldB (all as {bind, ...}) =
                                         end
                                       | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s))
                                       | DValRec vis => foldl (fn ((x, n, t, e, s), ctx) =>
-                                                                 bind (ctx, NamedE (x, n, t, SOME e, s))) ctx vis
+                                                                 bind (ctx, NamedE (x, n, t, NONE, s))) ctx vis
                                       | DExport _ => ctx
                             in
                                 S.map2 (mff ctx' ds',
diff --git a/src/monoize.sml b/src/monoize.sml
index 9f75e8f9..98b9075a 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -33,7 +33,9 @@ structure Env = CoreEnv
 structure L = Core
 structure L' = Mono
 
-val dummyTyp = (L'.TDatatype (L'.Enum, 0, []), E.dummySpan)
+structure IM = IntBinaryMap
+
+val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan)
 
 fun monoName env (all as (c, loc)) =
     let
@@ -47,46 +49,58 @@ fun monoName env (all as (c, loc)) =
           | _ => poly ()
     end
 
-fun monoType env (all as (c, loc)) =
+fun monoType env =
     let
-        fun poly () =
-            (E.errorAt loc "Unsupported type constructor";
-             Print.eprefaces' [("Constructor", CorePrint.p_con env all)];
-             dummyTyp)
-    in
-        case c of
-            L.TFun (c1, c2) => (L'.TFun (monoType env c1, monoType env c2), loc)
-          | L.TCFun _ => poly ()
-          | L.TRecord (L.CRecord ((L.KType, _), xcs), _) =>
-            (L'.TRecord (map (fn (x, t) => (monoName env x, monoType env t)) xcs), loc)
-          | L.TRecord _ => poly ()
-
-          | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
-            (L'.TFfi ("Basis", "string"), loc)
-          | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
-            (L'.TFfi ("Basis", "string"), loc)
-
-          | L.CRel _ => poly ()
-          | L.CNamed n =>
+        fun mt env dtmap (all as (c, loc)) =
             let
-                val (_, xs, xncs) = Env.lookupDatatype env n
-
-                val xncs = map (fn (x, n, to) => (x, n, Option.map (monoType env) to)) xncs
+                fun poly () =
+                    (E.errorAt loc "Unsupported type constructor";
+                     Print.eprefaces' [("Constructor", CorePrint.p_con env all)];
+                     dummyTyp)
             in
-                case xs of
-                    [] => (L'.TDatatype (MonoUtil.classifyDatatype xncs, n, xncs), loc)
-                  | _ => poly ()
+                case c of
+                    L.TFun (c1, c2) => (L'.TFun (mt env dtmap c1, mt env dtmap c2), loc)
+                  | L.TCFun _ => poly ()
+                  | L.TRecord (L.CRecord ((L.KType, _), xcs), _) =>
+                    (L'.TRecord (map (fn (x, t) => (monoName env x, mt env dtmap t)) xcs), loc)
+                  | L.TRecord _ => poly ()
+
+                  | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+
+                  | L.CRel _ => poly ()
+                  | L.CNamed n =>
+                    (case IM.find (dtmap, n) of
+                         SOME r => (L'.TDatatype (n, r), loc)
+                       | NONE =>
+                         let
+                             val r = ref (L'.Default, [])
+                             val (_, xs, xncs) = Env.lookupDatatype env n
+                                                 
+                             val dtmap' = IM.insert (dtmap, n, r)
+                                          
+                             val xncs = map (fn (x, n, to) => (x, n, Option.map (mt env dtmap') to)) xncs
+                         in
+                             case xs of
+                                 [] =>(r := (MonoUtil.classifyDatatype xncs, xncs);
+                                       (L'.TDatatype (n, r), loc))
+                               | _ => poly ()
+                         end)
+                  | L.CFfi mx => (L'.TFfi mx, loc)
+                  | L.CApp _ => poly ()
+                  | L.CAbs _ => poly ()
+
+                  | L.CName _ => poly ()
+
+                  | L.CRecord _ => poly ()
+                  | L.CConcat _ => poly ()
+                  | L.CFold _ => poly ()
+                  | L.CUnit => poly ()
             end
-          | L.CFfi mx => (L'.TFfi mx, loc)
-          | L.CApp _ => poly ()
-          | L.CAbs _ => poly ()
-
-          | L.CName _ => poly ()
-
-          | L.CRecord _ => poly ()
-          | L.CConcat _ => poly ()
-          | L.CFold _ => poly ()
-          | L.CUnit => poly ()
+    in
+        mt env IM.empty
     end
 
 val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan)
@@ -204,7 +218,7 @@ fun fooifyExp fk env =
                     L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [e]), loc), fm)
                   | L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm)
 
-                  | L'.TDatatype (dk, i, _) =>
+                  | L'.TDatatype (i, ref (dk, _)) =>
                     let
                         fun makeDecl n fm =
                             let
@@ -733,9 +747,10 @@ fun monoDecl (env, fm) (all as (d, loc)) =
             L.DCon _ => NONE
           | L.DDatatype (x, n, [], xncs) =>
             let
-                val d = (L'.DDatatype (x, n, map (fn (x, n, to) => (x, n, Option.map (monoType env) to)) xncs), loc)
+                val env' = Env.declBinds env all
+                val d = (L'.DDatatype (x, n, map (fn (x, n, to) => (x, n, Option.map (monoType env') to)) xncs), loc)
             in
-                SOME (Env.declBinds env all, fm, d)
+                SOME (env', fm, d)
             end
           | L.DDatatype _ => poly ()
           | L.DVal (x, n, t, e, s) =>
diff --git a/tests/list.lac b/tests/list.lac
new file mode 100644
index 00000000..a4602d0e
--- /dev/null
+++ b/tests/list.lac
@@ -0,0 +1,19 @@
+datatype list a = Nil | Cons of a * list a
+
+val isNil = fn t ::: Type => fn ls : list t =>
+        case ls of Nil => True | _ => False
+
+val show = fn b => if b then "True" else "False"
+
+val rec delist : list string -> xml body [] [] = fn x =>
+        case x of
+          Nil => <body>Nil</body>
+        | Cons (h, t) => <body>{cdata h} :: {delist t}</body>
+
+val main : unit -> page = fn () => <html><body>
+        {cdata (show (isNil (Nil : list bool)))},
+        {cdata (show (isNil (Cons (1, Nil))))},
+        {cdata (show (isNil (Cons ("A", Cons ("B", Nil)))))}
+
+        <p>{delist (Cons ("X", Cons ("Y", Cons ("Z", Nil))))}</p>
+</body></html>