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