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