summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-12-22 12:13:23 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-12-22 12:13:23 -0500
commit1399d287e92c4d6a76564cdb2d14e226629de60d (patch)
tree2f9b8a343d9b384b5f9996d02c555e597693f2ea
parenta16e550a2284ab7485429afae24f20032e5bac17 (diff)
Basis.sql_nullable and Top.queryL
-rw-r--r--lib/ur/basis.urs5
-rw-r--r--lib/ur/top.ur5
-rw-r--r--lib/ur/top.urs5
-rw-r--r--src/monoize.sml19
4 files changed, 34 insertions, 0 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index f550ce67..87454ea5 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -484,6 +484,11 @@ val sql_ufunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
val sql_octet_length : sql_ufunc blob int
+val sql_nullable : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+ -> sql_injectable_prim t
+ -> sql_exp tables agg exps t
+ -> sql_exp tables agg exps (option t)
+
(*** Executing queries *)
val query : tables ::: {{Type}} -> exps ::: {Type}
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 9a27f6b2..e4e33940 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -208,6 +208,11 @@ fun foldRX3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [ctx ::
<xml>{f [nm] [t] [rest] ! r1 r2 r3}{acc}</xml>)
<xml/>
+fun queryL [tables] [exps] [tables ~ exps] (q : sql_query tables exps) =
+ query q
+ (fn r ls => return (r :: ls))
+ []
+
fun queryI [tables ::: {{Type}}] [exps ::: {Type}]
[tables ~ exps] (q : sql_query tables exps)
(f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index 92fb9edd..11547ace 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -118,6 +118,11 @@ val foldRX3 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Typ
-> r :: {K} -> folder r
-> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> xml ctx [] []
+val queryL : tables ::: {{Type}} -> exps ::: {Type}
+ -> [tables ~ exps] =>
+ sql_query tables exps
+ -> transaction (list $(exps ++ map (fn fields :: {Type} => $fields) tables))
+
val queryI : tables ::: {{Type}} -> exps ::: {Type}
-> [tables ~ exps] =>
sql_query tables exps
diff --git a/src/monoize.sml b/src/monoize.sml
index f6a56c33..e9d90ecc 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2469,6 +2469,25 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
fm)
end
+ | L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.EFfi ("Basis", "sql_nullable"), _),
+ _), _),
+ _), _),
+ _), _),
+ _) =>
+ let
+ val s = (L'.TFfi ("Basis", "string"), loc)
+ fun sc s = (L'.EPrim (Prim.String s), loc)
+ in
+ ((L'.EAbs ("u", (L'.TRecord [], loc), (L'.TFun (s, s), loc),
+ (L'.EAbs ("x", s, s,
+ (L'.ERel 0, loc)), loc)), loc),
+ fm)
+ end
+
| L.EFfiApp ("Basis", "nextval", [e]) =>
let
val (e, fm) = monoExp (env, st, fm) e