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