never executed always true always false
1 -- | Utilities related to Monad and Applicative classes
2 -- Mostly for backwards compatibility.
3
4 module GHC.Utils.Monad
5 ( Applicative(..)
6 , (<$>)
7
8 , MonadFix(..)
9 , MonadIO(..)
10
11 , zipWith3M, zipWith3M_, zipWith4M, zipWithAndUnzipM
12 , mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M, mapAndUnzip5M
13 , mapAccumLM
14 , liftFstM, liftSndM
15 , mapSndM
16 , concatMapM
17 , mapMaybeM
18 , fmapMaybeM, fmapEitherM
19 , anyM, allM, orM
20 , foldlM, foldlM_, foldrM
21 , maybeMapM
22 , whenM, unlessM
23 , filterOutM
24 ) where
25
26 -------------------------------------------------------------------------------
27 -- Imports
28 -------------------------------------------------------------------------------
29
30 import GHC.Prelude
31
32 import Control.Applicative
33 import Control.Monad
34 import Control.Monad.Fix
35 import Control.Monad.IO.Class
36 import Data.Foldable (sequenceA_, foldlM, foldrM)
37 import Data.List (unzip4, unzip5, zipWith4)
38
39 -------------------------------------------------------------------------------
40 -- Common functions
41 -- These are used throughout the compiler
42 -------------------------------------------------------------------------------
43
44 {-
45
46 Note [Inline @zipWithNM@ functions]
47 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
48
49 The inline principle for 'zipWith3M', 'zipWith4M' and 'zipWith3M_' is the same
50 as for 'zipWithM' and 'zipWithM_' in "Control.Monad", see
51 Note [Fusion for zipN/zipWithN] in GHC/List.hs for more details.
52
53 The 'zipWithM'/'zipWithM_' functions are inlined so that the `zipWith` and
54 `sequenceA` functions with which they are defined have an opportunity to fuse.
55
56 Furthermore, 'zipWith3M'/'zipWith4M' and 'zipWith3M_' have been explicitly
57 rewritten in a non-recursive way similarly to 'zipWithM'/'zipWithM_', and for
58 more than just uniformity: after [D5241](https://phabricator.haskell.org/D5241)
59 for issue #14037, all @zipN@/@zipWithN@ functions fuse, meaning
60 'zipWith3M'/'zipWIth4M' and 'zipWith3M_'@ now behave like 'zipWithM' and
61 'zipWithM_', respectively, with regards to fusion.
62
63 As such, since there are not any differences between 2-ary 'zipWithM'/
64 'zipWithM_' and their n-ary counterparts below aside from the number of
65 arguments, the `INLINE` pragma should be replicated in the @zipWithNM@
66 functions below as well.
67
68 -}
69
70 zipWith3M :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]
71 {-# INLINE zipWith3M #-}
72 -- Inline so that fusion with 'zipWith3' and 'sequenceA' has a chance to fire.
73 -- See Note [Inline @zipWithNM@ functions] above.
74 zipWith3M f xs ys zs = sequenceA (zipWith3 f xs ys zs)
75
76 zipWith3M_ :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m ()
77 {-# INLINE zipWith3M_ #-}
78 -- Inline so that fusion with 'zipWith4' and 'sequenceA' has a chance to fire.
79 -- See Note [Inline @zipWithNM@ functions] above.
80 zipWith3M_ f xs ys zs = sequenceA_ (zipWith3 f xs ys zs)
81
82 zipWith4M :: Monad m => (a -> b -> c -> d -> m e)
83 -> [a] -> [b] -> [c] -> [d] -> m [e]
84 {-# INLINE zipWith4M #-}
85 -- Inline so that fusion with 'zipWith5' and 'sequenceA' has a chance to fire.
86 -- See Note [Inline @zipWithNM@ functions] above.
87 zipWith4M f xs ys ws zs = sequenceA (zipWith4 f xs ys ws zs)
88
89 zipWithAndUnzipM :: Monad m
90 => (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
91 {-# INLINABLE zipWithAndUnzipM #-} -- this allows specialization to a given monad
92 zipWithAndUnzipM f (x:xs) (y:ys)
93 = do { (c, d) <- f x y
94 ; (cs, ds) <- zipWithAndUnzipM f xs ys
95 ; return (c:cs, d:ds) }
96 zipWithAndUnzipM _ _ _ = return ([], [])
97
98 {-
99
100 Note [Inline @mapAndUnzipNM@ functions]
101 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
102
103 The inline principle is the same as 'mapAndUnzipM' in "Control.Monad".
104 The 'mapAndUnzipM' function is inlined so that the `unzip` and `traverse`
105 functions with which it is defined have an opportunity to fuse, see
106 Note [Inline @unzipN@ functions] in Data/OldList.hs for more details.
107
108 Furthermore, the @mapAndUnzipNM@ functions have been explicitly rewritten in a
109 non-recursive way similarly to 'mapAndUnzipM', and for more than just
110 uniformity: after [D5249](https://phabricator.haskell.org/D5249) for Trac
111 ticket #14037, all @unzipN@ functions fuse, meaning 'mapAndUnzip3M',
112 'mapAndUnzip4M' and 'mapAndUnzip5M' now behave like 'mapAndUnzipM' with regards
113 to fusion.
114
115 As such, since there are not any differences between 2-ary 'mapAndUnzipM' and
116 its n-ary counterparts below aside from the number of arguments, the `INLINE`
117 pragma should be replicated in the @mapAndUnzipNM@ functions below as well.
118
119 -}
120
121 -- | mapAndUnzipM for triples
122 mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])
123 {-# INLINE mapAndUnzip3M #-}
124 -- Inline so that fusion with 'unzip3' and 'traverse' has a chance to fire.
125 -- See Note [Inline @mapAndUnzipNM@ functions] above.
126 mapAndUnzip3M f xs = unzip3 <$> traverse f xs
127
128 mapAndUnzip4M :: Monad m => (a -> m (b,c,d,e)) -> [a] -> m ([b],[c],[d],[e])
129 {-# INLINE mapAndUnzip4M #-}
130 -- Inline so that fusion with 'unzip4' and 'traverse' has a chance to fire.
131 -- See Note [Inline @mapAndUnzipNM@ functions] above.
132 mapAndUnzip4M f xs = unzip4 <$> traverse f xs
133
134 mapAndUnzip5M :: Monad m => (a -> m (b,c,d,e,f)) -> [a] -> m ([b],[c],[d],[e],[f])
135 {-# INLINE mapAndUnzip5M #-}
136 -- Inline so that fusion with 'unzip5' and 'traverse' has a chance to fire.
137 -- See Note [Inline @mapAndUnzipNM@ functions] above.
138 mapAndUnzip5M f xs = unzip5 <$> traverse f xs
139
140 -- TODO: mapAccumLM is used in many places. Surely most of
141 -- these don't actually want to be lazy. We should add a strict
142 -- variant and use it where appropriate.
143
144 -- | Monadic version of mapAccumL
145 mapAccumLM :: Monad m
146 => (acc -> x -> m (acc, y)) -- ^ combining function
147 -> acc -- ^ initial state
148 -> [x] -- ^ inputs
149 -> m (acc, [y]) -- ^ final state, outputs
150 mapAccumLM f s xs =
151 go s xs
152 where
153 go s (x:xs) = do
154 (s1, x') <- f s x
155 (s2, xs') <- go s1 xs
156 return (s2, x' : xs')
157 go s [] = return (s, [])
158
159 -- | Monadic version of mapSnd
160 mapSndM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
161 mapSndM f xs = go xs
162 where
163 go [] = return []
164 go ((a,b):xs) = do { c <- f b; rs <- go xs; return ((a,c):rs) }
165
166 liftFstM :: Monad m => (a -> b) -> m (a, r) -> m (b, r)
167 liftFstM f thing = do { (a,r) <- thing; return (f a, r) }
168
169 liftSndM :: Monad m => (a -> b) -> m (r, a) -> m (r, b)
170 liftSndM f thing = do { (r,a) <- thing; return (r, f a) }
171
172 -- | Monadic version of concatMap
173 concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
174 concatMapM f xs = liftM concat (mapM f xs)
175
176 -- | Applicative version of mapMaybe
177 mapMaybeM :: Applicative m => (a -> m (Maybe b)) -> [a] -> m [b]
178 mapMaybeM f = foldr g (pure [])
179 where g a = liftA2 (maybe id (:)) (f a)
180
181 -- | Monadic version of fmap
182 fmapMaybeM :: (Monad m) => (a -> m b) -> Maybe a -> m (Maybe b)
183 fmapMaybeM _ Nothing = return Nothing
184 fmapMaybeM f (Just x) = f x >>= (return . Just)
185
186 -- | Monadic version of fmap
187 fmapEitherM :: Monad m => (a -> m b) -> (c -> m d) -> Either a c -> m (Either b d)
188 fmapEitherM fl _ (Left a) = fl a >>= (return . Left)
189 fmapEitherM _ fr (Right b) = fr b >>= (return . Right)
190
191 -- | Monadic version of 'any', aborts the computation at the first @True@ value
192 anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
193 anyM f xs = go xs
194 where
195 go [] = return False
196 go (x:xs) = do b <- f x
197 if b then return True
198 else go xs
199
200 -- | Monad version of 'all', aborts the computation at the first @False@ value
201 allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
202 allM f bs = go bs
203 where
204 go [] = return True
205 go (b:bs) = (f b) >>= (\bv -> if bv then go bs else return False)
206
207 -- | Monadic version of or
208 orM :: Monad m => m Bool -> m Bool -> m Bool
209 orM m1 m2 = m1 >>= \x -> if x then return True else m2
210
211 -- | Monadic version of foldl that discards its result
212 foldlM_ :: (Monad m, Foldable t) => (a -> b -> m a) -> a -> t b -> m ()
213 foldlM_ = foldM_
214
215 -- | Monadic version of fmap specialised for Maybe
216 maybeMapM :: Monad m => (a -> m b) -> (Maybe a -> m (Maybe b))
217 maybeMapM _ Nothing = return Nothing
218 maybeMapM m (Just x) = liftM Just $ m x
219
220 -- | Monadic version of @when@, taking the condition in the monad
221 whenM :: Monad m => m Bool -> m () -> m ()
222 whenM mb thing = do { b <- mb
223 ; when b thing }
224
225 -- | Monadic version of @unless@, taking the condition in the monad
226 unlessM :: Monad m => m Bool -> m () -> m ()
227 unlessM condM acc = do { cond <- condM
228 ; unless cond acc }
229
230 -- | Like 'filterM', only it reverses the sense of the test.
231 filterOutM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]
232 filterOutM p =
233 foldr (\ x -> liftA2 (\ flg -> if flg then id else (x:)) (p x)) (pure [])
234
235 {- Note [The one-shot state monad trick]
236 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
237 Summary: many places in GHC use a state monad, and we really want those
238 functions to be eta-expanded (#18202).
239
240 The problem
241 ~~~~~~~~~~~
242 Consider
243 newtype M a = MkM (State -> (State, a))
244
245 instance Monad M where
246 mf >>= k = MkM (\s -> case mf of MkM f ->
247 case f s of (s',r) ->
248 case k r of MkM g ->
249 g s')
250
251 fooM :: Int -> M Int
252 fooM x = g y >>= \r -> h r
253 where
254 y = expensive x
255
256 Now suppose you say (repeat 20 (fooM 4)), where
257 repeat :: Int -> M Int -> M Int
258 performs its argument n times. You would expect (expensive 4) to be
259 evaluated only once, not 20 times. So foo should have arity 1 (not 2);
260 it should look like this (modulo casts)
261
262 fooM x = let y = expensive x in
263 \s -> case g y of ...
264
265 But creating and then repeating, a monadic computation is rare. If you
266 /aren't/ re-using (M a) value, it's /much/ more efficient to make
267 foo have arity 2, thus:
268
269 fooM x s = case g (expensive x) of ...
270
271 Why more efficient? Because now foo takes its argument both at once,
272 rather than one at a time, creating a heap-allocated function closure. See
273 https://www.joachim-breitner.de/blog/763-Faster_Winter_5__Eta-Expanding_ReaderT
274 for a very good explanation of the issue which led to these optimisations
275 into GHC.
276
277 The trick
278 ~~~~~~~~~
279 With state monads like M the general case is that we *aren't* reusing
280 (M a) values so it is much more efficient to avoid allocating a
281 function closure for them. So the state monad trick is a way to keep
282 the monadic syntax but to make GHC eta-expand functions like `fooM`.
283 To do that we use the "oneShot" magic function.
284
285 Here is the trick:
286 * Define a "smart constructor"
287 mkM :: (State -> (State,a)) -> M a
288 mkM f = MkM (oneShot m)
289
290 * Never call MkM directly, as a constructor. Instead, always call mkM.
291
292 And that's it! The magic 'oneShot' function does this transformation:
293 oneShot (\s. e) ==> \s{os}. e
294 which pins a one-shot flag {os} onto the binder 's'. That tells GHC
295 that it can assume the lambda is called only once, and thus can freely
296 float computations in and out of the lambda.
297
298 To be concrete, let's see what happens to fooM:
299
300 fooM = \x. g (expensive x) >>= \r -> h r
301 = \x. let mf = g (expensive x)
302 k = \r -> h r
303 in MkM (oneShot (\s -> case mf of MkM' f ->
304 case f s of (s',r) ->
305 case k r of MkM' g ->
306 g s'))
307 -- The MkM' are just newtype casts nt_co
308 = \x. let mf = g (expensive x)
309 k = \r -> h r
310 in (\s{os}. case (mf |> nt_co) s of (s',r) ->
311 (k r) |> nt_co s')
312 |> sym nt_co
313
314 -- Crucial step: float let-bindings into that \s{os}
315 = \x. (\s{os}. case (g (expensive x) |> nt_co) s of (s',r) ->
316 h r |> nt_co s')
317 |> sym nt_co
318
319 and voila! fooM has arity 2.
320
321 The trick is very similar to the built-in "state hack"
322 (see Note [The state-transformer hack] in "GHC.Core.Opt.Arity") but is
323 applicable on a monad-by-monad basis under programmer control.
324
325 Using pattern synonyms
326 ~~~~~~~~~~~~~~~~~~~~~~
327 Using a smart constructor is fine, but there is no way to check that we
328 have found *all* uses, especially if the uses escape a single module.
329 A neat (but more sophisticated) alternative is to use pattern synonyms:
330
331 -- We rename the existing constructor.
332 newtype M a = MkM' (State -> (State, a))
333
334 -- The pattern has the old constructor name.
335 pattern MkM f <- MkM' f
336 where
337 MkM f = MkM' (oneShot f)
338
339 Now we can simply grep to check that there are no uses of MkM'
340 /anywhere/, to guarantee that we have not missed any. (Using the
341 smart constructor alone we still need the data constructor in
342 patterns.) That's the advantage of the pattern-synonym approach, but
343 it is more elaborate.
344
345 The pattern synonym approach is due to Sebastian Graaf (#18238)
346
347 Do note that for monads for multiple arguments more than one oneShot
348 function might be required. For example in FCode we use:
349
350 newtype FCode a = FCode' { doFCode :: CgInfoDownwards -> CgState -> (a, CgState) }
351
352 pattern FCode :: (CgInfoDownwards -> CgState -> (a, CgState))
353 -> FCode a
354 pattern FCode m <- FCode' m
355 where
356 FCode m = FCode' $ oneShot (\cgInfoDown -> oneShot (\state ->m cgInfoDown state))
357
358 INLINE pragmas and (>>)
359 ~~~~~~~~~~~~~~~~~~~~~~~
360 A nasty gotcha is described in #20008. In brief, be careful if you get (>>) via
361 its default method:
362
363 instance Applicative M where
364 pure a = MkM (\s -> (s, a))
365 (<*>) = ap
366
367 instance Monad UM where
368 {-# INLINE (>>=) #-}
369 m >>= k = MkM (\s -> blah)
370
371 Here we define (>>), via its default method, in terms of (>>=). If you do this,
372 be sure to put an INLINE pragma on (>>=), as above. That tells it to inline
373 (>>=) in the RHS of (>>), even when it is applied to only two arguments, which
374 in turn conveys the one-shot info from (>>=) to (>>). Lacking the INLINE, GHC
375 may eta-expand (>>), and with a non-one-shot lambda. #20008 has more discussion.
376
377 Derived instances
378 ~~~~~~~~~~~~~~~~~
379 One caveat of both approaches is that derived instances don't use the smart
380 constructor /or/ the pattern synonym. So they won't benefit from the automatic
381 insertion of "oneShot".
382
383 data M a = MkM' (State -> (State,a))
384 deriving (Functor) <-- Functor implementation will use MkM'!
385
386 Conclusion: don't use 'derviving' in these cases.
387
388 Multi-shot actions (cf #18238)
389 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
390 Sometimes we really *do* want computations to be shared! Remember our
391 example (repeat 20 (fooM 4)). See Note [multiShotIO] in GHC.Types.Unique.Supply
392
393 We can force fooM to have arity 1 using multiShot:
394
395 fooM :: Int -> M Int
396 fooM x = multiShotM (g y >>= \r -> h r)
397 where
398 y = expensive x
399
400 multiShotM :: M a -> M a
401 {-# INLINE multiShotM #-}
402 multiShotM (MkM m) = MkM (\s -> inline m s)
403 -- Really uses the data constructor,
404 -- not the smart constructor!
405
406 Now we can see how fooM optimises (ignoring casts)
407
408 multiShotM (g y >>= \r -> h r)
409 ==> {inline (>>=)}
410 multiShotM (\s{os}. case g y s of ...)
411 ==> {inline multiShotM}
412 let m = \s{os}. case g y s of ...
413 in \s. inline m s
414 ==> {inline m}
415 \s. (\s{os}. case g y s of ...) s
416 ==> \s. case g y s of ...
417
418 and voila! the one-shot flag has gone. It's possible that y has been
419 replaced by (expensive x), but full laziness should pull it back out.
420 (This part seems less robust.)
421
422 The magic `inline` function does two things
423 * It prevents eta reduction. If we wrote just
424 multiShotIO (IO m) = IO (\s -> m s)
425 the lamda would eta-reduce to 'm' and all would be lost.
426
427 * It helps ensure that 'm' really does inline.
428
429 Note that 'inline' evaporates in phase 0. See Note [inlineIdMagic]
430 in GHC.Core.Opt.ConstantFold.match_inline.
431
432 The INLINE pragma on multiShotM is very important, else the
433 'inline' call will evaporate when compiling the module that
434 defines 'multiShotM', before it is ever exported.
435 -}