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