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