never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 -}
6
7 {-# LANGUAGE TypeFamilies #-}
8
9 -- | Error-checking and other utilities for @deriving@ clauses or declarations.
10 module GHC.Tc.Deriv.Utils (
11 DerivM, DerivEnv(..),
12 DerivSpec(..), pprDerivSpec, DerivInstTys(..),
13 DerivSpecMechanism(..), derivSpecMechanismToStrategy, isDerivSpecStock,
14 isDerivSpecNewtype, isDerivSpecAnyClass, isDerivSpecVia,
15 DerivContext(..), OriginativeDerivStatus(..),
16 isStandaloneDeriv, isStandaloneWildcardDeriv, mkDerivOrigin,
17 PredOrigin(..), ThetaOrigin(..), mkPredOrigin,
18 mkThetaOrigin, mkThetaOriginFromPreds, substPredOrigin,
19 checkOriginativeSideConditions, hasStockDeriving,
20 std_class_via_coercible, non_coercible_class,
21 newDerivClsInst, extendLocalInstEnv
22 ) where
23
24 import GHC.Prelude
25
26 import GHC.Data.Bag
27 import GHC.Types.Basic
28 import GHC.Core.Class
29 import GHC.Core.DataCon
30 import GHC.Driver.Session
31 import GHC.Utils.Error
32 import GHC.Types.Fixity.Env (lookupFixity)
33 import GHC.Hs
34 import GHC.Tc.Utils.Instantiate
35 import GHC.Core.InstEnv
36 import GHC.Iface.Load (loadInterfaceForName)
37 import GHC.Unit.Module (getModule)
38 import GHC.Unit.Module.ModIface (mi_fix)
39 import GHC.Types.Name
40 import GHC.Utils.Outputable
41 import GHC.Utils.Panic
42 import GHC.Builtin.Names
43 import GHC.Types.SrcLoc
44 import GHC.Tc.Deriv.Generate
45 import GHC.Tc.Deriv.Functor
46 import GHC.Tc.Deriv.Generics
47 import GHC.Tc.Errors.Types
48 import GHC.Tc.Types.Origin
49 import GHC.Tc.Utils.Monad
50 import GHC.Tc.Utils.TcType
51 import GHC.Builtin.Names.TH (liftClassKey)
52 import GHC.Core.TyCon
53 import GHC.Core.Multiplicity
54 import GHC.Core.Type
55 import GHC.Utils.Misc
56 import GHC.Types.Var.Set
57
58 import Control.Monad.Trans.Reader
59 import Data.Maybe
60 import qualified GHC.LanguageExtensions as LangExt
61 import GHC.Data.List.SetOps (assocMaybe)
62
63 -- | To avoid having to manually plumb everything in 'DerivEnv' throughout
64 -- various functions in "GHC.Tc.Deriv" and "GHC.Tc.Deriv.Infer", we use 'DerivM', which
65 -- is a simple reader around 'TcRn'.
66 type DerivM = ReaderT DerivEnv TcRn
67
68 -- | Is GHC processing a standalone deriving declaration?
69 isStandaloneDeriv :: DerivM Bool
70 isStandaloneDeriv = asks (go . denv_ctxt)
71 where
72 go :: DerivContext -> Bool
73 go (InferContext wildcard) = isJust wildcard
74 go (SupplyContext {}) = True
75
76 -- | Is GHC processing a standalone deriving declaration with an
77 -- extra-constraints wildcard as the context?
78 -- (e.g., @deriving instance _ => Eq (Foo a)@)
79 isStandaloneWildcardDeriv :: DerivM Bool
80 isStandaloneWildcardDeriv = asks (go . denv_ctxt)
81 where
82 go :: DerivContext -> Bool
83 go (InferContext wildcard) = isJust wildcard
84 go (SupplyContext {}) = False
85
86 -- | @'mkDerivOrigin' wc@ returns 'StandAloneDerivOrigin' if @wc@ is 'True',
87 -- and 'DerivClauseOrigin' if @wc@ is 'False'. Useful for error-reporting.
88 mkDerivOrigin :: Bool -> CtOrigin
89 mkDerivOrigin standalone_wildcard
90 | standalone_wildcard = StandAloneDerivOrigin
91 | otherwise = DerivClauseOrigin
92
93 -- | Contains all of the information known about a derived instance when
94 -- determining what its @EarlyDerivSpec@ should be.
95 -- See @Note [DerivEnv and DerivSpecMechanism]@.
96 data DerivEnv = DerivEnv
97 { denv_overlap_mode :: Maybe OverlapMode
98 -- ^ Is this an overlapping instance?
99 , denv_tvs :: [TyVar]
100 -- ^ Universally quantified type variables in the instance
101 , denv_cls :: Class
102 -- ^ Class for which we need to derive an instance
103 , denv_inst_tys :: [Type]
104 -- ^ All arguments to 'denv_cls' in the derived instance.
105 , denv_ctxt :: DerivContext
106 -- ^ @'SupplyContext' theta@ for standalone deriving (where @theta@ is the
107 -- context of the instance).
108 -- 'InferContext' for @deriving@ clauses, or for standalone deriving that
109 -- uses a wildcard constraint.
110 -- See @Note [Inferring the instance context]@.
111 , denv_strat :: Maybe (DerivStrategy GhcTc)
112 -- ^ 'Just' if user requests a particular deriving strategy.
113 -- Otherwise, 'Nothing'.
114 }
115
116 instance Outputable DerivEnv where
117 ppr (DerivEnv { denv_overlap_mode = overlap_mode
118 , denv_tvs = tvs
119 , denv_cls = cls
120 , denv_inst_tys = inst_tys
121 , denv_ctxt = ctxt
122 , denv_strat = mb_strat })
123 = hang (text "DerivEnv")
124 2 (vcat [ text "denv_overlap_mode" <+> ppr overlap_mode
125 , text "denv_tvs" <+> ppr tvs
126 , text "denv_cls" <+> ppr cls
127 , text "denv_inst_tys" <+> ppr inst_tys
128 , text "denv_ctxt" <+> ppr ctxt
129 , text "denv_strat" <+> ppr mb_strat ])
130
131 data DerivSpec theta = DS { ds_loc :: SrcSpan
132 , ds_name :: Name -- DFun name
133 , ds_tvs :: [TyVar]
134 , ds_theta :: theta
135 , ds_cls :: Class
136 , ds_tys :: [Type]
137 , ds_overlap :: Maybe OverlapMode
138 , ds_standalone_wildcard :: Maybe SrcSpan
139 -- See Note [Inferring the instance context]
140 -- in GHC.Tc.Deriv.Infer
141 , ds_mechanism :: DerivSpecMechanism }
142 -- This spec implies a dfun declaration of the form
143 -- df :: forall tvs. theta => C tys
144 -- The Name is the name for the DFun we'll build
145 -- The tyvars bind all the variables in the theta
146
147 -- the theta is either the given and final theta, in standalone deriving,
148 -- or the not-yet-simplified list of constraints together with their origin
149
150 -- ds_mechanism specifies the means by which GHC derives the instance.
151 -- See Note [Deriving strategies] in GHC.Tc.Deriv
152
153 {-
154 Example:
155
156 newtype instance T [a] = MkT (Tree a) deriving( C s )
157 ==>
158 axiom T [a] = :RTList a
159 axiom :RTList a = Tree a
160
161 DS { ds_tvs = [a,s], ds_cls = C, ds_tys = [s, T [a]]
162 , ds_mechanism = DerivSpecNewtype (Tree a) }
163 -}
164
165 pprDerivSpec :: Outputable theta => DerivSpec theta -> SDoc
166 pprDerivSpec (DS { ds_loc = l, ds_name = n, ds_tvs = tvs, ds_cls = c,
167 ds_tys = tys, ds_theta = rhs,
168 ds_standalone_wildcard = wildcard, ds_mechanism = mech })
169 = hang (text "DerivSpec")
170 2 (vcat [ text "ds_loc =" <+> ppr l
171 , text "ds_name =" <+> ppr n
172 , text "ds_tvs =" <+> ppr tvs
173 , text "ds_cls =" <+> ppr c
174 , text "ds_tys =" <+> ppr tys
175 , text "ds_theta =" <+> ppr rhs
176 , text "ds_standalone_wildcard =" <+> ppr wildcard
177 , text "ds_mechanism =" <+> ppr mech ])
178
179 instance Outputable theta => Outputable (DerivSpec theta) where
180 ppr = pprDerivSpec
181
182 -- | Information about the arguments to the class in a stock- or
183 -- newtype-derived instance.
184 -- See @Note [DerivEnv and DerivSpecMechanism]@.
185 data DerivInstTys = DerivInstTys
186 { dit_cls_tys :: [Type]
187 -- ^ Other arguments to the class except the last
188 , dit_tc :: TyCon
189 -- ^ Type constructor for which the instance is requested
190 -- (last arguments to the type class)
191 , dit_tc_args :: [Type]
192 -- ^ Arguments to the type constructor
193 , dit_rep_tc :: TyCon
194 -- ^ The representation tycon for 'dit_tc'
195 -- (for data family instances). Otherwise the same as 'dit_tc'.
196 , dit_rep_tc_args :: [Type]
197 -- ^ The representation types for 'dit_tc_args'
198 -- (for data family instances). Otherwise the same as 'dit_tc_args'.
199 }
200
201 instance Outputable DerivInstTys where
202 ppr (DerivInstTys { dit_cls_tys = cls_tys, dit_tc = tc, dit_tc_args = tc_args
203 , dit_rep_tc = rep_tc, dit_rep_tc_args = rep_tc_args })
204 = hang (text "DITTyConHead")
205 2 (vcat [ text "dit_cls_tys" <+> ppr cls_tys
206 , text "dit_tc" <+> ppr tc
207 , text "dit_tc_args" <+> ppr tc_args
208 , text "dit_rep_tc" <+> ppr rep_tc
209 , text "dit_rep_tc_args" <+> ppr rep_tc_args ])
210
211 -- | What action to take in order to derive a class instance.
212 -- See @Note [DerivEnv and DerivSpecMechanism]@, as well as
213 -- @Note [Deriving strategies]@ in "GHC.Tc.Deriv".
214 data DerivSpecMechanism
215 -- | \"Standard\" classes
216 = DerivSpecStock
217 { dsm_stock_dit :: DerivInstTys
218 -- ^ Information about the arguments to the class in the derived
219 -- instance, including what type constructor the last argument is
220 -- headed by. See @Note [DerivEnv and DerivSpecMechanism]@.
221 , dsm_stock_gen_fn ::
222 SrcSpan -> TyCon -- dit_rep_tc
223 -> [Type] -- dit_rep_tc_args
224 -> [Type] -- inst_tys
225 -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name])
226 -- ^ This function returns four things:
227 --
228 -- 1. @LHsBinds GhcPs@: The derived instance's function bindings
229 -- (e.g., @compare (T x) (T y) = compare x y@)
230 --
231 -- 2. @[LSig GhcPs]@: A list of instance specific signatures/pragmas.
232 -- Most likely INLINE pragmas for class methods.
233 --
234 -- 3. @BagDerivStuff@: Auxiliary bindings needed to support the derived
235 -- instance. As examples, derived 'Generic' instances require
236 -- associated type family instances, and derived 'Eq' and 'Ord'
237 -- instances require top-level @con2tag@ functions.
238 -- See @Note [Auxiliary binders]@ in "GHC.Tc.Deriv.Generate".
239 --
240 -- 4. @[Name]@: A list of Names for which @-Wunused-binds@ should be
241 -- suppressed. This is used to suppress unused warnings for record
242 -- selectors when deriving 'Read', 'Show', or 'Generic'.
243 -- See @Note [Deriving and unused record selectors]@.
244 }
245
246 -- | @GeneralizedNewtypeDeriving@
247 | DerivSpecNewtype
248 { dsm_newtype_dit :: DerivInstTys
249 -- ^ Information about the arguments to the class in the derived
250 -- instance, including what type constructor the last argument is
251 -- headed by. See @Note [DerivEnv and DerivSpecMechanism]@.
252 , dsm_newtype_rep_ty :: Type
253 -- ^ The newtype rep type.
254 }
255
256 -- | @DeriveAnyClass@
257 | DerivSpecAnyClass
258
259 -- | @DerivingVia@
260 | DerivSpecVia
261 { dsm_via_cls_tys :: [Type]
262 -- ^ All arguments to the class besides the last one.
263 , dsm_via_inst_ty :: Type
264 -- ^ The last argument to the class.
265 , dsm_via_ty :: Type
266 -- ^ The @via@ type
267 }
268
269 -- | Convert a 'DerivSpecMechanism' to its corresponding 'DerivStrategy'.
270 derivSpecMechanismToStrategy :: DerivSpecMechanism -> DerivStrategy GhcTc
271 derivSpecMechanismToStrategy DerivSpecStock{} = StockStrategy noExtField
272 derivSpecMechanismToStrategy DerivSpecNewtype{} = NewtypeStrategy noExtField
273 derivSpecMechanismToStrategy DerivSpecAnyClass = AnyclassStrategy noExtField
274 derivSpecMechanismToStrategy (DerivSpecVia{dsm_via_ty = t}) = ViaStrategy t
275
276 isDerivSpecStock, isDerivSpecNewtype, isDerivSpecAnyClass, isDerivSpecVia
277 :: DerivSpecMechanism -> Bool
278 isDerivSpecStock (DerivSpecStock{}) = True
279 isDerivSpecStock _ = False
280
281 isDerivSpecNewtype (DerivSpecNewtype{}) = True
282 isDerivSpecNewtype _ = False
283
284 isDerivSpecAnyClass DerivSpecAnyClass = True
285 isDerivSpecAnyClass _ = False
286
287 isDerivSpecVia (DerivSpecVia{}) = True
288 isDerivSpecVia _ = False
289
290 instance Outputable DerivSpecMechanism where
291 ppr (DerivSpecStock{dsm_stock_dit = dit})
292 = hang (text "DerivSpecStock")
293 2 (vcat [ text "dsm_stock_dit" <+> ppr dit ])
294 ppr (DerivSpecNewtype { dsm_newtype_dit = dit, dsm_newtype_rep_ty = rep_ty })
295 = hang (text "DerivSpecNewtype")
296 2 (vcat [ text "dsm_newtype_dit" <+> ppr dit
297 , text "dsm_newtype_rep_ty" <+> ppr rep_ty ])
298 ppr DerivSpecAnyClass = text "DerivSpecAnyClass"
299 ppr (DerivSpecVia { dsm_via_cls_tys = cls_tys, dsm_via_inst_ty = inst_ty
300 , dsm_via_ty = via_ty })
301 = hang (text "DerivSpecVia")
302 2 (vcat [ text "dsm_via_cls_tys" <+> ppr cls_tys
303 , text "dsm_via_inst_ty" <+> ppr inst_ty
304 , text "dsm_via_ty" <+> ppr via_ty ])
305
306 {-
307 Note [DerivEnv and DerivSpecMechanism]
308 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
309 DerivEnv contains all of the bits and pieces that are common to every
310 deriving strategy. (See Note [Deriving strategies] in GHC.Tc.Deriv.) Some deriving
311 strategies impose stricter requirements on the types involved in the derived
312 instance than others, and these differences are factored out into the
313 DerivSpecMechanism type. Suppose that the derived instance looks like this:
314
315 instance ... => C arg_1 ... arg_n
316
317 Each deriving strategy imposes restrictions on arg_1 through arg_n as follows:
318
319 * stock (DerivSpecStock):
320
321 Stock deriving requires that:
322
323 - n must be a positive number. This is checked by
324 GHC.Tc.Deriv.expectNonNullaryClsArgs
325 - arg_n must be an application of an algebraic type constructor. Here,
326 "algebraic type constructor" means:
327
328 + An ordinary data type constructor, or
329 + A data family type constructor such that the arguments it is applied to
330 give rise to a data family instance.
331
332 This is checked by GHC.Tc.Deriv.expectAlgTyConApp.
333
334 This extra structure is witnessed by the DerivInstTys data type, which stores
335 arg_1 through arg_(n-1) (dit_cls_tys), the algebraic type constructor
336 (dit_tc), and its arguments (dit_tc_args). If dit_tc is an ordinary data type
337 constructor, then dit_rep_tc/dit_rep_tc_args are the same as
338 dit_tc/dit_tc_args. If dit_tc is a data family type constructor, then
339 dit_rep_tc is the representation type constructor for the data family
340 instance, and dit_rep_tc_args are the arguments to the representation type
341 constructor in the corresponding instance.
342
343 * newtype (DerivSpecNewtype):
344
345 Newtype deriving imposes the same DerivInstTys requirements as stock
346 deriving. This is necessary because we need to know what the underlying type
347 that the newtype wraps is, and this information can only be learned by
348 knowing dit_rep_tc.
349
350 * anyclass (DerivSpecAnyclass):
351
352 DeriveAnyClass is the most permissive deriving strategy of all, as it
353 essentially imposes no requirements on the derived instance. This is because
354 DeriveAnyClass simply derives an empty instance, so it does not need any
355 particular knowledge about the types involved. It can do several things
356 that stock/newtype deriving cannot do (#13154):
357
358 - n can be 0. That is, one is allowed to anyclass-derive an instance with
359 no arguments to the class, such as in this example:
360
361 class C
362 deriving anyclass instance C
363
364 - One can derive an instance for a type that is not headed by a type
365 constructor, such as in the following example:
366
367 class C (n :: Nat)
368 deriving instance C 0
369 deriving instance C 1
370 ...
371
372 - One can derive an instance for a data family with no data family instances,
373 such as in the following example:
374
375 data family Foo a
376 class C a
377 deriving anyclass instance C (Foo a)
378
379 * via (DerivSpecVia):
380
381 Like newtype deriving, DerivingVia requires that n must be a positive number.
382 This is because when one derives something like this:
383
384 deriving via Foo instance C Bar
385
386 Then the generated code must specifically mention Bar. However, in
387 contrast with newtype deriving, DerivingVia does *not* require Bar to be
388 an application of an algebraic type constructor. This is because the
389 generated code simply defers to invoking `coerce`, which does not need to
390 know anything in particular about Bar (besides that it is representationally
391 equal to Foo). This allows DerivingVia to do some things that are not
392 possible with newtype deriving, such as deriving instances for data families
393 without data instances (#13154):
394
395 data family Foo a
396 newtype ByBar a = ByBar a
397 class Baz a where ...
398 instance Baz (ByBar a) where ...
399 deriving via ByBar (Foo a) instance Baz (Foo a)
400 -}
401
402 -- | Whether GHC is processing a @deriving@ clause or a standalone deriving
403 -- declaration.
404 data DerivContext
405 = InferContext (Maybe SrcSpan) -- ^ @'InferContext mb_wildcard@ is either:
406 --
407 -- * A @deriving@ clause (in which case
408 -- @mb_wildcard@ is 'Nothing').
409 --
410 -- * A standalone deriving declaration with
411 -- an extra-constraints wildcard as the
412 -- context (in which case @mb_wildcard@ is
413 -- @'Just' loc@, where @loc@ is the location
414 -- of the wildcard.
415 --
416 -- GHC should infer the context.
417
418 | SupplyContext ThetaType -- ^ @'SupplyContext' theta@ is a standalone
419 -- deriving declaration, where @theta@ is the
420 -- context supplied by the user.
421
422 instance Outputable DerivContext where
423 ppr (InferContext standalone) = text "InferContext" <+> ppr standalone
424 ppr (SupplyContext theta) = text "SupplyContext" <+> ppr theta
425
426 -- | Records whether a particular class can be derived by way of an
427 -- /originative/ deriving strategy (i.e., @stock@ or @anyclass@).
428 --
429 -- See @Note [Deriving strategies]@ in "GHC.Tc.Deriv".
430 data OriginativeDerivStatus
431 = CanDeriveStock -- Stock class, can derive
432 (SrcSpan -> TyCon -> [Type] -> [Type]
433 -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))
434 | StockClassError !DeriveInstanceErrReason -- Stock class, but can't do it
435 | CanDeriveAnyClass -- See Note [Deriving any class]
436 | NonDerivableClass -- Cannot derive with either stock or anyclass
437
438 -- A stock class is one either defined in the Haskell report or for which GHC
439 -- otherwise knows how to generate code for (possibly requiring the use of a
440 -- language extension), such as Eq, Ord, Ix, Data, Generic, etc.)
441
442 -- | A 'PredType' annotated with the origin of the constraint 'CtOrigin',
443 -- and whether or the constraint deals in types or kinds.
444 data PredOrigin = PredOrigin PredType CtOrigin TypeOrKind
445
446 -- | A list of wanted 'PredOrigin' constraints ('to_wanted_origins') to
447 -- simplify when inferring a derived instance's context. These are used in all
448 -- deriving strategies, but in the particular case of @DeriveAnyClass@, we
449 -- need extra information. In particular, we need:
450 --
451 -- * 'to_anyclass_skols', the list of type variables bound by a class method's
452 -- regular type signature, which should be rigid.
453 --
454 -- * 'to_anyclass_metas', the list of type variables bound by a class method's
455 -- default type signature. These can be unified as necessary.
456 --
457 -- * 'to_anyclass_givens', the list of constraints from a class method's
458 -- regular type signature, which can be used to help solve constraints
459 -- in the 'to_wanted_origins'.
460 --
461 -- (Note that 'to_wanted_origins' will likely contain type variables from the
462 -- derived type class or data type, neither of which will appear in
463 -- 'to_anyclass_skols' or 'to_anyclass_metas'.)
464 --
465 -- For all other deriving strategies, it is always the case that
466 -- 'to_anyclass_skols', 'to_anyclass_metas', and 'to_anyclass_givens' are
467 -- empty.
468 --
469 -- Here is an example to illustrate this:
470 --
471 -- @
472 -- class Foo a where
473 -- bar :: forall b. Ix b => a -> b -> String
474 -- default bar :: forall y. (Show a, Ix y) => a -> y -> String
475 -- bar x y = show x ++ show (range (y, y))
476 --
477 -- baz :: Eq a => a -> a -> Bool
478 -- default baz :: Ord a => a -> a -> Bool
479 -- baz x y = compare x y == EQ
480 --
481 -- data Quux q = Quux deriving anyclass Foo
482 -- @
483 --
484 -- Then it would generate two 'ThetaOrigin's, one for each method:
485 --
486 -- @
487 -- [ ThetaOrigin { to_anyclass_skols = [b]
488 -- , to_anyclass_metas = [y]
489 -- , to_anyclass_givens = [Ix b]
490 -- , to_wanted_origins = [ Show (Quux q), Ix y
491 -- , (Quux q -> b -> String) ~
492 -- (Quux q -> y -> String)
493 -- ] }
494 -- , ThetaOrigin { to_anyclass_skols = []
495 -- , to_anyclass_metas = []
496 -- , to_anyclass_givens = [Eq (Quux q)]
497 -- , to_wanted_origins = [ Ord (Quux q)
498 -- , (Quux q -> Quux q -> Bool) ~
499 -- (Quux q -> Quux q -> Bool)
500 -- ] }
501 -- ]
502 -- @
503 --
504 -- (Note that the type variable @q@ is bound by the data type @Quux@, and thus
505 -- it appears in neither 'to_anyclass_skols' nor 'to_anyclass_metas'.)
506 --
507 -- See @Note [Gathering and simplifying constraints for DeriveAnyClass]@
508 -- in "GHC.Tc.Deriv.Infer" for an explanation of how 'to_wanted_origins' are
509 -- determined in @DeriveAnyClass@, as well as how 'to_anyclass_skols',
510 -- 'to_anyclass_metas', and 'to_anyclass_givens' are used.
511 data ThetaOrigin
512 = ThetaOrigin { to_anyclass_skols :: [TyVar]
513 , to_anyclass_metas :: [TyVar]
514 , to_anyclass_givens :: ThetaType
515 , to_wanted_origins :: [PredOrigin] }
516
517 instance Outputable PredOrigin where
518 ppr (PredOrigin ty _ _) = ppr ty -- The origin is not so interesting when debugging
519
520 instance Outputable ThetaOrigin where
521 ppr (ThetaOrigin { to_anyclass_skols = ac_skols
522 , to_anyclass_metas = ac_metas
523 , to_anyclass_givens = ac_givens
524 , to_wanted_origins = wanted_origins })
525 = hang (text "ThetaOrigin")
526 2 (vcat [ text "to_anyclass_skols =" <+> ppr ac_skols
527 , text "to_anyclass_metas =" <+> ppr ac_metas
528 , text "to_anyclass_givens =" <+> ppr ac_givens
529 , text "to_wanted_origins =" <+> ppr wanted_origins ])
530
531 mkPredOrigin :: CtOrigin -> TypeOrKind -> PredType -> PredOrigin
532 mkPredOrigin origin t_or_k pred = PredOrigin pred origin t_or_k
533
534 mkThetaOrigin :: CtOrigin -> TypeOrKind
535 -> [TyVar] -> [TyVar] -> ThetaType -> ThetaType
536 -> ThetaOrigin
537 mkThetaOrigin origin t_or_k skols metas givens
538 = ThetaOrigin skols metas givens . map (mkPredOrigin origin t_or_k)
539
540 -- A common case where the ThetaOrigin only contains wanted constraints, with
541 -- no givens or locally scoped type variables.
542 mkThetaOriginFromPreds :: [PredOrigin] -> ThetaOrigin
543 mkThetaOriginFromPreds = ThetaOrigin [] [] []
544
545 substPredOrigin :: HasCallStack => TCvSubst -> PredOrigin -> PredOrigin
546 substPredOrigin subst (PredOrigin pred origin t_or_k)
547 = PredOrigin (substTy subst pred) origin t_or_k
548
549 {-
550 ************************************************************************
551 * *
552 Class deriving diagnostics
553 * *
554 ************************************************************************
555
556 Only certain blessed classes can be used in a deriving clause (without the
557 assistance of GeneralizedNewtypeDeriving or DeriveAnyClass). These classes
558 are listed below in the definition of hasStockDeriving. The stockSideConditions
559 function determines the criteria that needs to be met in order for a particular
560 stock class to be able to be derived successfully.
561
562 A class might be able to be used in a deriving clause if -XDeriveAnyClass
563 is willing to support it.
564 -}
565
566 hasStockDeriving
567 :: Class -> Maybe (SrcSpan
568 -> TyCon
569 -> [Type]
570 -> [Type]
571 -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))
572 hasStockDeriving clas
573 = assocMaybe gen_list (getUnique clas)
574 where
575 gen_list
576 :: [(Unique, SrcSpan
577 -> TyCon
578 -> [Type]
579 -> [Type]
580 -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))]
581 gen_list = [ (eqClassKey, simpleM gen_Eq_binds)
582 , (ordClassKey, simpleM gen_Ord_binds)
583 , (enumClassKey, simpleM gen_Enum_binds)
584 , (boundedClassKey, simple gen_Bounded_binds)
585 , (ixClassKey, simpleM gen_Ix_binds)
586 , (showClassKey, read_or_show gen_Show_binds)
587 , (readClassKey, read_or_show gen_Read_binds)
588 , (dataClassKey, simpleM gen_Data_binds)
589 , (functorClassKey, simple gen_Functor_binds)
590 , (foldableClassKey, simple gen_Foldable_binds)
591 , (traversableClassKey, simple gen_Traversable_binds)
592 , (liftClassKey, simple gen_Lift_binds)
593 , (genClassKey, generic (gen_Generic_binds Gen0))
594 , (gen1ClassKey, generic (gen_Generic_binds Gen1)) ]
595
596 simple gen_fn loc tc tc_args _
597 = let (binds, deriv_stuff) = gen_fn loc tc tc_args
598 in return (binds, [], deriv_stuff, [])
599
600 -- Like `simple`, but monadic. The only monadic thing that these functions
601 -- do is allocate new Uniques, which are used for generating the names of
602 -- auxiliary bindings.
603 -- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
604 simpleM gen_fn loc tc tc_args _
605 = do { (binds, deriv_stuff) <- gen_fn loc tc tc_args
606 ; return (binds, [], deriv_stuff, []) }
607
608 read_or_show gen_fn loc tc tc_args _
609 = do { fix_env <- getDataConFixityFun tc
610 ; let (binds, deriv_stuff) = gen_fn fix_env loc tc tc_args
611 field_names = all_field_names tc
612 ; return (binds, [], deriv_stuff, field_names) }
613
614 generic gen_fn _ tc _ inst_tys
615 = do { (binds, sigs, faminst) <- gen_fn tc inst_tys
616 ; let field_names = all_field_names tc
617 ; return (binds, sigs, unitBag (DerivFamInst faminst), field_names) }
618
619 -- See Note [Deriving and unused record selectors]
620 all_field_names = map flSelector . concatMap dataConFieldLabels
621 . tyConDataCons
622
623 {-
624 Note [Deriving and unused record selectors]
625 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
626 Consider this (see #13919):
627
628 module Main (main) where
629
630 data Foo = MkFoo {bar :: String} deriving Show
631
632 main :: IO ()
633 main = print (Foo "hello")
634
635 Strictly speaking, the record selector `bar` is unused in this module, since
636 neither `main` nor the derived `Show` instance for `Foo` mention `bar`.
637 However, the behavior of `main` is affected by the presence of `bar`, since
638 it will print different output depending on whether `MkFoo` is defined using
639 record selectors or not. Therefore, we do not to issue a
640 "Defined but not used: ‘bar’" warning for this module, since removing `bar`
641 changes the program's behavior. This is the reason behind the [Name] part of
642 the return type of `hasStockDeriving`—it tracks all of the record selector
643 `Name`s for which -Wunused-binds should be suppressed.
644
645 Currently, the only three stock derived classes that require this are Read,
646 Show, and Generic, as their derived code all depend on the record selectors
647 of the derived data type's constructors.
648
649 See also Note [Newtype deriving and unused constructors] in GHC.Tc.Deriv for
650 another example of a similar trick.
651 -}
652
653 getDataConFixityFun :: TyCon -> TcM (Name -> Fixity)
654 -- If the TyCon is locally defined, we want the local fixity env;
655 -- but if it is imported (which happens for standalone deriving)
656 -- we need to get the fixity env from the interface file
657 -- c.f. GHC.Rename.Env.lookupFixity, and #9830
658 getDataConFixityFun tc
659 = do { this_mod <- getModule
660 ; if nameIsLocalOrFrom this_mod name
661 then do { fix_env <- getFixityEnv
662 ; return (lookupFixity fix_env) }
663 else do { iface <- loadInterfaceForName doc name
664 -- Should already be loaded!
665 ; return (mi_fix iface . nameOccName) } }
666 where
667 name = tyConName tc
668 doc = text "Data con fixities for" <+> ppr name
669
670 ------------------------------------------------------------------
671 -- Check side conditions that dis-allow derivability for the originative
672 -- deriving strategies (stock and anyclass).
673 -- See Note [Deriving strategies] in GHC.Tc.Deriv for an explanation of what
674 -- "originative" means.
675 --
676 -- This is *apart* from the coerce-based strategies, newtype and via.
677 --
678 -- Here we get the representation tycon in case of family instances as it has
679 -- the data constructors - but we need to be careful to fall back to the
680 -- family tycon (with indexes) in error messages.
681
682 checkOriginativeSideConditions
683 :: DynFlags -> DerivContext -> Class -> [TcType]
684 -> TyCon -> TyCon
685 -> OriginativeDerivStatus
686 checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys tc rep_tc
687 -- First, check if stock deriving is possible...
688 | Just cond <- stockSideConditions deriv_ctxt cls
689 = case (cond dflags tc rep_tc) of
690 NotValid err -> StockClassError err -- Class-specific error
691 IsValid | null (filterOutInvisibleTypes (classTyCon cls) cls_tys)
692 -- All stock derivable classes are unary in the sense that
693 -- there should be not types in cls_tys (i.e., no type args
694 -- other than last). Note that cls_types can contain
695 -- invisible types as well (e.g., for Generic1, which is
696 -- poly-kinded), so make sure those are not counted.
697 , Just gen_fn <- hasStockDeriving cls
698 -> CanDeriveStock gen_fn
699 | otherwise -> StockClassError (classArgsErr cls cls_tys)
700 -- e.g. deriving( Eq s )
701
702 -- ...if not, try falling back on DeriveAnyClass.
703 | xopt LangExt.DeriveAnyClass dflags
704 = CanDeriveAnyClass -- DeriveAnyClass should work
705
706 | otherwise
707 = NonDerivableClass -- Neither anyclass nor stock work
708
709
710 classArgsErr :: Class -> [Type] -> DeriveInstanceErrReason
711 classArgsErr cls cls_tys = DerivErrNotAClass (mkClassPred cls cls_tys)
712
713 -- Side conditions (whether the datatype must have at least one constructor,
714 -- required language extensions, etc.) for using GHC's stock deriving
715 -- mechanism on certain classes (as opposed to classes that require
716 -- GeneralizedNewtypeDeriving or DeriveAnyClass). Returns Nothing for a
717 -- class for which stock deriving isn't possible.
718 stockSideConditions :: DerivContext -> Class -> Maybe Condition
719 stockSideConditions deriv_ctxt cls
720 | cls_key == eqClassKey = Just (cond_std `andCond` cond_args cls)
721 | cls_key == ordClassKey = Just (cond_std `andCond` cond_args cls)
722 | cls_key == showClassKey = Just (cond_std `andCond` cond_args cls)
723 | cls_key == readClassKey = Just (cond_std `andCond` cond_args cls)
724 | cls_key == enumClassKey = Just (cond_std `andCond` cond_isEnumeration)
725 | cls_key == ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
726 | cls_key == boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
727 | cls_key == dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond`
728 cond_vanilla `andCond`
729 cond_args cls)
730 | cls_key == functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond`
731 cond_vanilla `andCond`
732 cond_functorOK True False)
733 | cls_key == foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond`
734 cond_vanilla `andCond`
735 cond_functorOK False True)
736 -- Functor/Fold/Trav works ok
737 -- for rank-n types
738 | cls_key == traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond`
739 cond_vanilla `andCond`
740 cond_functorOK False False)
741 | cls_key == genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
742 cond_vanilla `andCond`
743 cond_RepresentableOk)
744 | cls_key == gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
745 cond_vanilla `andCond`
746 cond_Representable1Ok)
747 | cls_key == liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond`
748 cond_vanilla `andCond`
749 cond_args cls)
750 | otherwise = Nothing
751 where
752 cls_key = getUnique cls
753 cond_std = cond_stdOK deriv_ctxt False
754 -- Vanilla data constructors, at least one, and monotype arguments
755 cond_vanilla = cond_stdOK deriv_ctxt True
756 -- Vanilla data constructors but allow no data cons or polytype arguments
757
758 type Condition
759 = DynFlags
760
761 -> TyCon -- ^ The data type's 'TyCon'. For data families, this is the
762 -- family 'TyCon'.
763
764 -> TyCon -- ^ For data families, this is the representation 'TyCon'.
765 -- Otherwise, this is the same as the other 'TyCon' argument.
766
767 -> Validity' DeriveInstanceErrReason
768 -- ^ 'IsValid' if deriving an instance for this 'TyCon' is
769 -- possible. Otherwise, it's @'NotValid' err@, where @err@
770 -- explains what went wrong.
771
772 andCond :: Condition -> Condition -> Condition
773 andCond c1 c2 dflags tc rep_tc
774 = c1 dflags tc rep_tc `andValid` c2 dflags tc rep_tc
775
776 -- | Some common validity checks shared among stock derivable classes. One
777 -- check that absolutely must hold is that if an instance @C (T a)@ is being
778 -- derived, then @T@ must be a tycon for a data type or a newtype. The
779 -- remaining checks are only performed if using a @deriving@ clause (i.e.,
780 -- they're ignored if using @StandaloneDeriving@):
781 --
782 -- 1. The data type must have at least one constructor (this check is ignored
783 -- if using @EmptyDataDeriving@).
784 --
785 -- 2. The data type cannot have any GADT constructors.
786 --
787 -- 3. The data type cannot have any constructors with existentially quantified
788 -- type variables.
789 --
790 -- 4. The data type cannot have a context (e.g., @data Foo a = Eq a => MkFoo@).
791 --
792 -- 5. The data type cannot have fields with higher-rank types.
793 cond_stdOK
794 :: DerivContext -- ^ 'SupplyContext' if this is standalone deriving with a
795 -- user-supplied context, 'InferContext' if not.
796 -- If it is the former, we relax some of the validity checks
797 -- we would otherwise perform (i.e., "just go for it").
798
799 -> Bool -- ^ 'True' <=> allow higher rank arguments and empty data
800 -- types (with no data constructors) even in the absence of
801 -- the -XEmptyDataDeriving extension.
802
803 -> Condition
804 cond_stdOK deriv_ctxt permissive dflags tc rep_tc
805 = valid_ADT `andValid` valid_misc
806 where
807 valid_ADT, valid_misc :: Validity' DeriveInstanceErrReason
808 valid_ADT
809 | isAlgTyCon tc || isDataFamilyTyCon tc
810 = IsValid
811 | otherwise
812 -- Complain about functions, primitive types, and other tycons that
813 -- stock deriving can't handle.
814 = NotValid DerivErrLastArgMustBeApp
815
816 valid_misc
817 = case deriv_ctxt of
818 SupplyContext _ -> IsValid
819 -- Don't check these conservative conditions for
820 -- standalone deriving; just generate the code
821 -- and let the typechecker handle the result
822 InferContext wildcard
823 | null data_cons -- 1.
824 , not permissive
825 -> checkFlag LangExt.EmptyDataDeriving dflags tc rep_tc `orValid`
826 NotValid (no_cons_why rep_tc)
827 | not (null con_whys)
828 -> NotValid $ DerivErrBadConstructor (Just $ has_wildcard wildcard) con_whys
829 | otherwise
830 -> IsValid
831
832 has_wildcard wildcard
833 = case wildcard of
834 Just _ -> YesHasWildcard
835 Nothing -> NoHasWildcard
836 data_cons = tyConDataCons rep_tc
837 con_whys = getInvalids (map check_con data_cons)
838
839 check_con :: DataCon -> Validity' DeriveInstanceBadConstructor
840 check_con con
841 | not (null eq_spec) -- 2.
842 = bad DerivErrBadConIsGADT
843 | not (null ex_tvs) -- 3.
844 = bad DerivErrBadConHasExistentials
845 | not (null theta) -- 4.
846 = bad DerivErrBadConHasConstraints
847 | not (permissive || all isTauTy (map scaledThing $ dataConOrigArgTys con)) -- 5.
848 = bad DerivErrBadConHasHigherRankType
849 | otherwise
850 = IsValid
851 where
852 (_, ex_tvs, eq_spec, theta, _, _) = dataConFullSig con
853 bad mkErr = NotValid $ mkErr con
854
855 no_cons_why :: TyCon -> DeriveInstanceErrReason
856 no_cons_why = DerivErrNoConstructors
857
858 cond_RepresentableOk :: Condition
859 cond_RepresentableOk _ _ rep_tc =
860 case canDoGenerics rep_tc of
861 IsValid -> IsValid
862 NotValid generic_errs -> NotValid $ DerivErrGenerics generic_errs
863
864 cond_Representable1Ok :: Condition
865 cond_Representable1Ok _ _ rep_tc =
866 case canDoGenerics1 rep_tc of
867 IsValid -> IsValid
868 NotValid generic_errs -> NotValid $ DerivErrGenerics generic_errs
869
870 cond_enumOrProduct :: Class -> Condition
871 cond_enumOrProduct cls = cond_isEnumeration `orCond`
872 (cond_isProduct `andCond` cond_args cls)
873 where
874 orCond :: Condition -> Condition -> Condition
875 orCond c1 c2 dflags tc rep_tc
876 = case (c1 dflags tc rep_tc, c2 dflags tc rep_tc) of
877 (IsValid, _) -> IsValid -- c1 succeeds
878 (_, IsValid) -> IsValid -- c21 succeeds
879 (NotValid x, NotValid y) -> NotValid $ DerivErrEnumOrProduct x y
880 -- Both fail
881
882
883 cond_args :: Class -> Condition
884 -- ^ For some classes (eg 'Eq', 'Ord') we allow unlifted arg types
885 -- by generating specialised code. For others (eg 'Data') we don't.
886 -- For even others (eg 'Lift'), unlifted types aren't even a special
887 -- consideration!
888 cond_args cls _ _ rep_tc
889 = case bad_args of
890 [] -> IsValid
891 (ty:_) -> NotValid $ DerivErrDunnoHowToDeriveForType ty
892 where
893 bad_args = [ arg_ty | con <- tyConDataCons rep_tc
894 , Scaled _ arg_ty <- dataConOrigArgTys con
895 , isLiftedType_maybe arg_ty /= Just True
896 , not (ok_ty arg_ty) ]
897
898 cls_key = classKey cls
899 ok_ty arg_ty
900 | cls_key == eqClassKey = check_in arg_ty ordOpTbl
901 | cls_key == ordClassKey = check_in arg_ty ordOpTbl
902 | cls_key == showClassKey = check_in arg_ty boxConTbl
903 | cls_key == liftClassKey = True -- Lift is representation-polymorphic
904 | otherwise = False -- Read, Ix etc
905
906 check_in :: Type -> [(Type,a)] -> Bool
907 check_in arg_ty tbl = any (eqType arg_ty . fst) tbl
908
909
910 cond_isEnumeration :: Condition
911 cond_isEnumeration _ _ rep_tc
912 | isEnumerationTyCon rep_tc = IsValid
913 | otherwise = NotValid $ DerivErrMustBeEnumType rep_tc
914
915 cond_isProduct :: Condition
916 cond_isProduct _ _ rep_tc
917 | Just _ <- tyConSingleDataCon_maybe rep_tc
918 = IsValid
919 | otherwise
920 = NotValid $ DerivErrMustHaveExactlyOneConstructor rep_tc
921
922 cond_functorOK :: Bool -> Bool -> Condition
923 -- OK for Functor/Foldable/Traversable class
924 -- Currently: (a) at least one argument
925 -- (b) don't use argument contravariantly
926 -- (c) don't use argument in the wrong place, e.g. data T a = T (X a a)
927 -- (d) optionally: don't use function types
928 -- (e) no "stupid context" on data type
929 cond_functorOK allowFunctions allowExQuantifiedLastTyVar _ _ rep_tc
930 | null tc_tvs
931 = NotValid $ DerivErrMustHaveSomeParameters rep_tc
932
933 | not (null bad_stupid_theta)
934 = NotValid $ DerivErrMustNotHaveClassContext rep_tc bad_stupid_theta
935
936 | otherwise
937 = allValid (map check_con data_cons)
938 where
939 tc_tvs = tyConTyVars rep_tc
940 last_tv = last tc_tvs
941 bad_stupid_theta = filter is_bad (tyConStupidTheta rep_tc)
942 is_bad pred = last_tv `elemVarSet` exactTyCoVarsOfType pred
943 -- See Note [Check that the type variable is truly universal]
944
945 data_cons = tyConDataCons rep_tc
946 check_con con = allValid (check_universal con : foldDataConArgs (ft_check con) con)
947
948 check_universal :: DataCon -> Validity' DeriveInstanceErrReason
949 check_universal con
950 | allowExQuantifiedLastTyVar
951 = IsValid -- See Note [DeriveFoldable with ExistentialQuantification]
952 -- in GHC.Tc.Deriv.Functor
953 | Just tv <- getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con)))
954 , tv `elem` dataConUnivTyVars con
955 , not (tv `elemVarSet` exactTyCoVarsOfTypes (dataConTheta con))
956 = IsValid -- See Note [Check that the type variable is truly universal]
957 | otherwise
958 = NotValid $ DerivErrBadConstructor Nothing [DerivErrBadConExistential con]
959
960 ft_check :: DataCon -> FFoldType (Validity' DeriveInstanceErrReason)
961 ft_check con = FT { ft_triv = IsValid, ft_var = IsValid
962 , ft_co_var = NotValid $ DerivErrBadConstructor Nothing [DerivErrBadConCovariant con]
963 , ft_fun = \x y -> if allowFunctions then x `andValid` y
964 else NotValid $ DerivErrBadConstructor Nothing [DerivErrBadConFunTypes con]
965 , ft_tup = \_ xs -> allValid xs
966 , ft_ty_app = \_ _ x -> x
967 , ft_bad_app = NotValid $ DerivErrBadConstructor Nothing [DerivErrBadConWrongArg con]
968 , ft_forall = \_ x -> x }
969
970
971 checkFlag :: LangExt.Extension -> Condition
972 checkFlag flag dflags _ _
973 | xopt flag dflags = IsValid
974 | otherwise = NotValid why
975 where
976 why = DerivErrLangExtRequired the_flag
977 the_flag = case [ flagSpecFlag f | f <- xFlags , flagSpecFlag f == flag ] of
978 [s] -> s
979 other -> pprPanic "checkFlag" (ppr other)
980
981 std_class_via_coercible :: Class -> Bool
982 -- These standard classes can be derived for a newtype
983 -- using the coercible trick *even if no -XGeneralizedNewtypeDeriving
984 -- because giving so gives the same results as generating the boilerplate
985 std_class_via_coercible clas
986 = classKey clas `elem` [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]
987 -- Not Read/Show because they respect the type
988 -- Not Enum, because newtypes are never in Enum
989
990
991 non_coercible_class :: Class -> Bool
992 -- *Never* derive Read, Show, Typeable, Data, Generic, Generic1, Lift
993 -- by Coercible, even with -XGeneralizedNewtypeDeriving
994 -- Also, avoid Traversable, as the Coercible-derived instance and the "normal"-derived
995 -- instance behave differently if there's a non-lawful Applicative out there.
996 -- Besides, with roles, Coercible-deriving Traversable is ill-roled.
997 non_coercible_class cls
998 = classKey cls `elem` ([ readClassKey, showClassKey, dataClassKey
999 , genClassKey, gen1ClassKey, typeableClassKey
1000 , traversableClassKey, liftClassKey ])
1001
1002 ------------------------------------------------------------------
1003
1004 newDerivClsInst :: ThetaType -> DerivSpec theta -> TcM ClsInst
1005 newDerivClsInst theta (DS { ds_name = dfun_name, ds_overlap = overlap_mode
1006 , ds_tvs = tvs, ds_cls = clas, ds_tys = tys })
1007 = newClsInst overlap_mode dfun_name tvs theta clas tys
1008
1009 extendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
1010 -- Add new locally-defined instances; don't bother to check
1011 -- for functional dependency errors -- that'll happen in GHC.Tc.TyCl.Instance
1012 extendLocalInstEnv dfuns thing_inside
1013 = do { env <- getGblEnv
1014 ; let inst_env' = extendInstEnvList (tcg_inst_env env) dfuns
1015 env' = env { tcg_inst_env = inst_env' }
1016 ; setGblEnv env' thing_inside }
1017
1018 {-
1019 Note [Deriving any class]
1020 ~~~~~~~~~~~~~~~~~~~~~~~~~
1021 Classic uses of a deriving clause, or a standalone-deriving declaration, are
1022 for:
1023 * a stock class like Eq or Show, for which GHC knows how to generate
1024 the instance code
1025 * a newtype, via the mechanism enabled by GeneralizedNewtypeDeriving
1026
1027 The DeriveAnyClass extension adds a third way to derive instances, based on
1028 empty instance declarations.
1029
1030 The canonical use case is in combination with GHC.Generics and default method
1031 signatures. These allow us to have instance declarations being empty, but still
1032 useful, e.g.
1033
1034 data T a = ...blah..blah... deriving( Generic )
1035 instance C a => C (T a) -- No 'where' clause
1036
1037 where C is some "random" user-defined class.
1038
1039 This boilerplate code can be replaced by the more compact
1040
1041 data T a = ...blah..blah... deriving( Generic, C )
1042
1043 if DeriveAnyClass is enabled.
1044
1045 This is not restricted to Generics; any class can be derived, simply giving
1046 rise to an empty instance.
1047
1048 See Note [Gathering and simplifying constraints for DeriveAnyClass] in
1049 GHC.Tc.Deriv.Infer for an explanation hof how the instance context is inferred for
1050 DeriveAnyClass.
1051
1052 Note [Check that the type variable is truly universal]
1053 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1054 For Functor and Traversable instances, we must check that the *last argument*
1055 of the type constructor is used truly universally quantified. Example
1056
1057 data T a b where
1058 T1 :: a -> b -> T a b -- Fine! Vanilla H-98
1059 T2 :: b -> c -> T a b -- Fine! Existential c, but we can still map over 'b'
1060 T3 :: b -> T Int b -- Fine! Constraint 'a', but 'b' is still polymorphic
1061 T4 :: Ord b => b -> T a b -- No! 'b' is constrained
1062 T5 :: b -> T b b -- No! 'b' is constrained
1063 T6 :: T a (b,b) -- No! 'b' is constrained
1064
1065 Notice that only the first of these constructors is vanilla H-98. We only
1066 need to take care about the last argument (b in this case). See #8678.
1067 Eg. for T1-T3 we can write
1068
1069 fmap f (T1 a b) = T1 a (f b)
1070 fmap f (T2 b c) = T2 (f b) c
1071 fmap f (T3 x) = T3 (f x)
1072
1073 We need not perform these checks for Foldable instances, however, since
1074 functions in Foldable can only consume existentially quantified type variables,
1075 rather than produce them (as is the case in Functor and Traversable functions.)
1076 As a result, T can have a derived Foldable instance:
1077
1078 foldr f z (T1 a b) = f b z
1079 foldr f z (T2 b c) = f b z
1080 foldr f z (T3 x) = f x z
1081 foldr f z (T4 x) = f x z
1082 foldr f z (T5 x) = f x z
1083 foldr _ z T6 = z
1084
1085 See Note [DeriveFoldable with ExistentialQuantification] in GHC.Tc.Deriv.Functor.
1086
1087 For Functor and Traversable, we must take care not to let type synonyms
1088 unfairly reject a type for not being truly universally quantified. An
1089 example of this is:
1090
1091 type C (a :: Constraint) b = a
1092 data T a b = C (Show a) b => MkT b
1093
1094 Here, the existential context (C (Show a) b) does technically mention the last
1095 type variable b. But this is OK, because expanding the type synonym C would give
1096 us the context (Show a), which doesn't mention b. Therefore, we must make sure
1097 to expand type synonyms before performing this check. Not doing so led to #13813.
1098 -}