summaryrefslogtreecommitdiff
path: root/lib/ur/list.ur
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-12-31 18:07:53 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-12-31 18:07:53 -0500
commit76a84dd3fb97b56605292c4f0eab2febe3c6a7ed (patch)
tree0bde2b80fc3e8df14cd6e16f05bdd88e062aca9a /lib/ur/list.ur
parentd57cc15e6b5c1f77ebfbfa222283809a4f594e36 (diff)
Eta-expand bodies of transaction functions in Monoization, to enable later optimization
Diffstat (limited to 'lib/ur/list.ur')
-rw-r--r--lib/ur/list.ur33
1 files changed, 33 insertions, 0 deletions
diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index 3abd8b97..bca5f4ba 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -133,6 +133,20 @@ fun mapM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f =
mapM' []
end
+fun mapPartialM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f =
+ let
+ fun mapPartialM' acc ls =
+ case ls of
+ [] => return (rev acc)
+ | x :: ls =>
+ v <- f x;
+ mapPartialM' (case v of
+ None => acc
+ | Some x' => x' :: acc) ls
+ in
+ mapPartialM' []
+ end
+
fun mapXM [m ::: (Type -> Type)] (_ : monad m) [a] [ctx ::: {Unit}] f =
let
fun mapXM' ls =
@@ -237,6 +251,25 @@ fun mapQuery [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type]
[];
return (rev ls)
+fun mapQueryM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type]
+ [tables ~ exps] (q : sql_query tables exps)
+ (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction t) =
+ ls <- query q
+ (fn fs acc => v <- f fs; return (v :: acc))
+ [];
+ return (rev ls)
+
+fun mapQueryPartialM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type]
+ [tables ~ exps] (q : sql_query tables exps)
+ (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction (option t)) =
+ ls <- query q
+ (fn fs acc => v <- f fs;
+ return (case v of
+ None => acc
+ | Some v => v :: acc))
+ [];
+ return (rev ls)
+
fun assoc [a] [b] (_ : eq a) (x : a) =
let
fun assoc' (ls : list (a * b)) =