pquery working with all four types of columns

11 files changed, 49 insertions, 14 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
index 74c4bca2..ac30bd9f 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -60,6 +60,7 @@ datatype exp' =
        | ERel of int
        | ENamed of int
        | ECon of datatype_kind * patCon * exp option
+       | ENone of typ
        | ESome of typ * exp
        | EFfi of string * string
        | EFfiApp of string * string * exp list
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 24dedb6c..022b9a68 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -518,6 +518,7 @@ fun p_exp' par env (e, loc) =
                  newline,
                  string "})"]          
         end
+      | ENone _ => string "NULL"
       | ESome (t, e) =>
         (case #1 t of
              TDatatype _ => p_exp' par env e
diff --git a/src/cjrize.sml b/src/cjrize.sml
index e137c6fd..1f515552 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -211,6 +211,12 @@ fun cifyExp (eAll as (e, loc), sm) =
         in
             ((L'.ECon (dk, pc, eo), loc), sm)
         end
+      | L.ENone t =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+        in
+            ((L'.ENone t, loc), sm)
+        end
       | L.ESome (t, e) =>
         let
             val (t, sm) = cifyTyp (t, sm)
diff --git a/src/compiler.sml b/src/compiler.sml
index 09080809..1578da71 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -467,8 +467,8 @@ val toSqlify = transform sqlify "sqlify" o toMono_opt2
 
 fun compileC {cname, oname, ename} =
     let
-        val compile = "gcc -s -O3 -I include -c " ^ cname ^ " -o " ^ oname
-        val link = "gcc -s -O3 -pthread -lpq clib/urweb.o " ^ oname ^ " clib/driver.o -o " ^ ename
+        val compile = "gcc -Wstrict-prototypes -Werror -s -O3 -I include -c " ^ cname ^ " -o " ^ oname
+        val link = "gcc -Werror -s -O3 -pthread -lpq clib/urweb.o " ^ oname ^ " clib/driver.o -o " ^ ename
     in
         if not (OS.Process.isSuccess (OS.Process.system compile)) then
             print "C compilation failed\n"
diff --git a/src/elab_env.sml b/src/elab_env.sml
index 89a2b4ff..1b9de129 100644
--- a/src/elab_env.sml
+++ b/src/elab_env.sml
@@ -991,17 +991,23 @@ fun declBinds env (d, loc) =
         DCon (x, n, k, c) => pushCNamedAs env x n k (SOME c)
       | DDatatype (x, n, xs, xncs) =>
         let
-            val env = pushCNamedAs env x n (KType, loc) NONE
+            val k = (KType, loc) 
+            val nxs = length xs
+            val (tb, kb) = ListUtil.foldli (fn (i, x', (tb, kb)) =>
+                                               ((CApp (tb, (CRel (nxs - i - 1), loc)), loc),
+                                                (KArrow (k, kb), loc)))
+                                           ((CNamed n, loc), k) xs
+                                              
+            val env = pushCNamedAs env x n kb NONE
             val env = pushDatatype env n xs xncs
         in
             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
+                                  NONE => tb
+                                | SOME t => (TFun (t, tb), loc)
+                          val t = foldr (fn (x, t) => (TCFun (Implicit, x, k, t), loc)) t xs
                       in
                           pushENamedAs env x' n' t
                       end)
@@ -1010,19 +1016,24 @@ fun declBinds env (d, loc) =
       | 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 k = (KType, loc) 
+            val nxs = length xs
+            val (tb, kb) = ListUtil.foldli (fn (i, x', (tb, kb)) =>
+                                               ((CApp (tb, (CRel (nxs - i - 1), loc)), loc),
+                                                (KArrow (k, kb), loc)))
+                                           ((CNamed n, loc), k) xs
+
+            val t' = foldr (fn (x, t) => (TCFun (Implicit, x, k, t), loc)) t xs
+            val env = pushCNamedAs env x n kb (SOME t')
             val env = pushDatatype env n xs xncs
-
-            val t = (CNamed n, loc)
         in
             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
+                                  NONE => tb
+                                | SOME t => (TFun (t, tb), loc)
+                          val t = foldr (fn (x, t) => (TCFun (Implicit, x, k, t), loc)) t xs
                       in
                           pushENamedAs env x' n' t
                       end)
diff --git a/src/mono.sml b/src/mono.sml
index 8c69443a..ce34c585 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -60,6 +60,7 @@ datatype exp' =
        | ERel of int
        | ENamed of int
        | ECon of datatype_kind * patCon * exp option
+       | ENone of typ
        | ESome of typ * exp
        | EFfi of string * string
        | EFfiApp of string * string * exp list
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 19084a65..643cb657 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -130,6 +130,7 @@ fun p_exp' par env (e, _) =
       | ECon (_, pc, SOME e) => parenIf par (box [p_patCon env pc,
                                                   space,
                                                   p_exp' true env e])
+      | ENone _ => string "None"
       | ESome (_, e) => parenIf par (box [string "Some",
                                           space,
                                           p_exp' true env e])
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 42f32256..9ae44e47 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -45,6 +45,7 @@ fun impure (e, _) =
       | ERel _ => false
       | ENamed _ => false
       | ECon (_, _, eo) => (case eo of NONE => false | SOME e => impure e)
+      | ENone _ => false
       | ESome (_, e) => impure e
       | EFfi _ => false
       | EFfiApp _ => false
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 90ae3a4f..3e6a9f0f 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -145,6 +145,10 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                 S.map2 (mfe ctx e,
                         fn e' =>
                            (ECon (dk, n, SOME e'), loc))
+              | ENone t =>
+                S.map2 (mft t,
+                        fn t' =>
+                           (ENone t', loc))
               | ESome (t, e) =>
                 S.bind2 (mft t,
                          fn t' =>
diff --git a/src/monoize.sml b/src/monoize.sml
index ebca1d43..09735568 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -478,6 +478,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             in
                 ((L'.ECon (dk, monoPatCon env pc, eo), loc), fm)
             end
+          | L.ECon (L.Option, _, [t], NONE) =>
+            ((L'.ENone (monoType env t), loc), fm)
+          | L.ECon (L.Option, _, [t], SOME e) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.ESome (monoType env t, e), loc), fm)
+            end
           | L.ECon _ => poly ()
 
           | L.ECApp ((L.EFfi ("Basis", "show"), _), t) =>
diff --git a/src/prepare.sml b/src/prepare.sml
index f74b8747..a1dd0e79 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -60,6 +60,7 @@ fun prepExp (e as (_, loc), sns) =
         in
             ((ECon (dk, pc, SOME e), loc), sns)
         end
+      | ENone t => (e, sns)
       | ESome (t, e) =>
         let
             val (e, sns) = prepExp (e, sns)