bool in Basis

16 files changed, 200 insertions, 90 deletions

diff --git a/include/lacweb.h b/include/lacweb.h
index c2853cd7..0a425a31 100644
--- a/include/lacweb.h
+++ b/include/lacweb.h
@@ -40,13 +40,16 @@ void lw_Basis_attrifyString_w(lw_context, lw_Basis_string);
 char *lw_Basis_urlifyInt(lw_context, lw_Basis_int);
 char *lw_Basis_urlifyFloat(lw_context, lw_Basis_float);
 char *lw_Basis_urlifyString(lw_context, lw_Basis_string);
+char *lw_Basis_urlifyBool(lw_context, lw_Basis_bool);
 
 void lw_Basis_urlifyInt_w(lw_context, lw_Basis_int);
 void lw_Basis_urlifyFloat_w(lw_context, lw_Basis_float);
 void lw_Basis_urlifyString_w(lw_context, lw_Basis_string);
+void lw_Basis_urlifyBool_w(lw_context, lw_Basis_bool);
 
-lw_Basis_int lw_unurlifyInt(char **);
-lw_Basis_float lw_unurlifyFloat(char **);
-lw_Basis_string lw_unurlifyString(lw_context, char **);
+lw_Basis_int lw_Basis_unurlifyInt(lw_context, char **);
+lw_Basis_float lw_Basis_unurlifyFloat(lw_context, char **);
+lw_Basis_string lw_Basis_unurlifyString(lw_context, char **);
+lw_Basis_bool lw_Basis_unurlifyBool(lw_context, char **);
 
 lw_Basis_string lw_Basis_strcat(lw_context, lw_Basis_string, lw_Basis_string);
