Mercurial > urweb
diff lib/ur/list.ur @ 1107:52571ca9b777
Eta-expand bodies of transaction functions in Monoization, to enable later optimization
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 31 Dec 2009 18:07:53 -0500 |
parents | eaba663fd6aa |
children | 61c3139eab12 |
line wrap: on
line diff
--- a/lib/ur/list.ur Thu Dec 31 16:12:13 2009 -0500 +++ b/lib/ur/list.ur Thu Dec 31 18:07:53 2009 -0500 @@ -133,6 +133,20 @@ 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 @@ []; 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)) =