diff options
author | 2009-12-31 18:07:53 -0500 | |
---|---|---|
committer | 2009-12-31 18:07:53 -0500 | |
commit | cc0f3b1b858aa0993d48f672fdbda04736afb635 (patch) | |
tree | 0bde2b80fc3e8df14cd6e16f05bdd88e062aca9a /lib/ur/list.ur | |
parent | 00b1094540b7ae07941b97e3714967eb4519cb1b (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.ur | 33 |
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)) = |