diff --git a/include/types.h b/include/types.h
index 169952cb..d5d2b202 100644
--- a/include/types.h
+++ b/include/types.h
@@ -8,6 +8,12 @@ struct __lws_0 {
 typedef struct __lws_0 lw_unit;
 typedef lw_unit lw_Basis_unit;
 
+enum lw_Basis_bool_enum { lw_Basis_False, lw_Basis_True };
+
+typedef struct lw_Basis_bool {
+  enum lw_Basis_bool_enum tag;
+} *lw_Basis_bool;
+
 typedef struct lw_context *lw_context;
 
 typedef lw_Basis_string lw_Basis_xhtml;
diff --git a/lib/basis.lig b/lib/basis.lig
index 94977faf..72a8ddf8 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -4,6 +4,8 @@ type string
 
 type unit = {}
 
+datatype bool = False | True
+
 
 con tag :: {Type} -> {Unit} -> {Unit} -> {Type} -> {Type} -> Type
 
diff --git a/src/c/lacweb.c b/src/c/lacweb.c
index 50f11ef1..94ff4a6d 100644
--- a/src/c/lacweb.c
+++ b/src/c/lacweb.c
@@ -338,6 +338,13 @@ char *lw_Basis_urlifyString(lw_context ctx, lw_Basis_string s) {
   return r;
 }
 
+char *lw_Basis_urlifyBool(lw_context ctx, lw_Basis_bool b) {
+  if (b->tag == lw_Basis_False)
+    return "0";
+  else
+    return "1";
+}
+
 static void lw_Basis_urlifyInt_w_unsafe(lw_context ctx, lw_Basis_int n) {
   int len;
 
@@ -375,6 +382,13 @@ void lw_Basis_urlifyString_w(lw_context ctx, lw_Basis_string s) {
   }
 }
 
+void lw_Basis_urlifyBool_w(lw_context ctx, lw_Basis_bool b) {
+  if (b->tag == lw_Basis_False)
+    lw_writec(ctx, '0');
+  else
+    lw_writec(ctx, '1');
+}
+
 
 static char *lw_unurlify_advance(char *s) {
   char *new_s = strchr(s, '/');
@@ -387,7 +401,7 @@ static char *lw_unurlify_advance(char *s) {
   return new_s;
 }
 
-lw_Basis_int lw_unurlifyInt(char **s) {
+lw_Basis_int lw_Basis_unurlifyInt(lw_context ctx, char **s) {
   char *new_s = lw_unurlify_advance(*s);
   int r;
 
@@ -396,7 +410,7 @@ lw_Basis_int lw_unurlifyInt(char **s) {
   return r;
 }
 
-lw_Basis_float lw_unurlifyFloat(char **s) {
+lw_Basis_float lw_Basis_unurlifyFloat(lw_context ctx, char **s) {
   char *new_s = lw_unurlify_advance(*s);
   int r;
 
@@ -434,7 +448,23 @@ static lw_Basis_string lw_unurlifyString_to(lw_context ctx, char *r, char *s) {
   return s1;
 }
 
-lw_Basis_string lw_unurlifyString(lw_context ctx, char **s) {
+static struct lw_Basis_bool lw_False = { lw_Basis_False },
+  lw_True = { lw_Basis_True };
+
+lw_Basis_bool lw_Basis_unurlifyBool(lw_context ctx, char **s) {
+  char *new_s = lw_unurlify_advance(*s);
+  lw_Basis_bool r;
+  
+  if (*s[0] == 0 || !strcmp(*s, "0") || !strcmp(*s, "off"))
+    r = &lw_False;
+  else
+    r = &lw_True;
+
+  *s = new_s;
+  return r;
+}
+
+lw_Basis_string lw_Basis_unurlifyString(lw_context ctx, char **s) {
   char *new_s = lw_unurlify_advance(*s);
   char *r, *s1, *s2;
   int len, n;
diff --git a/src/cjr.sml b/src/cjr.sml
index d260e8b3..95a21956 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -40,7 +40,7 @@ withtype typ = typ' located
 
 datatype patCon =
          PConVar of int
-       | PConFfi of {mod : string, datatyp : string, con : string}
+       | PConFfi of {mod : string, datatyp : string, con : string, arg : typ option}
 
 datatype pat' =
          PWild
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index d35c93fe..7ff8f60f 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -116,7 +116,7 @@ fun p_pat_preamble env (p, _) =
 fun p_patCon env pc =
     case pc of
         PConVar n => p_con_named env n
-      | PConFfi _ => raise Fail "CjrPrint PConFfi"
+      | PConFfi {mod = m, con, ...} => string ("lw_" ^ m ^ "_" ^ con)
 
 fun p_pat (env, exit, depth) (p, _) =
     case p of
@@ -276,7 +276,7 @@ fun patConInfo env pc =
             ("__lwd_" ^ dx ^ "_" ^ Int.toString dn,
              "__lwc_" ^ x ^ "_" ^ Int.toString n)
         end
-      | PConFfi {mod = m, datatyp, con} =>
+      | PConFfi {mod = m, datatyp, con, ...} =>
         ("lw_" ^ m ^ "_" ^ datatyp,
          "lw_" ^ m ^ "_" ^ con)
 
@@ -706,11 +706,15 @@ fun p_file env (ds, ps) =
                              string "}"]
                 end
 
+        fun capitalize s =
+            if s = "" then
+                ""
+            else
+                str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
         fun unurlify (t, loc) =
             case t of
-                TFfi ("Basis", "int") => string "lw_unurlifyInt(&request)"
-              | TFfi ("Basis", "float") => string "lw_unurlifyFloat(&request)"
-              | TFfi ("Basis", "string") => string "lw_unurlifyString(ctx, &request)"
+                TFfi (m, t) => string ("lw_" ^ m ^ "_unurlify" ^ capitalize t ^ "(ctx, &request)")
 
               | TRecord 0 => string "lw_unit_v"
               | TRecord i =>
diff --git a/src/cjrize.sml b/src/cjrize.sml
index eedc594e..526a3788 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -103,10 +103,23 @@ fun cifyTyp ((t, loc), sm) =
 
 val dummye = (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan)
 
-fun cifyPatCon pc =
+fun cifyPatCon (pc, sm) =
     case pc of
-        L.PConVar n => L'.PConVar n
-      | L.PConFfi mx => L'.PConFfi mx
+        L.PConVar n => (L'.PConVar n, sm)
+      | L.PConFfi {mod = m, datatyp, con, arg} =>
+        let
+            val (arg, sm) =
+                case arg of
+                    NONE => (NONE, sm)
+                  | SOME t =>
+                    let
+                        val (t, sm) = cifyTyp (t, sm)
+                    in
+                        (SOME t, sm)
+                    end
+        in
+            (L'.PConFfi {mod = m, datatyp = datatyp, con = con, arg = arg}, sm)
+        end
 
 fun cifyPat ((p, loc), sm) =
     case p of
@@ -118,12 +131,18 @@ fun cifyPat ((p, loc), sm) =
             ((L'.PVar (x, t), loc), sm)
         end
       | L.PPrim p => ((L'.PPrim p, loc), sm)
-      | L.PCon (pc, NONE) => ((L'.PCon (cifyPatCon pc, NONE), loc), sm)
+      | L.PCon (pc, NONE) =>
+        let
+            val (pc, sm) = cifyPatCon (pc, sm)
+        in
+            ((L'.PCon (pc, NONE), loc), sm)
+        end
       | L.PCon (pc, SOME p) =>
         let
+            val (pc, sm) = cifyPatCon (pc, sm)
             val (p, sm) = cifyPat (p, sm)
         in
-            ((L'.PCon (cifyPatCon pc, SOME p), loc), sm)
+            ((L'.PCon (pc, SOME p), loc), sm)
         end
       | L.PRecord xps =>
         let
@@ -154,8 +173,9 @@ fun cifyExp ((e, loc), sm) =
                     in
                         (SOME e, sm)
                     end
+            val (pc, sm) = cifyPatCon (pc, sm)
         in
-            ((L'.ECon (cifyPatCon pc, eo), loc), sm)
+            ((L'.ECon (pc, eo), loc), sm)
         end
       | L.EFfi mx => ((L'.EFfi mx, loc), sm)
       | L.EFfiApp (m, x, es) =>
diff --git a/src/compiler.sml b/src/compiler.sml
index 2be17762..15d27b6b 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -430,7 +430,7 @@ fun compileC {cname, oname, ename} =
         if not (OS.Process.isSuccess (OS.Process.system compile)) then
             print "C compilation failed\n"
         else if not (OS.Process.isSuccess (OS.Process.system link)) then
-                print "C linking failed\n"
+            print "C linking failed\n"
         else
             print "Success\n"
     end
@@ -439,18 +439,21 @@ fun compile job =
     case cjrize job of
         NONE => print "Laconic compilation failed\n"
       | SOME file =>
-        let
-            val cname = "/tmp/lacweb.c"
-            val oname = "/tmp/lacweb.o"
-            val ename = "/tmp/webapp"
-
-            val outf = TextIO.openOut cname
-            val s = TextIOPP.openOut {dst = outf, wid = 80}
-        in
-            Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
-            TextIO.closeOut outf;
-
-            compileC {cname = cname, oname = oname, ename = ename}
-        end
+        if ErrorMsg.anyErrors () then
+            print "Laconic compilation failed\n"
+        else
+            let
+                val cname = "/tmp/lacweb.c"
+                val oname = "/tmp/lacweb.o"
+                val ename = "/tmp/webapp"
+
+                val outf = TextIO.openOut cname
+                val s = TextIOPP.openOut {dst = outf, wid = 80}
+            in
+                Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
+                TextIO.closeOut outf;
+
+                compileC {cname = cname, oname = oname, ename = ename}
+            end
 
 end
diff --git a/src/core.sml b/src/core.sml
index 1ecc9691..e9fd570c 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -61,7 +61,7 @@ withtype con = con' located
 
 datatype patCon =
          PConVar of int
-       | PConFfi of {mod : string, datatyp : string, con : string}
+       | PConFfi of {mod : string, datatyp : string, con : string, arg : con option}
 
 datatype pat' =
          PWild
diff --git a/src/core_print.sml b/src/core_print.sml
index d749bdf9..0e797d88 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -162,7 +162,7 @@ fun p_con_named env n =
 fun p_patCon env pc =
     case pc of
         PConVar n => p_con_named env n
-      | PConFfi {mod = m, con, ...} => box [string "FFI(",
+      | PConFfi {mod = m, con, ...} => box [string "FFIC(",
                                             string m,
                                             string ".",
                                             string con,
diff --git a/src/corify.sml b/src/corify.sml
index 81c32f40..146868e6 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -62,7 +62,7 @@ structure St : sig
 
     val enter : t -> t
     val leave : t -> {outer : t, inner : t}
-    val ffi : string -> L'.con SM.map -> string SM.map -> t
+    val ffi : string -> L'.con SM.map -> (string * L'.con option) SM.map -> t
 
     datatype core_con =
              CNormal of int
@@ -72,6 +72,7 @@ structure St : sig
     val lookupConByName : t -> string -> core_con
 
     val bindConstructor : t -> string -> int -> L'.patCon -> t
+    val lookupConstructorByNameOpt : t -> string -> L'.patCon option
     val lookupConstructorByName : t -> string -> L'.patCon
     val lookupConstructorById : t -> int -> L'.patCon
 
@@ -100,7 +101,7 @@ datatype flattening =
                      funs : (string * int * L.str) SM.map}
        | FFfi of {mod : string,
                   vals : L'.con SM.map,
-                  constructors : string SM.map}
+                  constructors : (string * L'.con option) SM.map}
                            
 type t = {
      cons : int IM.map,
@@ -257,12 +258,23 @@ fun lookupConstructorById ({constructors, ...} : t) n =
         NONE => raise Fail "Corify.St.lookupConstructorById"
       | SOME x => x
 
+fun lookupConstructorByNameOpt ({current, ...} : t) x =
+    case current of
+        FFfi {mod = m, constructors, ...} =>
+        (case SM.find (constructors, x) of
+             NONE => NONE
+           | SOME (n, to) => SOME (L'.PConFfi {mod = m, datatyp = n, con = x, arg = to}))
+      | FNormal {constructors, ...} =>
+        case SM.find (constructors, x) of
+            NONE => NONE
+          | SOME n => SOME n
+
 fun lookupConstructorByName ({current, ...} : t) x =
     case current of
         FFfi {mod = m, constructors, ...} =>
         (case SM.find (constructors, x) of
              NONE => raise Fail "Corify.St.lookupConstructorByName [1]"
-           | SOME n => L'.PConFfi {mod = m, datatyp = n, con = x})
+           | SOME (n, to) => L'.PConFfi {mod = m, datatyp = n, con = x, arg = to})
       | FNormal {constructors, ...} =>
         case SM.find (constructors, x) of
             NONE => raise Fail "Corify.St.lookupConstructorByName [2]"
@@ -433,36 +445,43 @@ fun corifyExp st (e, loc) =
             val st = St.lookupStrById st m
             val st = foldl St.lookupStrByName st ms
         in
-            case St.lookupValByName st x of
-                St.ENormal n => (L'.ENamed n, loc)
-              | St.EFfi (m, t) =>
-                case t of
-                    (L'.TFun (dom as (L'.TRecord (L'.CRecord (_, []), _), _), ran), _) =>
-                    (L'.EAbs ("arg", dom, ran, (L'.EFfiApp (m, x, []), loc)), loc)
-                  | t as (L'.TFun _, _) =>
-                    let
-                        fun getArgs (all as (t, _), args) =
-                            case t of
-                                L'.TFun (dom, ran) => getArgs (ran, dom :: args)
-                              | _ => (all, rev args)
-                                     
-                        val (result, args) = getArgs (t, [])
-
-                        val (actuals, _) = foldr (fn (_, (actuals, n)) =>
-                                                     ((L'.ERel n, loc) :: actuals,
-                                                      n + 1)) ([], 0) args
-                        val app = (L'.EFfiApp (m, x, actuals), loc)
-                        val (abs, _, _) = foldr (fn (t, (abs, ran, n)) =>
-                                                    ((L'.EAbs ("arg" ^ Int.toString n,
-                                                               t,
-                                                               ran,
-                                                               abs), loc),
-                                                     (L'.TFun (t, ran), loc),
-                                                     n - 1)) (app, result, length args - 1) args
-                    in
-                        abs
-                    end
-                  | _ => (L'.EFfi (m, x), loc)
+            case St.lookupConstructorByNameOpt st x of
+                SOME (pc as L'.PConFfi {mod = m, datatyp, arg, ...}) =>
+                (case arg of
+                     NONE => (L'.ECon (pc, NONE), loc)
+                   | SOME dom => (L'.EAbs ("x", dom, (L'.CFfi (m, datatyp), loc),
+                                           (L'.ECon (pc, SOME (L'.ERel 0, loc)), loc)), loc))
+              | _ =>
+                case St.lookupValByName st x of
+                    St.ENormal n => (L'.ENamed n, loc)
+                  | St.EFfi (m, t) =>
+                    case t of
+                        (L'.TFun (dom as (L'.TRecord (L'.CRecord (_, []), _), _), ran), _) =>
+                        (L'.EAbs ("arg", dom, ran, (L'.EFfiApp (m, x, []), loc)), loc)
+                      | t as (L'.TFun _, _) =>
+                        let
+                            fun getArgs (all as (t, _), args) =
+                                case t of
+                                    L'.TFun (dom, ran) => getArgs (ran, dom :: args)
+                                  | _ => (all, rev args)
+                                         
+                            val (result, args) = getArgs (t, [])
+
+                            val (actuals, _) = foldr (fn (_, (actuals, n)) =>
+                                                         ((L'.ERel n, loc) :: actuals,
+                                                          n + 1)) ([], 0) args
+                            val app = (L'.EFfiApp (m, x, actuals), loc)
+                            val (abs, _, _) = foldr (fn (t, (abs, ran, n)) =>
+                                                        ((L'.EAbs ("arg" ^ Int.toString n,
+                                                                   t,
+                                                                   ran,
+                                                                   abs), loc),
+                                                         (L'.TFun (t, ran), loc),
+                                                         n - 1)) (app, result, length args - 1) args
+                        in
+                            abs
+                        end
+                      | _ => (L'.EFfi (m, x), loc)
         end
       | L.EApp (e1, e2) => (L'.EApp (corifyExp st e1, corifyExp st e2), loc)
       | L.EAbs (x, dom, ran, e1) => (L'.EAbs (x, corifyCon st dom, corifyCon st ran, corifyExp st e1), loc)
@@ -630,36 +649,48 @@ fun corifyDecl ((d, loc : EM.span), st) =
                                  | L.SgiDatatype (x, n, xnts) =>
                                    let
                                        val (st, n') = St.bindCon st x n
-                                       val (xnts, (st, cmap, conmap)) =
+                                       val (xnts, (ds', st, cmap, conmap)) =
                                            ListUtil.foldlMap
-                                               (fn ((x', n, to), (st, cmap, conmap)) =>
+                                               (fn ((x', n, to), (ds', st, cmap, conmap)) =>
                                                    let
-                                                       val st = St.bindConstructor st x' n
-                                                                                   (L'.PConFfi {mod = m,
-                                                                                                datatyp = x,
-                                                                                                con = x'})
-                                                       val st = St.bindConstructorVal st x' n
-
                                                        val dt = (L'.CNamed n', loc)
 
-                                                       val (to, cmap) =
+                                                       val to = Option.map (corifyCon st) to
+
+                                                       val pc = L'.PConFfi {mod = m,
+                                                                            datatyp = x,
+                                                                            con = x',
+                                                                            arg = to}
+
+                                                       val (cmap, d) =
                                                            case to of
-                                                               NONE => (NONE, SM.insert (cmap, x', dt))
+                                                               NONE => (SM.insert (cmap, x', dt),
+                                                                        (L'.DVal (x', n, dt,
+                                                                                  (L'.ECon (pc, NONE), loc),
+                                                                                  ""), loc))
                                                              | SOME t =>
                                                                let
-                                                                   val t = corifyCon st t
+                                                                   val tf = (L'.TFun (t, dt), loc)
+                                                                   val d = (L'.DVal (x', n, tf,
+                                                                                     (L'.EAbs ("x", t, tf,
+                                                                                               (L'.ECon (pc,
+                                                                                                         SOME (L'.ERel 0,
+                                                                                                               loc)),
+                                                                                                loc)), loc), ""), loc)
                                                                in
-                                                                   (SOME t, SM.insert (cmap, x',
-                                                                                       (L'.TFun (t, dt), loc)))
+                                                                   (SM.insert (cmap, x', tf), d)
                                                                end
 
-                                                       val conmap = SM.insert (conmap, x', x)
+                                                       val st = St.bindConstructor st x' n pc
+                                                       (*val st = St.bindConstructorVal st x' n*)
+
+                                                       val conmap = SM.insert (conmap, x', (x, to))
                                                    in
                                                        ((x', n, to),
-                                                        (st, cmap, conmap))
-                                                   end) (st, cmap, conmap) xnts
+                                                        (d :: ds', st, cmap, conmap))
+                                                   end) ([], st, cmap, conmap) xnts
                                    in
-                                       ((L'.DDatatype (x, n', xnts), loc) :: ds,
+                                       (ds' @ (L'.DDatatype (x, n', xnts), loc) :: ds,
                                         cmap,
                                         conmap,
                                         st)
diff --git a/src/elab_env.sml b/src/elab_env.sml
index 720b19da..0367e023 100644
--- a/src/elab_env.sml
+++ b/src/elab_env.sml
@@ -648,6 +648,7 @@ fun declBinds env (d, loc) =
       | DDatatype (x, n, xncs) =>
         let
             val env = pushCNamedAs env x n (KType, loc) NONE
+            val env = pushDatatype env n 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))
@@ -657,6 +658,7 @@ fun declBinds env (d, loc) =
         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 t = (CNamed n, loc)
         in
diff --git a/src/mono.sml b/src/mono.sml
index 2c55721a..7cc0dc78 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -39,7 +39,7 @@ withtype typ = typ' located
 
 datatype patCon =
          PConVar of int
-       | PConFfi of {mod : string, datatyp : string, con : string}
+       | PConFfi of {mod : string, datatyp : string, con : string, arg : typ option}
 
 datatype pat' =
          PWild
diff --git a/src/mono_print.sml b/src/mono_print.sml
index ea8458eb..91e48b7f 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -80,7 +80,7 @@ fun p_con_named env n =
 fun p_patCon env pc =
     case pc of
         PConVar n => p_con_named env n
-      | PConFfi {mod = m, con, ...} => box [string "FFI(",
+      | PConFfi {mod = m, con, ...} => box [string "FFIC(",
                                             string m,
                                             string ".",
                                             string con,
diff --git a/src/monoize.sml b/src/monoize.sml
index a1d1d570..bd7cdcd0 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -286,17 +286,18 @@ fun setRadioGroup (t : t, x) = {radioGroup = SOME x}
 
 end
 
-fun monoPatCon pc =
+fun monoPatCon env pc =
     case pc of
         L.PConVar n => L'.PConVar n
-      | L.PConFfi mx => L'.PConFfi mx
+      | L.PConFfi {mod = m, datatyp, con, arg} => L'.PConFfi {mod = m, datatyp = datatyp, con = con,
+                                                              arg = Option.map (monoType env) arg}
 
 fun monoPat env (p, loc) =
     case p of
         L.PWild => (L'.PWild, loc)
       | L.PVar (x, t) => (L'.PVar (x, monoType env t), loc)
       | L.PPrim p => (L'.PPrim p, loc)
-      | L.PCon (pc, po) => (L'.PCon (monoPatCon pc, Option.map (monoPat env) po), loc)
+      | L.PCon (pc, po) => (L'.PCon (monoPatCon env pc, Option.map (monoPat env) po), loc)
       | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc)
 
 fun monoExp (env, st, fm) (all as (e, loc)) =
@@ -322,7 +323,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             (SOME e, fm)
                         end
             in
-                ((L'.ECon (monoPatCon pc, eo), loc), fm)
+                ((L'.ECon (monoPatCon env pc, eo), loc), fm)
             end
           | L.EFfi mx => ((L'.EFfi mx, loc), fm)
           | L.EFfiApp (m, x, es) =>
diff --git a/tests/bool.lac b/tests/bool.lac
new file mode 100644
index 00000000..b7e57dca
--- /dev/null
+++ b/tests/bool.lac
@@ -0,0 +1,8 @@
+val page = fn b => <html><body>
+        {cdata (case b of False => "No!" | True => "Yes!")}
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li><a link={page True}>True</a></li>
+        <li><a link={page False}>False</a></li>
+</body></html>