Treat banged bindings as FunBinds
[ghc.git] / compiler / typecheck / TcGenFunctor.hs
1 {-
2 (c) The University of Glasgow 2011
3
4
5 The deriving code for the Functor, Foldable, and Traversable classes
6 (equivalent to the code in TcGenDeriv, for other classes)
7 -}
8
9 {-# LANGUAGE ScopedTypeVariables #-}
10
11 module TcGenFunctor (
12 FFoldType(..), functorLikeTraverse,
13 deepSubtypesContaining, foldDataConArgs,
14
15 gen_Functor_binds, gen_Foldable_binds, gen_Traversable_binds
16 ) where
17
18 import Bag
19 import DataCon
20 import FastString
21 import HsSyn
22 import Panic
23 import PrelNames
24 import RdrName
25 import SrcLoc
26 import State
27 import TcGenDeriv
28 import TcType
29 import TyCon
30 import TyCoRep
31 import Type
32 import Util
33 import Var
34 import VarSet
35 import MkId (coerceId)
36 import TysWiredIn (true_RDR, false_RDR)
37
38 import Data.Maybe (catMaybes, isJust)
39
40 {-
41 ************************************************************************
42 * *
43 Functor instances
44
45 see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html
46
47 * *
48 ************************************************************************
49
50 For the data type:
51
52 data T a = T1 Int a | T2 (T a)
53
54 We generate the instance:
55
56 instance Functor T where
57 fmap f (T1 b1 a) = T1 b1 (f a)
58 fmap f (T2 ta) = T2 (fmap f ta)
59
60 Notice that we don't simply apply 'fmap' to the constructor arguments.
61 Rather
62 - Do nothing to an argument whose type doesn't mention 'a'
63 - Apply 'f' to an argument of type 'a'
64 - Apply 'fmap f' to other arguments
65 That's why we have to recurse deeply into the constructor argument types,
66 rather than just one level, as we typically do.
67
68 What about types with more than one type parameter? In general, we only
69 derive Functor for the last position:
70
71 data S a b = S1 [b] | S2 (a, T a b)
72 instance Functor (S a) where
73 fmap f (S1 bs) = S1 (fmap f bs)
74 fmap f (S2 (p,q)) = S2 (a, fmap f q)
75
76 However, we have special cases for
77 - tuples
78 - functions
79
80 More formally, we write the derivation of fmap code over type variable
81 'a for type 'b as ($fmap 'a 'b). In this general notation the derived
82 instance for T is:
83
84 instance Functor T where
85 fmap f (T1 x1 x2) = T1 ($(fmap 'a 'b1) x1) ($(fmap 'a 'a) x2)
86 fmap f (T2 x1) = T2 ($(fmap 'a '(T a)) x1)
87
88 $(fmap 'a 'b) = \x -> x -- when b does not contain a
89 $(fmap 'a 'a) = f
90 $(fmap 'a '(b1,b2)) = \x -> case x of (x1,x2) -> ($(fmap 'a 'b1) x1, $(fmap 'a 'b2) x2)
91 $(fmap 'a '(T b1 b2)) = fmap $(fmap 'a 'b2) -- when a only occurs in the last parameter, b2
92 $(fmap 'a '(b -> c)) = \x b -> $(fmap 'a' 'c) (x ($(cofmap 'a 'b) b))
93
94 For functions, the type parameter 'a can occur in a contravariant position,
95 which means we need to derive a function like:
96
97 cofmap :: (a -> b) -> (f b -> f a)
98
99 This is pretty much the same as $fmap, only without the $(cofmap 'a 'a) case:
100
101 $(cofmap 'a 'b) = \x -> x -- when b does not contain a
102 $(cofmap 'a 'a) = error "type variable in contravariant position"
103 $(cofmap 'a '(b1,b2)) = \x -> case x of (x1,x2) -> ($(cofmap 'a 'b1) x1, $(cofmap 'a 'b2) x2)
104 $(cofmap 'a '[b]) = map $(cofmap 'a 'b)
105 $(cofmap 'a '(T b1 b2)) = fmap $(cofmap 'a 'b2) -- when a only occurs in the last parameter, b2
106 $(cofmap 'a '(b -> c)) = \x b -> $(cofmap 'a' 'c) (x ($(fmap 'a 'c) b))
107
108 Note that the code produced by $(fmap _ _) is always a higher order function,
109 with type `(a -> b) -> (g a -> g b)` for some g. When we need to do pattern
110 matching on the type, this means create a lambda function (see the (,) case above).
111 The resulting code for fmap can look a bit weird, for example:
112
113 data X a = X (a,Int)
114 -- generated instance
115 instance Functor X where
116 fmap f (X x) = (\y -> case y of (x1,x2) -> X (f x1, (\z -> z) x2)) x
117
118 The optimizer should be able to simplify this code by simple inlining.
119
120 An older version of the deriving code tried to avoid these applied
121 lambda functions by producing a meta level function. But the function to
122 be mapped, `f`, is a function on the code level, not on the meta level,
123 so it was eta expanded to `\x -> [| f $x |]`. This resulted in too much eta expansion.
124 It is better to produce too many lambdas than to eta expand, see ticket #7436.
125 -}
126
127 gen_Functor_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
128 -- When the argument is phantom, we can use fmap _ = coerce
129 -- See Note [Phantom types with Functor, Foldable, and Traversable]
130 gen_Functor_binds loc tycon
131 | Phantom <- last (tyConRoles tycon)
132 = (unitBag fmap_bind, emptyBag)
133 where
134 fmap_name = L loc fmap_RDR
135 fmap_bind = mkRdrFunBind fmap_name fmap_eqns
136 fmap_eqns = [mkSimpleMatch fmap_match_ctxt
137 [nlWildPat]
138 coerce_Expr]
139 fmap_match_ctxt = mkPrefixFunRhs fmap_name
140
141 gen_Functor_binds loc tycon
142 = (listToBag [fmap_bind, replace_bind], emptyBag)
143 where
144 data_cons = tyConDataCons tycon
145 fmap_name = L loc fmap_RDR
146
147 -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]
148 fmap_bind = mkRdrFunBindEC 2 id fmap_name fmap_eqns
149 fmap_match_ctxt = mkPrefixFunRhs fmap_name
150
151 fmap_eqn con = flip evalState bs_RDRs $
152 match_for_con fmap_match_ctxt [f_Pat] con =<< parts
153 where
154 parts = sequence $ foldDataConArgs ft_fmap con
155
156 fmap_eqns = map fmap_eqn data_cons
157
158 ft_fmap :: FFoldType (State [RdrName] (LHsExpr RdrName))
159 ft_fmap = FT { ft_triv = mkSimpleLam $ \x -> return x
160 -- fmap f = \x -> x
161 , ft_var = return f_Expr
162 -- fmap f = f
163 , ft_fun = \g h -> do
164 gg <- g
165 hh <- h
166 mkSimpleLam2 $ \x b -> return $
167 nlHsApp hh (nlHsApp x (nlHsApp gg b))
168 -- fmap f = \x b -> h (x (g b))
169 , ft_tup = \t gs -> do
170 gg <- sequence gs
171 mkSimpleLam $ mkSimpleTupleCase (match_for_con CaseAlt) t gg
172 -- fmap f = \x -> case x of (a1,a2,..) -> (g1 a1,g2 a2,..)
173 , ft_ty_app = \_ g -> nlHsApp fmap_Expr <$> g
174 -- fmap f = fmap g
175 , ft_forall = \_ g -> g
176 , ft_bad_app = panic "in other argument in ft_fmap"
177 , ft_co_var = panic "contravariant in ft_fmap" }
178
179 -- See Note [Deriving <$]
180 replace_name = L loc replace_RDR
181
182 -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]
183 replace_bind = mkRdrFunBindEC 2 id replace_name replace_eqns
184 replace_match_ctxt = mkPrefixFunRhs replace_name
185
186 replace_eqn con = flip evalState bs_RDRs $
187 match_for_con replace_match_ctxt [z_Pat] con =<< parts
188 where
189 parts = traverse (fmap replace) $ foldDataConArgs ft_replace con
190
191 replace_eqns = map replace_eqn data_cons
192
193 ft_replace :: FFoldType (State [RdrName] Replacer)
194 ft_replace = FT { ft_triv = fmap Nested $ mkSimpleLam $ \x -> return x
195 -- (p <$) = \x -> x
196 , ft_var = fmap Immediate $ mkSimpleLam $ \_ -> return z_Expr
197 -- (p <$) = const p
198 , ft_fun = \g h -> do
199 gg <- replace <$> g
200 hh <- replace <$> h
201 fmap Nested $ mkSimpleLam2 $ \x b -> return $
202 nlHsApp hh (nlHsApp x (nlHsApp gg b))
203 -- (<$) p = \x b -> h (x (g b))
204 , ft_tup = \t gs -> do
205 gg <- traverse (fmap replace) gs
206 fmap Nested . mkSimpleLam $
207 mkSimpleTupleCase (match_for_con CaseAlt) t gg
208 -- (p <$) = \x -> case x of (a1,a2,..) -> (g1 a1,g2 a2,..)
209 , ft_ty_app = \_ gm -> do
210 g <- gm
211 case g of
212 Nested g' -> pure . Nested $
213 nlHsApp fmap_Expr $ g'
214 Immediate _ -> pure . Nested $
215 nlHsApp replace_Expr z_Expr
216 -- (p <$) = fmap (p <$)
217 , ft_forall = \_ g -> g
218 , ft_bad_app = panic "in other argument in ft_replace"
219 , ft_co_var = panic "contravariant in ft_replace" }
220
221 -- Con a1 a2 ... -> Con (f1 a1) (f2 a2) ...
222 match_for_con :: HsMatchContext RdrName
223 -> [LPat RdrName] -> DataCon -> [LHsExpr RdrName]
224 -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
225 match_for_con ctxt = mkSimpleConMatch ctxt $
226 \con_name xs -> return $ nlHsApps con_name xs -- Con x1 x2 ..
227
228 -- See Note [Deriving <$]
229 data Replacer = Immediate {replace :: LHsExpr RdrName}
230 | Nested {replace :: LHsExpr RdrName}
231
232 {- Note [Deriving <$]
233 ~~~~~~~~~~~~~~~~~~
234
235 We derive the definition of <$. Allowing this to take the default definition
236 can lead to memory leaks: mapping over a structure with a constant function can
237 fill the result structure with trivial thunks that retain the values from the
238 original structure. The simplifier seems to handle this all right for simple
239 types, but not for recursive ones. Consider
240
241 data Tree a = Bin !(Tree a) a !(Tree a) | Tip deriving Functor
242
243 -- fmap _ Tip = Tip
244 -- fmap f (Bin l v r) = Bin (fmap f l) (f v) (fmap f r)
245
246 Using the default definition of <$, we get (<$) x = fmap (\_ -> x) and that
247 simplifies no further. Why is that? `fmap` is defined recursively, so GHC
248 cannot inline it. The static argument transformation would turn the definition
249 into a non-recursive one
250
251 -- fmap f = go where
252 -- go Tip = Tip
253 -- go (Bin l v r) = Bin (go l) (f v) (go r)
254
255 which GHC could inline, producing an efficient definion of `<$`. But there are
256 several problems. First, GHC does not perform the static argument transformation
257 by default, even with -O2. Second, even when it does perform the static argument
258 transformation, it does so only when there are at least two static arguments,
259 which is not the case for fmap. Finally, when the type in question is
260 non-regular, such as
261
262 data Nesty a = Z a | S (Nesty a) (Nest (a, a))
263
264 the function argument is no longer (entirely) static, so the static argument
265 transformation will do nothing for us.
266
267 Applying the default definition of `<$` will produce a tree full of thunks that
268 look like ((\_ -> x) x0), which represents unnecessary thunk allocation and
269 also retention of the previous value, potentially leaking memory. Instead, we
270 derive <$ separately. Two aspects are different from fmap: the case of the
271 sought type variable (ft_var) and the case of a type application (ft_ty_app).
272 The interesting one is ft_ty_app. We have to distinguish two cases: the
273 "immediate" case where the type argument *is* the sought type variable, and
274 the "nested" case where the type argument *contains* the sought type variable.
275
276 The immediate case:
277
278 Suppose we have
279
280 data Imm a = Imm (F ... a)
281
282 Then we want to define
283
284 x <$ Imm q = Imm (x <$ q)
285
286 The nested case:
287
288 Suppose we have
289
290 data Nes a = Nes (F ... (G a))
291
292 Then we want to define
293
294 x <$ Nes q = Nes (fmap (x <$) q)
295
296 We use the Replacer type to tag whether the expression derived for applying
297 <$ to the last type variable was the ft_var case (immediate) or one of the
298 others (letting ft_forall pass through as usual).
299
300 We could, but do not, give tuples special treatment to improve efficiency
301 in some cases. Suppose we have
302
303 data Nest a = Z a | S (Nest (a,a))
304
305 The optimal definition would be
306
307 x <$ Z _ = Z x
308 x <$ S t = S ((x, x) <$ t)
309
310 which produces a result with maximal internal sharing. The reason we do not
311 attempt to treat this case specially is that we have no way to give
312 user-provided tuple-like types similar treatment. If the user changed the
313 definition to
314
315 data Pair a = Pair a a
316 data Nest a = Z a | S (Nest (Pair a))
317
318 they would experience a surprising degradation in performance. -}
319
320
321 {-
322 Utility functions related to Functor deriving.
323
324 Since several things use the same pattern of traversal, this is abstracted into functorLikeTraverse.
325 This function works like a fold: it makes a value of type 'a' in a bottom up way.
326 -}
327
328 -- Generic traversal for Functor deriving
329 -- See Note [FFoldType and functorLikeTraverse]
330 data FFoldType a -- Describes how to fold over a Type in a functor like way
331 = FT { ft_triv :: a
332 -- ^ Does not contain variable
333 , ft_var :: a
334 -- ^ The variable itself
335 , ft_co_var :: a
336 -- ^ The variable itself, contravariantly
337 , ft_fun :: a -> a -> a
338 -- ^ Function type
339 , ft_tup :: TyCon -> [a] -> a
340 -- ^ Tuple type
341 , ft_ty_app :: Type -> a -> a
342 -- ^ Type app, variable only in last argument
343 , ft_bad_app :: a
344 -- ^ Type app, variable other than in last argument
345 , ft_forall :: TcTyVar -> a -> a
346 -- ^ Forall type
347 }
348
349 functorLikeTraverse :: forall a.
350 TyVar -- ^ Variable to look for
351 -> FFoldType a -- ^ How to fold
352 -> Type -- ^ Type to process
353 -> a
354 functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar
355 , ft_co_var = caseCoVar, ft_fun = caseFun
356 , ft_tup = caseTuple, ft_ty_app = caseTyApp
357 , ft_bad_app = caseWrongArg, ft_forall = caseForAll })
358 ty
359 = fst (go False ty)
360 where
361 go :: Bool -- Covariant or contravariant context
362 -> Type
363 -> (a, Bool) -- (result of type a, does type contain var)
364
365 go co ty | Just ty' <- tcView ty = go co ty'
366 go co (TyVarTy v) | v == var = (if co then caseCoVar else caseVar,True)
367 go co (FunTy x y) | isPredTy x = go co y
368 | xc || yc = (caseFun xr yr,True)
369 where (xr,xc) = go (not co) x
370 (yr,yc) = go co y
371 go co (AppTy x y) | xc = (caseWrongArg, True)
372 | yc = (caseTyApp x yr, True)
373 where (_, xc) = go co x
374 (yr,yc) = go co y
375 go co ty@(TyConApp con args)
376 | not (or xcs) = (caseTrivial, False) -- Variable does not occur
377 -- At this point we know that xrs, xcs is not empty,
378 -- and at least one xr is True
379 | isTupleTyCon con = (caseTuple con xrs, True)
380 | or (init xcs) = (caseWrongArg, True) -- T (..var..) ty
381 | Just (fun_ty, _) <- splitAppTy_maybe ty -- T (..no var..) ty
382 = (caseTyApp fun_ty (last xrs), True)
383 | otherwise = (caseWrongArg, True) -- Non-decomposable (eg type function)
384 where
385 -- When folding over an unboxed tuple, we must explicitly drop the
386 -- runtime rep arguments, or else GHC will generate twice as many
387 -- variables in a unboxed tuple pattern match and expression as it
388 -- actually needs. See Trac #12399
389 (xrs,xcs) = unzip (map (go co) (dropRuntimeRepArgs args))
390 go co (ForAllTy (TvBndr v vis) x)
391 | isVisibleArgFlag vis = panic "unexpected visible binder"
392 | v /= var && xc = (caseForAll v xr,True)
393 where (xr,xc) = go co x
394
395 go _ _ = (caseTrivial,False)
396
397 -- Return all syntactic subterms of ty that contain var somewhere
398 -- These are the things that should appear in instance constraints
399 deepSubtypesContaining :: TyVar -> Type -> [TcType]
400 deepSubtypesContaining tv
401 = functorLikeTraverse tv
402 (FT { ft_triv = []
403 , ft_var = []
404 , ft_fun = (++)
405 , ft_tup = \_ xs -> concat xs
406 , ft_ty_app = (:)
407 , ft_bad_app = panic "in other argument in deepSubtypesContaining"
408 , ft_co_var = panic "contravariant in deepSubtypesContaining"
409 , ft_forall = \v xs -> filterOut ((v `elemVarSet`) . tyCoVarsOfType) xs })
410
411
412 foldDataConArgs :: FFoldType a -> DataCon -> [a]
413 -- Fold over the arguments of the datacon
414 foldDataConArgs ft con
415 = map foldArg (dataConOrigArgTys con)
416 where
417 foldArg
418 = case getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con))) of
419 Just tv -> functorLikeTraverse tv ft
420 Nothing -> const (ft_triv ft)
421 -- If we are deriving Foldable for a GADT, there is a chance that the last
422 -- type variable in the data type isn't actually a type variable at all.
423 -- (for example, this can happen if the last type variable is refined to
424 -- be a concrete type such as Int). If the last type variable is refined
425 -- to be a specific type, then getTyVar_maybe will return Nothing.
426 -- See Note [DeriveFoldable with ExistentialQuantification]
427 --
428 -- The kind checks have ensured the last type parameter is of kind *.
429
430 -- Make a HsLam using a fresh variable from a State monad
431 mkSimpleLam :: (LHsExpr RdrName -> State [RdrName] (LHsExpr RdrName))
432 -> State [RdrName] (LHsExpr RdrName)
433 -- (mkSimpleLam fn) returns (\x. fn(x))
434 mkSimpleLam lam = do
435 (n:names) <- get
436 put names
437 body <- lam (nlHsVar n)
438 return (mkHsLam [nlVarPat n] body)
439
440 mkSimpleLam2 :: (LHsExpr RdrName -> LHsExpr RdrName
441 -> State [RdrName] (LHsExpr RdrName))
442 -> State [RdrName] (LHsExpr RdrName)
443 mkSimpleLam2 lam = do
444 (n1:n2:names) <- get
445 put names
446 body <- lam (nlHsVar n1) (nlHsVar n2)
447 return (mkHsLam [nlVarPat n1,nlVarPat n2] body)
448
449 -- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]"
450 --
451 -- @mkSimpleConMatch fold extra_pats con insides@ produces a match clause in
452 -- which the LHS pattern-matches on @extra_pats@, followed by a match on the
453 -- constructor @con@ and its arguments. The RHS folds (with @fold@) over @con@
454 -- and its arguments, applying an expression (from @insides@) to each of the
455 -- respective arguments of @con@.
456 mkSimpleConMatch :: Monad m => HsMatchContext RdrName
457 -> (RdrName -> [LHsExpr RdrName] -> m (LHsExpr RdrName))
458 -> [LPat RdrName]
459 -> DataCon
460 -> [LHsExpr RdrName]
461 -> m (LMatch RdrName (LHsExpr RdrName))
462 mkSimpleConMatch ctxt fold extra_pats con insides = do
463 let con_name = getRdrName con
464 let vars_needed = takeList insides as_RDRs
465 let bare_pat = nlConVarPat con_name vars_needed
466 let pat = if null vars_needed
467 then bare_pat
468 else nlParPat bare_pat
469 rhs <- fold con_name
470 (zipWith (\i v -> i `nlHsApp` nlHsVar v) insides vars_needed)
471 return $ mkMatch ctxt (extra_pats ++ [pat]) rhs
472 (noLoc emptyLocalBinds)
473
474 -- "Con a1 a2 a3 -> fmap (\b2 -> Con a1 b2 a3) (traverse f a2)"
475 --
476 -- @mkSimpleConMatch2 fold extra_pats con insides@ behaves very similarly to
477 -- 'mkSimpleConMatch', with two key differences:
478 --
479 -- 1. @insides@ is a @[Maybe (LHsExpr RdrName)]@ instead of a
480 -- @[LHsExpr RdrName]@. This is because it filters out the expressions
481 -- corresponding to arguments whose types do not mention the last type
482 -- variable in a derived 'Foldable' or 'Traversable' instance (i.e., the
483 -- 'Nothing' elements of @insides@).
484 --
485 -- 2. @fold@ takes an expression as its first argument instead of a
486 -- constructor name. This is because it uses a specialized
487 -- constructor function expression that only takes as many parameters as
488 -- there are argument types that mention the last type variable.
489 --
490 -- See Note [Generated code for DeriveFoldable and DeriveTraversable]
491 mkSimpleConMatch2 :: Monad m
492 => HsMatchContext RdrName
493 -> (LHsExpr RdrName -> [LHsExpr RdrName]
494 -> m (LHsExpr RdrName))
495 -> [LPat RdrName]
496 -> DataCon
497 -> [Maybe (LHsExpr RdrName)]
498 -> m (LMatch RdrName (LHsExpr RdrName))
499 mkSimpleConMatch2 ctxt fold extra_pats con insides = do
500 let con_name = getRdrName con
501 vars_needed = takeList insides as_RDRs
502 pat = nlConVarPat con_name vars_needed
503 -- Make sure to zip BEFORE invoking catMaybes. We want the variable
504 -- indicies in each expression to match up with the argument indices
505 -- in con_expr (defined below).
506 exps = catMaybes $ zipWith (\i v -> (`nlHsApp` nlHsVar v) <$> i)
507 insides vars_needed
508 -- An element of argTysTyVarInfo is True if the constructor argument
509 -- with the same index has a type which mentions the last type
510 -- variable.
511 argTysTyVarInfo = map isJust insides
512 (asWithTyVar, asWithoutTyVar) = partitionByList argTysTyVarInfo as_Vars
513
514 con_expr
515 | null asWithTyVar = nlHsApps con_name asWithoutTyVar
516 | otherwise =
517 let bs = filterByList argTysTyVarInfo bs_RDRs
518 vars = filterByLists argTysTyVarInfo bs_Vars as_Vars
519 in mkHsLam (map nlVarPat bs) (nlHsApps con_name vars)
520
521 rhs <- fold con_expr exps
522 return $ mkMatch ctxt (extra_pats ++ [pat]) rhs
523 (noLoc emptyLocalBinds)
524
525 -- "case x of (a1,a2,a3) -> fold [x1 a1, x2 a2, x3 a3]"
526 mkSimpleTupleCase :: Monad m => ([LPat RdrName] -> DataCon -> [a]
527 -> m (LMatch RdrName (LHsExpr RdrName)))
528 -> TyCon -> [a] -> LHsExpr RdrName -> m (LHsExpr RdrName)
529 mkSimpleTupleCase match_for_con tc insides x
530 = do { let data_con = tyConSingleDataCon tc
531 ; match <- match_for_con [] data_con insides
532 ; return $ nlHsCase x [match] }
533
534 {-
535 ************************************************************************
536 * *
537 Foldable instances
538
539 see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html
540
541 * *
542 ************************************************************************
543
544 Deriving Foldable instances works the same way as Functor instances,
545 only Foldable instances are not possible for function types at all.
546 Given (data T a = T a a (T a) deriving Foldable), we get:
547
548 instance Foldable T where
549 foldr f z (T x1 x2 x3) =
550 $(foldr 'a 'a) x1 ( $(foldr 'a 'a) x2 ( $(foldr 'a '(T a)) x3 z ) )
551
552 -XDeriveFoldable is different from -XDeriveFunctor in that it filters out
553 arguments to the constructor that would produce useless code in a Foldable
554 instance. For example, the following datatype:
555
556 data Foo a = Foo Int a Int deriving Foldable
557
558 would have the following generated Foldable instance:
559
560 instance Foldable Foo where
561 foldr f z (Foo x1 x2 x3) = $(foldr 'a 'a) x2
562
563 since neither of the two Int arguments are folded over.
564
565 The cases are:
566
567 $(foldr 'a 'a) = f
568 $(foldr 'a '(b1,b2)) = \x z -> case x of (x1,x2) -> $(foldr 'a 'b1) x1 ( $(foldr 'a 'b2) x2 z )
569 $(foldr 'a '(T b1 b2)) = \x z -> foldr $(foldr 'a 'b2) z x -- when a only occurs in the last parameter, b2
570
571 Note that the arguments to the real foldr function are the wrong way around,
572 since (f :: a -> b -> b), while (foldr f :: b -> t a -> b).
573
574 One can envision a case for types that don't contain the last type variable:
575
576 $(foldr 'a 'b) = \x z -> z -- when b does not contain a
577
578 But this case will never materialize, since the aforementioned filtering
579 removes all such types from consideration.
580 See Note [Generated code for DeriveFoldable and DeriveTraversable].
581
582 Foldable instances differ from Functor and Traversable instances in that
583 Foldable instances can be derived for data types in which the last type
584 variable is existentially quantified. In particular, if the last type variable
585 is refined to a more specific type in a GADT:
586
587 data GADT a where
588 G :: a ~ Int => a -> G Int
589
590 then the deriving machinery does not attempt to check that the type a contains
591 Int, since it is not syntactically equal to a type variable. That is, the
592 derived Foldable instance for GADT is:
593
594 instance Foldable GADT where
595 foldr _ z (GADT _) = z
596
597 See Note [DeriveFoldable with ExistentialQuantification].
598
599 Note [Deriving null]
600 ~~~~~~~~~~~~~~~~~~~~
601
602 In some cases, deriving the definition of 'null' can produce much better
603 results than the default definition. For example, with
604
605 data SnocList a = Nil | Snoc (SnocList a) a
606
607 the default definition of 'null' would walk the entire spine of a
608 nonempty snoc-list before concluding that it is not null. But looking at
609 the Snoc constructor, we can immediately see that it contains an 'a', and
610 so 'null' can return False immediately if it matches on Snoc. When we
611 derive 'null', we keep track of things that cannot be null. The interesting
612 case is type application. Given
613
614 data Wrap a = Wrap (Foo (Bar a))
615
616 we use
617
618 null (Wrap fba) = all null fba
619
620 but if we see
621
622 data Wrap a = Wrap (Foo a)
623
624 we can just use
625
626 null (Wrap fa) = null fa
627
628 Indeed, we allow this to happen even for tuples:
629
630 data Wrap a = Wrap (Foo (a, Int))
631
632 produces
633
634 null (Wrap fa) = null fa
635
636 As explained in Note [Deriving <$], giving tuples special performance treatment
637 could surprise users if they switch to other types, but Ryan Scott seems to
638 think it's okay to do it for now.
639 -}
640
641 gen_Foldable_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
642 -- When the parameter is phantom, we can use foldMap _ _ = mempty
643 -- See Note [Phantom types with Functor, Foldable, and Traversable]
644 gen_Foldable_binds loc tycon
645 | Phantom <- last (tyConRoles tycon)
646 = (unitBag foldMap_bind, emptyBag)
647 where
648 foldMap_name = L loc foldMap_RDR
649 foldMap_bind = mkRdrFunBind foldMap_name foldMap_eqns
650 foldMap_eqns = [mkSimpleMatch foldMap_match_ctxt
651 [nlWildPat, nlWildPat]
652 mempty_Expr]
653 foldMap_match_ctxt = mkPrefixFunRhs foldMap_name
654
655 gen_Foldable_binds loc tycon
656 | null data_cons -- There's no real point producing anything but
657 -- foldMap for a type with no constructors.
658 = (unitBag foldMap_bind, emptyBag)
659
660 | otherwise
661 = (listToBag [foldr_bind, foldMap_bind, null_bind], emptyBag)
662 where
663 data_cons = tyConDataCons tycon
664
665 foldr_bind = mkRdrFunBind (L loc foldable_foldr_RDR) eqns
666 eqns = map foldr_eqn data_cons
667 foldr_eqn con
668 = evalState (match_foldr z_Expr [f_Pat,z_Pat] con =<< parts) bs_RDRs
669 where
670 parts = sequence $ foldDataConArgs ft_foldr con
671
672 foldMap_name = L loc foldMap_RDR
673
674 -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]
675 foldMap_bind = mkRdrFunBindEC 2 (const mempty_Expr)
676 foldMap_name foldMap_eqns
677
678 foldMap_eqns = map foldMap_eqn data_cons
679
680 foldMap_eqn con
681 = evalState (match_foldMap [f_Pat] con =<< parts) bs_RDRs
682 where
683 parts = sequence $ foldDataConArgs ft_foldMap con
684
685 -- Given a list of NullM results, produce Nothing if any of
686 -- them is NotNull, and otherwise produce a list of Maybes
687 -- with Justs representing unknowns and Nothings representing
688 -- things that are definitely null.
689 convert :: [NullM a] -> Maybe [Maybe a]
690 convert = traverse go where
691 go IsNull = Just Nothing
692 go NotNull = Nothing
693 go (NullM a) = Just (Just a)
694
695 null_name = L loc null_RDR
696 null_match_ctxt = mkPrefixFunRhs null_name
697 null_bind = mkRdrFunBind null_name null_eqns
698 null_eqns = map null_eqn data_cons
699 null_eqn con
700 = flip evalState bs_RDRs $ do
701 parts <- sequence $ foldDataConArgs ft_null con
702 case convert parts of
703 Nothing -> return $
704 mkMatch null_match_ctxt [nlParPat (nlWildConPat con)]
705 false_Expr (noLoc emptyLocalBinds)
706 Just cp -> match_null [] con cp
707
708 -- Yields 'Just' an expression if we're folding over a type that mentions
709 -- the last type parameter of the datatype. Otherwise, yields 'Nothing'.
710 -- See Note [FFoldType and functorLikeTraverse]
711 ft_foldr :: FFoldType (State [RdrName] (Maybe (LHsExpr RdrName)))
712 ft_foldr
713 = FT { ft_triv = return Nothing
714 -- foldr f = \x z -> z
715 , ft_var = return $ Just f_Expr
716 -- foldr f = f
717 , ft_tup = \t g -> do
718 gg <- sequence g
719 lam <- mkSimpleLam2 $ \x z ->
720 mkSimpleTupleCase (match_foldr z) t gg x
721 return (Just lam)
722 -- foldr f = (\x z -> case x of ...)
723 , ft_ty_app = \_ g -> do
724 gg <- g
725 mapM (\gg' -> mkSimpleLam2 $ \x z -> return $
726 nlHsApps foldable_foldr_RDR [gg',z,x]) gg
727 -- foldr f = (\x z -> foldr g z x)
728 , ft_forall = \_ g -> g
729 , ft_co_var = panic "contravariant in ft_foldr"
730 , ft_fun = panic "function in ft_foldr"
731 , ft_bad_app = panic "in other argument in ft_foldr" }
732
733 match_foldr :: LHsExpr RdrName
734 -> [LPat RdrName]
735 -> DataCon
736 -> [Maybe (LHsExpr RdrName)]
737 -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
738 match_foldr z = mkSimpleConMatch2 LambdaExpr $ \_ xs -> return (mkFoldr xs)
739 where
740 -- g1 v1 (g2 v2 (.. z))
741 mkFoldr :: [LHsExpr RdrName] -> LHsExpr RdrName
742 mkFoldr = foldr nlHsApp z
743
744 -- See Note [FFoldType and functorLikeTraverse]
745 ft_foldMap :: FFoldType (State [RdrName] (Maybe (LHsExpr RdrName)))
746 ft_foldMap
747 = FT { ft_triv = return Nothing
748 -- foldMap f = \x -> mempty
749 , ft_var = return (Just f_Expr)
750 -- foldMap f = f
751 , ft_tup = \t g -> do
752 gg <- sequence g
753 lam <- mkSimpleLam $ mkSimpleTupleCase match_foldMap t gg
754 return (Just lam)
755 -- foldMap f = \x -> case x of (..,)
756 , ft_ty_app = \_ g -> fmap (nlHsApp foldMap_Expr) <$> g
757 -- foldMap f = foldMap g
758 , ft_forall = \_ g -> g
759 , ft_co_var = panic "contravariant in ft_foldMap"
760 , ft_fun = panic "function in ft_foldMap"
761 , ft_bad_app = panic "in other argument in ft_foldMap" }
762
763 match_foldMap :: [LPat RdrName]
764 -> DataCon
765 -> [Maybe (LHsExpr RdrName)]
766 -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
767 match_foldMap = mkSimpleConMatch2 CaseAlt $ \_ xs -> return (mkFoldMap xs)
768 where
769 -- mappend v1 (mappend v2 ..)
770 mkFoldMap :: [LHsExpr RdrName] -> LHsExpr RdrName
771 mkFoldMap [] = mempty_Expr
772 mkFoldMap xs = foldr1 (\x y -> nlHsApps mappend_RDR [x,y]) xs
773
774 -- See Note [FFoldType and functorLikeTraverse]
775 -- Yields NullM an expression if we're folding over an expression
776 -- that may or may not be null. Yields IsNull if it's certainly
777 -- null, and yields NotNull if it's certainly not null.
778 -- See Note [Deriving null]
779 ft_null :: FFoldType (State [RdrName] (NullM (LHsExpr RdrName)))
780 ft_null
781 = FT { ft_triv = return IsNull
782 -- null = \_ -> True
783 , ft_var = return NotNull
784 -- null = \_ -> False
785 , ft_tup = \t g -> do
786 gg <- sequence g
787 case convert gg of
788 Nothing -> pure NotNull
789 Just ggg ->
790 NullM <$> (mkSimpleLam $ mkSimpleTupleCase match_null t ggg)
791 -- null = \x -> case x of (..,)
792 , ft_ty_app = \_ g -> flip fmap g $ \nestedResult ->
793 case nestedResult of
794 -- If e definitely contains the parameter,
795 -- then we can test if (G e) contains it by
796 -- simply checking if (G e) is null
797 NotNull -> NullM null_Expr
798 -- This case is unreachable--it will actually be
799 -- caught by ft_triv
800 IsNull -> IsNull
801 -- The general case uses (all null),
802 -- (all (all null)), etc.
803 NullM nestedTest -> NullM $
804 nlHsApp all_Expr nestedTest
805 -- null fa = null fa, or null fa = all null fa, or null fa = True
806 , ft_forall = \_ g -> g
807 , ft_co_var = panic "contravariant in ft_null"
808 , ft_fun = panic "function in ft_null"
809 , ft_bad_app = panic "in other argument in ft_null" }
810
811 match_null :: [LPat RdrName]
812 -> DataCon
813 -> [Maybe (LHsExpr RdrName)]
814 -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
815 match_null = mkSimpleConMatch2 CaseAlt $ \_ xs -> return (mkNull xs)
816 where
817 -- v1 && v2 && ..
818 mkNull :: [LHsExpr RdrName] -> LHsExpr RdrName
819 mkNull [] = true_Expr
820 mkNull xs = foldr1 (\x y -> nlHsApps and_RDR [x,y]) xs
821
822 data NullM a =
823 IsNull -- Definitely null
824 | NotNull -- Definitely not null
825 | NullM a -- Unknown
826
827 {-
828 ************************************************************************
829 * *
830 Traversable instances
831
832 see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html
833 * *
834 ************************************************************************
835
836 Again, Traversable is much like Functor and Foldable.
837
838 The cases are:
839
840 $(traverse 'a 'a) = f
841 $(traverse 'a '(b1,b2)) = \x -> case x of (x1,x2) ->
842 liftA2 (,) ($(traverse 'a 'b1) x1) ($(traverse 'a 'b2) x2)
843 $(traverse 'a '(T b1 b2)) = traverse $(traverse 'a 'b2) -- when a only occurs in the last parameter, b2
844
845 Like -XDeriveFoldable, -XDeriveTraversable filters out arguments whose types
846 do not mention the last type parameter. Therefore, the following datatype:
847
848 data Foo a = Foo Int a Int
849
850 would have the following derived Traversable instance:
851
852 instance Traversable Foo where
853 traverse f (Foo x1 x2 x3) =
854 fmap (\b2 -> Foo x1 b2 x3) ( $(traverse 'a 'a) x2 )
855
856 since the two Int arguments do not produce any effects in a traversal.
857
858 One can envision a case for types that do not mention the last type parameter:
859
860 $(traverse 'a 'b) = pure -- when b does not contain a
861
862 But this case will never materialize, since the aforementioned filtering
863 removes all such types from consideration.
864 See Note [Generated code for DeriveFoldable and DeriveTraversable].
865 -}
866
867 gen_Traversable_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
868 -- When the argument is phantom, we can use traverse = pure . coerce
869 -- See Note [Phantom types with Functor, Foldable, and Traversable]
870 gen_Traversable_binds loc tycon
871 | Phantom <- last (tyConRoles tycon)
872 = (unitBag traverse_bind, emptyBag)
873 where
874 traverse_name = L loc traverse_RDR
875 traverse_bind = mkRdrFunBind traverse_name traverse_eqns
876 traverse_eqns =
877 [mkSimpleMatch traverse_match_ctxt
878 [nlWildPat, z_Pat]
879 (nlHsApps pure_RDR [nlHsApp coerce_Expr z_Expr])]
880 traverse_match_ctxt = mkPrefixFunRhs traverse_name
881
882 gen_Traversable_binds loc tycon
883 = (unitBag traverse_bind, emptyBag)
884 where
885 data_cons = tyConDataCons tycon
886
887 traverse_name = L loc traverse_RDR
888
889 -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]
890 traverse_bind = mkRdrFunBindEC 2 (nlHsApp pure_Expr)
891 traverse_name traverse_eqns
892 traverse_eqns = map traverse_eqn data_cons
893 traverse_eqn con
894 = evalState (match_for_con [f_Pat] con =<< parts) bs_RDRs
895 where
896 parts = sequence $ foldDataConArgs ft_trav con
897
898 -- Yields 'Just' an expression if we're folding over a type that mentions
899 -- the last type parameter of the datatype. Otherwise, yields 'Nothing'.
900 -- See Note [FFoldType and functorLikeTraverse]
901 ft_trav :: FFoldType (State [RdrName] (Maybe (LHsExpr RdrName)))
902 ft_trav
903 = FT { ft_triv = return Nothing
904 -- traverse f = pure x
905 , ft_var = return (Just f_Expr)
906 -- traverse f = f x
907 , ft_tup = \t gs -> do
908 gg <- sequence gs
909 lam <- mkSimpleLam $ mkSimpleTupleCase match_for_con t gg
910 return (Just lam)
911 -- traverse f = \x -> case x of (a1,a2,..) ->
912 -- liftA2 (,,) (g1 a1) (g2 a2) <*> ..
913 , ft_ty_app = \_ g -> fmap (nlHsApp traverse_Expr) <$> g
914 -- traverse f = traverse g
915 , ft_forall = \_ g -> g
916 , ft_co_var = panic "contravariant in ft_trav"
917 , ft_fun = panic "function in ft_trav"
918 , ft_bad_app = panic "in other argument in ft_trav" }
919
920 -- Con a1 a2 ... -> liftA2 (\b1 b2 ... -> Con b1 b2 ...) (g1 a1)
921 -- (g2 a2) <*> ...
922 match_for_con :: [LPat RdrName]
923 -> DataCon
924 -> [Maybe (LHsExpr RdrName)]
925 -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
926 match_for_con = mkSimpleConMatch2 CaseAlt $
927 \con xs -> return (mkApCon con xs)
928 where
929 -- liftA2 (\b1 b2 ... -> Con b1 b2 ...) x1 x2 <*> ..
930 mkApCon :: LHsExpr RdrName -> [LHsExpr RdrName] -> LHsExpr RdrName
931 mkApCon con [] = nlHsApps pure_RDR [con]
932 mkApCon con [x] = nlHsApps fmap_RDR [con,x]
933 mkApCon con (x1:x2:xs) =
934 foldl appAp (nlHsApps liftA2_RDR [con,x1,x2]) xs
935 where appAp x y = nlHsApps ap_RDR [x,y]
936
937 -----------------------------------------------------------------------
938
939 f_Expr, z_Expr, fmap_Expr, replace_Expr, mempty_Expr, foldMap_Expr,
940 traverse_Expr, coerce_Expr, pure_Expr, true_Expr, false_Expr,
941 all_Expr, null_Expr :: LHsExpr RdrName
942 f_Expr = nlHsVar f_RDR
943 z_Expr = nlHsVar z_RDR
944 fmap_Expr = nlHsVar fmap_RDR
945 replace_Expr = nlHsVar replace_RDR
946 mempty_Expr = nlHsVar mempty_RDR
947 foldMap_Expr = nlHsVar foldMap_RDR
948 traverse_Expr = nlHsVar traverse_RDR
949 coerce_Expr = nlHsVar (getRdrName coerceId)
950 pure_Expr = nlHsVar pure_RDR
951 true_Expr = nlHsVar true_RDR
952 false_Expr = nlHsVar false_RDR
953 all_Expr = nlHsVar all_RDR
954 null_Expr = nlHsVar null_RDR
955
956 f_RDR, z_RDR :: RdrName
957 f_RDR = mkVarUnqual (fsLit "f")
958 z_RDR = mkVarUnqual (fsLit "z")
959
960 as_RDRs, bs_RDRs :: [RdrName]
961 as_RDRs = [ mkVarUnqual (mkFastString ("a"++show i)) | i <- [(1::Int) .. ] ]
962 bs_RDRs = [ mkVarUnqual (mkFastString ("b"++show i)) | i <- [(1::Int) .. ] ]
963
964 as_Vars, bs_Vars :: [LHsExpr RdrName]
965 as_Vars = map nlHsVar as_RDRs
966 bs_Vars = map nlHsVar bs_RDRs
967
968 f_Pat, z_Pat :: LPat RdrName
969 f_Pat = nlVarPat f_RDR
970 z_Pat = nlVarPat z_RDR
971
972 {-
973 Note [DeriveFoldable with ExistentialQuantification]
974 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
975 Functor and Traversable instances can only be derived for data types whose
976 last type parameter is truly universally polymorphic. For example:
977
978 data T a b where
979 T1 :: b -> T a b -- YES, b is unconstrained
980 T2 :: Ord b => b -> T a b -- NO, b is constrained by (Ord b)
981 T3 :: b ~ Int => b -> T a b -- NO, b is constrained by (b ~ Int)
982 T4 :: Int -> T a Int -- NO, this is just like T3
983 T5 :: Ord a => a -> b -> T a b -- YES, b is unconstrained, even
984 -- though a is existential
985 T6 :: Int -> T Int b -- YES, b is unconstrained
986
987 For Foldable instances, however, we can completely lift the constraint that
988 the last type parameter be truly universally polymorphic. This means that T
989 (as defined above) can have a derived Foldable instance:
990
991 instance Foldable (T a) where
992 foldr f z (T1 b) = f b z
993 foldr f z (T2 b) = f b z
994 foldr f z (T3 b) = f b z
995 foldr f z (T4 b) = z
996 foldr f z (T5 a b) = f b z
997 foldr f z (T6 a) = z
998
999 foldMap f (T1 b) = f b
1000 foldMap f (T2 b) = f b
1001 foldMap f (T3 b) = f b
1002 foldMap f (T4 b) = mempty
1003 foldMap f (T5 a b) = f b
1004 foldMap f (T6 a) = mempty
1005
1006 In a Foldable instance, it is safe to fold over an occurrence of the last type
1007 parameter that is not truly universally polymorphic. However, there is a bit
1008 of subtlety in determining what is actually an occurrence of a type parameter.
1009 T3 and T4, as defined above, provide one example:
1010
1011 data T a b where
1012 ...
1013 T3 :: b ~ Int => b -> T a b
1014 T4 :: Int -> T a Int
1015 ...
1016
1017 instance Foldable (T a) where
1018 ...
1019 foldr f z (T3 b) = f b z
1020 foldr f z (T4 b) = z
1021 ...
1022 foldMap f (T3 b) = f b
1023 foldMap f (T4 b) = mempty
1024 ...
1025
1026 Notice that the argument of T3 is folded over, whereas the argument of T4 is
1027 not. This is because we only fold over constructor arguments that
1028 syntactically mention the universally quantified type parameter of that
1029 particular data constructor. See foldDataConArgs for how this is implemented.
1030
1031 As another example, consider the following data type. The argument of each
1032 constructor has the same type as the last type parameter:
1033
1034 data E a where
1035 E1 :: (a ~ Int) => a -> E a
1036 E2 :: Int -> E Int
1037 E3 :: (a ~ Int) => a -> E Int
1038 E4 :: (a ~ Int) => Int -> E a
1039
1040 Only E1's argument is an occurrence of a universally quantified type variable
1041 that is syntactically equivalent to the last type parameter, so only E1's
1042 argument will be folded over in a derived Foldable instance.
1043
1044 See Trac #10447 for the original discussion on this feature. Also see
1045 https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFunctor
1046 for a more in-depth explanation.
1047
1048 Note [FFoldType and functorLikeTraverse]
1049 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1050 Deriving Functor, Foldable, and Traversable all require generating expressions
1051 which perform an operation on each argument of a data constructor depending
1052 on the argument's type. In particular, a generated operation can be different
1053 depending on whether the type mentions the last type variable of the datatype
1054 (e.g., if you have data T a = MkT a Int, then a generated foldr expression would
1055 fold over the first argument of MkT, but not the second).
1056
1057 This pattern is abstracted with the FFoldType datatype, which provides hooks
1058 for the user to specify how a constructor argument should be folded when it
1059 has a type with a particular "shape". The shapes are as follows (assume that
1060 a is the last type variable in a given datatype):
1061
1062 * ft_triv: The type does not mention the last type variable at all.
1063 Examples: Int, b
1064
1065 * ft_var: The type is syntactically equal to the last type variable.
1066 Moreover, the type appears in a covariant position (see
1067 the Deriving Functor instances section of the user's guide
1068 for an in-depth explanation of covariance vs. contravariance).
1069 Example: a (covariantly)
1070
1071 * ft_co_var: The type is syntactically equal to the last type variable.
1072 Moreover, the type appears in a contravariant position.
1073 Example: a (contravariantly)
1074
1075 * ft_fun: A function type which mentions the last type variable in
1076 the argument position, result position or both.
1077 Examples: a -> Int, Int -> a, Maybe a -> [a]
1078
1079 * ft_tup: A tuple type which mentions the last type variable in at least
1080 one of its fields. The TyCon argument of ft_tup represents the
1081 particular tuple's type constructor.
1082 Examples: (a, Int), (Maybe a, [a], Either a Int), (# Int, a #)
1083
1084 * ft_ty_app: A type is being applied to the last type parameter, where the
1085 applied type does not mention the last type parameter (if it
1086 did, it would fall under ft_bad_app). The Type argument to
1087 ft_ty_app represents the applied type.
1088
1089 Note that functions, tuples, and foralls are distinct cases
1090 and take precedence of ft_ty_app. (For example, (Int -> a) would
1091 fall under (ft_fun Int a), not (ft_ty_app ((->) Int) a).
1092 Examples: Maybe a, Either b a
1093
1094 * ft_bad_app: A type application uses the last type parameter in a position
1095 other than the last argument. This case is singled out because
1096 Functor, Foldable, and Traversable instances cannot be derived
1097 for datatypes containing arguments with such types.
1098 Examples: Either a Int, Const a b
1099
1100 * ft_forall: A forall'd type mentions the last type parameter on its right-
1101 hand side (and is not quantified on the left-hand side). This
1102 case is present mostly for plumbing purposes.
1103 Example: forall b. Either b a
1104
1105 If FFoldType describes a strategy for folding subcomponents of a Type, then
1106 functorLikeTraverse is the function that applies that strategy to the entirety
1107 of a Type, returning the final folded-up result.
1108
1109 foldDataConArgs applies functorLikeTraverse to every argument type of a
1110 constructor, returning a list of the fold results. This makes foldDataConArgs
1111 a natural way to generate the subexpressions in a generated fmap, foldr,
1112 foldMap, or traverse definition (the subexpressions must then be combined in
1113 a method-specific fashion to form the final generated expression).
1114
1115 Deriving Generic1 also does validity checking by looking for the last type
1116 variable in certain positions of a constructor's argument types, so it also
1117 uses foldDataConArgs. See Note [degenerate use of FFoldType] in TcGenGenerics.
1118
1119 Note [Generated code for DeriveFoldable and DeriveTraversable]
1120 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1121 We adapt the algorithms for -XDeriveFoldable and -XDeriveTraversable based on
1122 that of -XDeriveFunctor. However, there an important difference between deriving
1123 the former two typeclasses and the latter one, which is best illustrated by the
1124 following scenario:
1125
1126 data WithInt a = WithInt a Int# deriving (Functor, Foldable, Traversable)
1127
1128 The generated code for the Functor instance is straightforward:
1129
1130 instance Functor WithInt where
1131 fmap f (WithInt a i) = WithInt (f a) i
1132
1133 But if we use too similar of a strategy for deriving the Foldable and
1134 Traversable instances, we end up with this code:
1135
1136 instance Foldable WithInt where
1137 foldMap f (WithInt a i) = f a <> mempty
1138
1139 instance Traversable WithInt where
1140 traverse f (WithInt a i) = fmap WithInt (f a) <*> pure i
1141
1142 This is unsatisfying for two reasons:
1143
1144 1. The Traversable instance doesn't typecheck! Int# is of kind #, but pure
1145 expects an argument whose type is of kind *. This effectively prevents
1146 Traversable from being derived for any datatype with an unlifted argument
1147 type (Trac #11174).
1148
1149 2. The generated code contains superfluous expressions. By the Monoid laws,
1150 we can reduce (f a <> mempty) to (f a), and by the Applicative laws, we can
1151 reduce (fmap WithInt (f a) <*> pure i) to (fmap (\b -> WithInt b i) (f a)).
1152
1153 We can fix both of these issues by incorporating a slight twist to the usual
1154 algorithm that we use for -XDeriveFunctor. The differences can be summarized
1155 as follows:
1156
1157 1. In the generated expression, we only fold over arguments whose types
1158 mention the last type parameter. Any other argument types will simply
1159 produce useless 'mempty's or 'pure's, so they can be safely ignored.
1160
1161 2. In the case of -XDeriveTraversable, instead of applying ConName,
1162 we apply (\b_i ... b_k -> ConName a_1 ... a_n), where
1163
1164 * ConName has n arguments
1165 * {b_i, ..., b_k} is a subset of {a_1, ..., a_n} whose indices correspond
1166 to the arguments whose types mention the last type parameter. As a
1167 consequence, taking the difference of {a_1, ..., a_n} and
1168 {b_i, ..., b_k} yields the all the argument values of ConName whose types
1169 do not mention the last type parameter. Note that [i, ..., k] is a
1170 strictly increasing—but not necessarily consecutive—integer sequence.
1171
1172 For example, the datatype
1173
1174 data Foo a = Foo Int a Int a
1175
1176 would generate the following Traversable instance:
1177
1178 instance Traversable Foo where
1179 traverse f (Foo a1 a2 a3 a4) =
1180 fmap (\b2 b4 -> Foo a1 b2 a3 b4) (f a2) <*> f a4
1181
1182 Technically, this approach would also work for -XDeriveFunctor as well, but we
1183 decide not to do so because:
1184
1185 1. There's not much benefit to generating, e.g., ((\b -> WithInt b i) (f a))
1186 instead of (WithInt (f a) i).
1187
1188 2. There would be certain datatypes for which the above strategy would
1189 generate Functor code that would fail to typecheck. For example:
1190
1191 data Bar f a = Bar (forall f. Functor f => f a) deriving Functor
1192
1193 With the conventional algorithm, it would generate something like:
1194
1195 fmap f (Bar a) = Bar (fmap f a)
1196
1197 which typechecks. But with the strategy mentioned above, it would generate:
1198
1199 fmap f (Bar a) = (\b -> Bar b) (fmap f a)
1200
1201 which does not typecheck, since GHC cannot unify the rank-2 type variables
1202 in the types of b and (fmap f a).
1203
1204 Note [Phantom types with Functor, Foldable, and Traversable]
1205 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1206
1207 Given a type F :: * -> * whose type argument has a phantom role, we can always
1208 produce lawful Functor and Traversable instances using
1209
1210 fmap _ = coerce
1211 traverse _ = pure . coerce
1212
1213 Indeed, these are equivalent to any *strictly lawful* instances one could
1214 write, except that this definition of 'traverse' may be lazier. That is, if
1215 instances obey the laws under true equality (rather than up to some equivalence
1216 relation), then they will be essentially equivalent to these. These definitions
1217 are incredibly cheap, so we want to use them even if it means ignoring some
1218 non-strictly-lawful instance in an embedded type.
1219
1220 Foldable has far fewer laws to work with, which leaves us unwelcome
1221 freedom in implementing it. At a minimum, we would like to ensure that
1222 a derived foldMap is always at least as good as foldMapDefault with a
1223 derived traverse. To accomplish that, we must define
1224
1225 foldMap _ _ = mempty
1226
1227 in these cases.
1228
1229 This may have different strictness properties from a standard derivation.
1230 Consider
1231
1232 data NotAList a = Nil | Cons (NotAList a) deriving Foldable
1233
1234 The usual deriving mechanism would produce
1235
1236 foldMap _ Nil = mempty
1237 foldMap f (Cons x) = foldMap f x
1238
1239 which is strict in the entire spine of the NotAList.
1240
1241 Final point: why do we even care about such types? Users will rarely if ever
1242 map, fold, or traverse over such things themselves, but other derived
1243 instances may:
1244
1245 data Hasn'tAList a = NotHere a (NotAList a) deriving Foldable
1246
1247 Note [EmptyDataDecls with Functor, Foldable, and Traversable]
1248 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1249
1250 There are some slightly tricky decisions to make about how to handle
1251 Functor, Foldable, and Traversable instances for types with no constructors.
1252 For fmap, the two basic options are
1253
1254 fmap _ _ = error "Sorry, no constructors"
1255
1256 or
1257
1258 fmap _ z = case z of
1259
1260 In most cases, the latter is more helpful: if the thunk passed to fmap
1261 throws an exception, we're generally going to be much more interested in
1262 that exception than in the fact that there aren't any constructors.
1263
1264 In order to match the semantics for phantoms (see note above), we need to
1265 be a bit careful about 'traverse'. The obvious definition would be
1266
1267 traverse _ z = case z of
1268
1269 but this is stricter than the one for phantoms. We instead use
1270
1271 traverse _ z = pure $ case z of
1272
1273 For foldMap, the obvious choices are
1274
1275 foldMap _ _ = mempty
1276
1277 or
1278
1279 foldMap _ z = case z of
1280
1281 We choose the first one to be consistent with what foldMapDefault does for
1282 a derived Traversable instance.
1283 -}