pquery working with all four types of columns

13 files changed, 93 insertions, 26 deletions

diff --git a/include/urweb.h b/include/urweb.h
index 51e6f04d..6dbd25d2 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -66,10 +66,10 @@ lw_Basis_bool lw_Basis_unurlifyBool(lw_context, char **);
 lw_Basis_string lw_Basis_strcat(lw_context, lw_Basis_string, lw_Basis_string);
 lw_Basis_string lw_Basis_strdup(lw_context, lw_Basis_string);
 
-lw_Basis_int lw_Basis_sqlifyInt(lw_context, lw_Basis_int);
-lw_Basis_float lw_Basis_sqlifyFloat(lw_context, lw_Basis_float);
+lw_Basis_string lw_Basis_sqlifyInt(lw_context, lw_Basis_int);
+lw_Basis_string lw_Basis_sqlifyFloat(lw_context, lw_Basis_float);
 lw_Basis_string lw_Basis_sqlifyString(lw_context, lw_Basis_string);
-lw_Basis_bool lw_Basis_sqlifyBool(lw_context, lw_Basis_bool);
+lw_Basis_string lw_Basis_sqlifyBool(lw_context, lw_Basis_bool);
 
 char *lw_Basis_ensqlBool(lw_Basis_bool);
 
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)
diff --git a/tests/pquery.ur b/tests/pquery.ur
index ea53f7c9..eb240909 100644
--- a/tests/pquery.ur
+++ b/tests/pquery.ur
@@ -1,19 +1,51 @@
 table t1 : {A : int, B : string, C : float, D : bool}
 
-fun lookup (inp : {B : string}) =
-        s <- query (SELECT * FROM t1 WHERE t1.B = {inp.B})
-                (fn fs _ => return fs.T1)
-                {A = 0, B = "Couldn't find it!", C = 0.0, D = False};
+fun display (q : sql_query [T1 = [A = int, B = string, C = float, D = bool]] []) =
+        s <- query q
+                (fn fs _ => return (Some fs.T1))
+                None;
         return <html><body>
-                A: {cdata (show _ s.A)}<br/>
-                B: {cdata (show _ s.B)}<br/>
-                C: {cdata (show _ s.C)}<br/>
-                D: {cdata (show _ s.D)}<br/>
+                {case s of
+                  None => cdata "Row not found."
+                | Some s =>
+                        <body>
+                                A: {cdata (show _ s.A)}<br/>
+                                B: {cdata (show _ s.B)}<br/>
+                                C: {cdata (show _ s.C)}<br/>
+                                D: {cdata (show _ s.D)}<br/>
+                        </body>}
         </body></html>
 
+fun lookupA (inp : {A : string}) =
+        display (SELECT * FROM t1 WHERE t1.A = {readError _ inp.A : int})
+
+fun lookupB (inp : {B : string}) =
+        display (SELECT * FROM t1 WHERE t1.B = {inp.B})
+
+fun lookupC (inp : {C : string}) =
+        display (SELECT * FROM t1 WHERE t1.C = {readError _ inp.C : float})
+
+fun lookupD (inp : {D : string}) =
+        display (SELECT * FROM t1 WHERE t1.D = {readError _ inp.D : bool})
+
 fun main () : transaction page = return <html><body>
         <lform>
+                A: <textbox{#A}/>
+                <submit action={lookupA}/>
+        </lform>
+
+        <lform>
                 B: <textbox{#B}/>
-                <submit action={lookup}/>
+                <submit action={lookupB}/>
+        </lform>
+
+        <lform>
+                C: <textbox{#C}/>
+                <submit action={lookupC}/>
+        </lform>
+
+        <lform>
+                D: <textbox{#D}/>
+                <submit action={lookupD}/>
         </lform>
 </body></html>