Mercurial > urweb

comparison lib/ur/list.ur @ 1107:52571ca9b777

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
1106:c9137606733a 1107:52571ca9b777
131 | x :: ls => x' <- f x; mapM' (x' :: acc) ls 131 | x :: ls => x' <- f x; mapM' (x' :: acc) ls
132 in 132 in
133 mapM' [] 133 mapM' []
134 end 134 end
135 135
136 fun mapPartialM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f =
137 let
138 fun mapPartialM' acc ls =
139 case ls of
140 [] => return (rev acc)
141 | x :: ls =>
142 v <- f x;
143 mapPartialM' (case v of
144 None => acc
145 | Some x' => x' :: acc) ls
146 in
147 mapPartialM' []
148 end
149
136 fun mapXM [m ::: (Type -> Type)] (_ : monad m) [a] [ctx ::: {Unit}] f = 150 fun mapXM [m ::: (Type -> Type)] (_ : monad m) [a] [ctx ::: {Unit}] f =
137 let 151 let
138 fun mapXM' ls = 152 fun mapXM' ls =
139 case ls of 153 case ls of
140 [] => return <xml/> 154 [] => return <xml/>
235 ls <- query q 249 ls <- query q
236 (fn fs acc => return (f fs :: acc)) 250 (fn fs acc => return (f fs :: acc))
237 []; 251 [];
238 return (rev ls) 252 return (rev ls)
239 253
254 fun mapQueryM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type]
255 [tables ~ exps] (q : sql_query tables exps)
256 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction t) =
257 ls <- query q
258 (fn fs acc => v <- f fs; return (v :: acc))
259 [];
260 return (rev ls)
261
262 fun mapQueryPartialM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type]
263 [tables ~ exps] (q : sql_query tables exps)
264 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction (option t)) =
265 ls <- query q
266 (fn fs acc => v <- f fs;
267 return (case v of
268 None => acc
269 | Some v => v :: acc))
270 [];
271 return (rev ls)
272
240 fun assoc [a] [b] (_ : eq a) (x : a) = 273 fun assoc [a] [b] (_ : eq a) (x : a) =
241 let 274 let
242 fun assoc' (ls : list (a * b)) = 275 fun assoc' (ls : list (a * b)) =
243 case ls of 276 case ls of
244 [] => None 277 [] => None