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