Disallow standalone deriving declarations involving unboxed tuples or sums
[ghc.git] / compiler / typecheck / TcDeriv.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 Handles @deriving@ clauses on @data@ declarations.
7 -}
8
9 {-# LANGUAGE CPP #-}
10 {-# LANGUAGE ImplicitParams #-}
11
12 module TcDeriv ( tcDeriving, DerivInfo(..), mkDerivInfos ) where
13
14 #include "HsVersions.h"
15
16 import HsSyn
17 import DynFlags
18
19 import TcRnMonad
20 import FamInst
21 import TcErrors( reportAllUnsolved )
22 import TcValidity( validDerivPred, allDistinctTyVars )
23 import TcClassDcl( tcATDefault, tcMkDeclCtxt )
24 import TcEnv
25 import TcGenDeriv -- Deriv stuff
26 import TcGenGenerics
27 import InstEnv
28 import Inst
29 import FamInstEnv
30 import TcHsType
31 import TcMType
32 import TcSimplify
33 import TcUnify( buildImplicationFor )
34
35 import RnNames( extendGlobalRdrEnvRn )
36 import RnBinds
37 import RnEnv
38 import RnSource ( addTcgDUs )
39 import Avail
40
41 import Unify( tcUnifyTy )
42 import BasicTypes ( DerivStrategy(..) )
43 import Class
44 import Type
45 import ErrUtils
46 import DataCon
47 import Maybes
48 import RdrName
49 import Name
50 import NameSet
51 import TyCon
52 import TcType
53 import Var
54 import VarEnv
55 import VarSet
56 import PrelNames
57 import THNames ( liftClassKey )
58 import SrcLoc
59 import Util
60 import Outputable
61 import FastString
62 import Bag
63 import Pair
64 import FV (fvVarList, unionFV, mkFVs)
65 import qualified GHC.LanguageExtensions as LangExt
66
67 import Control.Monad
68 import Data.List
69
70 {-
71 ************************************************************************
72 * *
73 Overview
74 * *
75 ************************************************************************
76
77 Overall plan
78 ~~~~~~~~~~~~
79 1. Convert the decls (i.e. data/newtype deriving clauses,
80 plus standalone deriving) to [EarlyDerivSpec]
81
82 2. Infer the missing contexts for the InferTheta's
83
84 3. Add the derived bindings, generating InstInfos
85 -}
86
87 -- DerivSpec is purely local to this module
88 data DerivSpec theta = DS { ds_loc :: SrcSpan
89 , ds_name :: Name -- DFun name
90 , ds_tvs :: [TyVar]
91 , ds_theta :: theta
92 , ds_cls :: Class
93 , ds_tys :: [Type]
94 , ds_tc :: TyCon
95 , ds_overlap :: Maybe OverlapMode
96 , ds_mechanism :: DerivSpecMechanism }
97 -- This spec implies a dfun declaration of the form
98 -- df :: forall tvs. theta => C tys
99 -- The Name is the name for the DFun we'll build
100 -- The tyvars bind all the variables in the theta
101 -- For type families, the tycon in
102 -- in ds_tys is the *family* tycon
103 -- in ds_tc is the *representation* type
104 -- For non-family tycons, both are the same
105
106 -- the theta is either the given and final theta, in standalone deriving,
107 -- or the not-yet-simplified list of constraints together with their origin
108
109 -- ds_mechanism specifies the means by which GHC derives the instance.
110 -- See Note [Deriving strategies]
111
112 {-
113 Example:
114
115 newtype instance T [a] = MkT (Tree a) deriving( C s )
116 ==>
117 axiom T [a] = :RTList a
118 axiom :RTList a = Tree a
119
120 DS { ds_tvs = [a,s], ds_cls = C, ds_tys = [s, T [a]]
121 , ds_tc = :RTList, ds_mechanism = DerivSpecNewtype (Tree a) }
122 -}
123
124 -- What action to take in order to derive a class instance.
125 -- See Note [Deriving strategies]
126 -- NB: DerivSpecMechanism is purely local to this module
127 data DerivSpecMechanism
128 = DerivSpecStock -- "Standard" classes (except for Generic(1), which is
129 -- covered by the special case of DerivSpecGeneric)
130 (SrcSpan -> TyCon -> TcM (LHsBinds RdrName, BagDerivStuff))
131
132 | DerivSpecGeneric -- -XDeriveGeneric
133 (TyCon -> [Type] -> TcM (LHsBinds RdrName, FamInst))
134
135 | DerivSpecNewtype -- -XGeneralizedNewtypeDeriving
136 Type -- ^ The newtype rep type
137
138 | DerivSpecAnyClass -- -XDeriveAnyClass
139
140 type DerivContext = Maybe ThetaType
141 -- Nothing <=> Vanilla deriving; infer the context of the instance decl
142 -- Just theta <=> Standalone deriving: context supplied by programmer
143
144 -- | A 'PredType' annotated with the origin of the constraint 'CtOrigin',
145 -- and whether or the constraint deals in types or kinds.
146 data PredOrigin = PredOrigin PredType CtOrigin TypeOrKind
147 type ThetaOrigin = [PredOrigin]
148
149 mkPredOrigin :: CtOrigin -> TypeOrKind -> PredType -> PredOrigin
150 mkPredOrigin origin t_or_k pred = PredOrigin pred origin t_or_k
151
152 mkThetaOrigin :: CtOrigin -> TypeOrKind -> ThetaType -> ThetaOrigin
153 mkThetaOrigin origin t_or_k = map (mkPredOrigin origin t_or_k)
154
155 substPredOrigin :: HasCallStack => TCvSubst -> PredOrigin -> PredOrigin
156 substPredOrigin subst (PredOrigin pred origin t_or_k)
157 = PredOrigin (substTy subst pred) origin t_or_k
158
159 substThetaOrigin :: HasCallStack => TCvSubst -> ThetaOrigin -> ThetaOrigin
160 substThetaOrigin subst = map (substPredOrigin subst)
161
162 data EarlyDerivSpec = InferTheta (DerivSpec ThetaOrigin)
163 | GivenTheta (DerivSpec ThetaType)
164 -- InferTheta ds => the context for the instance should be inferred
165 -- In this case ds_theta is the list of all the constraints
166 -- needed, such as (Eq [a], Eq a), together with a suitable CtLoc
167 -- to get good error messages.
168 -- The inference process is to reduce this to a
169 -- simpler form (e.g. Eq a)
170 --
171 -- GivenTheta ds => the exact context for the instance is supplied
172 -- by the programmer; it is ds_theta
173 -- See Note [Inferring the instance context]
174
175 earlyDSLoc :: EarlyDerivSpec -> SrcSpan
176 earlyDSLoc (InferTheta spec) = ds_loc spec
177 earlyDSLoc (GivenTheta spec) = ds_loc spec
178
179 splitEarlyDerivSpec :: [EarlyDerivSpec] -> ([DerivSpec ThetaOrigin], [DerivSpec ThetaType])
180 splitEarlyDerivSpec [] = ([],[])
181 splitEarlyDerivSpec (InferTheta spec : specs) =
182 case splitEarlyDerivSpec specs of (is, gs) -> (spec : is, gs)
183 splitEarlyDerivSpec (GivenTheta spec : specs) =
184 case splitEarlyDerivSpec specs of (is, gs) -> (is, spec : gs)
185
186 pprDerivSpec :: Outputable theta => DerivSpec theta -> SDoc
187 pprDerivSpec (DS { ds_loc = l, ds_name = n, ds_tvs = tvs,
188 ds_cls = c, ds_tys = tys, ds_theta = rhs })
189 = hang (text "DerivSpec")
190 2 (vcat [ text "ds_loc =" <+> ppr l
191 , text "ds_name =" <+> ppr n
192 , text "ds_tvs =" <+> ppr tvs
193 , text "ds_cls =" <+> ppr c
194 , text "ds_tys =" <+> ppr tys
195 , text "ds_theta =" <+> ppr rhs ])
196
197 instance Outputable theta => Outputable (DerivSpec theta) where
198 ppr = pprDerivSpec
199
200 instance Outputable EarlyDerivSpec where
201 ppr (InferTheta spec) = ppr spec <+> text "(Infer)"
202 ppr (GivenTheta spec) = ppr spec <+> text "(Given)"
203
204 instance Outputable PredOrigin where
205 ppr (PredOrigin ty _ _) = ppr ty -- The origin is not so interesting when debugging
206
207 {- Note [Inferring the instance context]
208 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
209 There are two sorts of 'deriving':
210
211 * InferTheta: the deriving clause for a data type
212 data T a = T1 a deriving( Eq )
213 Here we must infer an instance context,
214 and generate instance declaration
215 instance Eq a => Eq (T a) where ...
216
217 * CheckTheta: standalone deriving
218 deriving instance Eq a => Eq (T a)
219 Here we only need to fill in the bindings;
220 the instance context is user-supplied
221
222 For a deriving clause (InferTheta) we must figure out the
223 instance context (inferConstraints). Suppose we are inferring
224 the instance context for
225 C t1 .. tn (T s1 .. sm)
226 There are two cases
227
228 * (T s1 .. sm) :: * (the normal case)
229 Then we behave like Eq and guess (C t1 .. tn t)
230 for each data constructor arg of type t. More
231 details below.
232
233 * (T s1 .. sm) :: * -> * (the functor-like case)
234 Then we behave like Functor.
235
236 In both cases we produce a bunch of un-simplified constraints
237 and them simplify them in simplifyInstanceContexts; see
238 Note [Simplifying the instance context].
239
240 In the functor-like case, we may need to unify some kind variables with * in
241 order for the generated instance to be well-kinded. An example from
242 Trac #10524:
243
244 newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1)
245 = Compose (f (g a)) deriving Functor
246
247 Earlier in the deriving pipeline, GHC unifies the kind of Compose f g
248 (k1 -> *) with the kind of Functor's argument (* -> *), so k1 := *. But this
249 alone isn't enough, since k2 wasn't unified with *:
250
251 instance (Functor (f :: k2 -> *), Functor (g :: * -> k2)) =>
252 Functor (Compose f g) where ...
253
254 The two Functor constraints are ill-kinded. To ensure this doesn't happen, we:
255
256 1. Collect all of a datatype's subtypes which require functor-like
257 constraints.
258 2. For each subtype, create a substitution by unifying the subtype's kind
259 with (* -> *).
260 3. Compose all the substitutions into one, then apply that substitution to
261 all of the in-scope type variables and the instance types.
262
263 Note [Data decl contexts]
264 ~~~~~~~~~~~~~~~~~~~~~~~~~
265 Consider
266
267 data (RealFloat a) => Complex a = !a :+ !a deriving( Read )
268
269 We will need an instance decl like:
270
271 instance (Read a, RealFloat a) => Read (Complex a) where
272 ...
273
274 The RealFloat in the context is because the read method for Complex is bound
275 to construct a Complex, and doing that requires that the argument type is
276 in RealFloat.
277
278 But this ain't true for Show, Eq, Ord, etc, since they don't construct
279 a Complex; they only take them apart.
280
281 Our approach: identify the offending classes, and add the data type
282 context to the instance decl. The "offending classes" are
283
284 Read, Enum?
285
286 FURTHER NOTE ADDED March 2002. In fact, Haskell98 now requires that
287 pattern matching against a constructor from a data type with a context
288 gives rise to the constraints for that context -- or at least the thinned
289 version. So now all classes are "offending".
290
291 Note [Newtype deriving]
292 ~~~~~~~~~~~~~~~~~~~~~~~
293 Consider this:
294 class C a b
295 instance C [a] Char
296 newtype T = T Char deriving( C [a] )
297
298 Notice the free 'a' in the deriving. We have to fill this out to
299 newtype T = T Char deriving( forall a. C [a] )
300
301 And then translate it to:
302 instance C [a] Char => C [a] T where ...
303
304
305 Note [Newtype deriving superclasses]
306 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
307 (See also Trac #1220 for an interesting exchange on newtype
308 deriving and superclasses.)
309
310 The 'tys' here come from the partial application in the deriving
311 clause. The last arg is the new instance type.
312
313 We must pass the superclasses; the newtype might be an instance
314 of them in a different way than the representation type
315 E.g. newtype Foo a = Foo a deriving( Show, Num, Eq )
316 Then the Show instance is not done via Coercible; it shows
317 Foo 3 as "Foo 3"
318 The Num instance is derived via Coercible, but the Show superclass
319 dictionary must the Show instance for Foo, *not* the Show dictionary
320 gotten from the Num dictionary. So we must build a whole new dictionary
321 not just use the Num one. The instance we want is something like:
322 instance (Num a, Show (Foo a), Eq (Foo a)) => Num (Foo a) where
323 (+) = ((+)@a)
324 ...etc...
325 There may be a coercion needed which we get from the tycon for the newtype
326 when the dict is constructed in TcInstDcls.tcInstDecl2
327
328
329 Note [Unused constructors and deriving clauses]
330 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
331 See Trac #3221. Consider
332 data T = T1 | T2 deriving( Show )
333 Are T1 and T2 unused? Well, no: the deriving clause expands to mention
334 both of them. So we gather defs/uses from deriving just like anything else.
335
336 -}
337
338 -- | Stuff needed to process a datatype's `deriving` clauses
339 data DerivInfo = DerivInfo { di_rep_tc :: TyCon
340 -- ^ The data tycon for normal datatypes,
341 -- or the *representation* tycon for data families
342 , di_clauses :: [LHsDerivingClause Name]
343 , di_ctxt :: SDoc -- ^ error context
344 }
345
346 -- | Extract `deriving` clauses of proper data type (skips data families)
347 mkDerivInfos :: [LTyClDecl Name] -> TcM [DerivInfo]
348 mkDerivInfos decls = concatMapM (mk_deriv . unLoc) decls
349 where
350
351 mk_deriv decl@(DataDecl { tcdLName = L _ data_name
352 , tcdDataDefn =
353 HsDataDefn { dd_derivs = L _ clauses } })
354 = do { tycon <- tcLookupTyCon data_name
355 ; return [DerivInfo { di_rep_tc = tycon, di_clauses = clauses
356 , di_ctxt = tcMkDeclCtxt decl }] }
357 mk_deriv _ = return []
358
359 {-
360
361 ************************************************************************
362 * *
363 \subsection[TcDeriv-driver]{Top-level function for \tr{derivings}}
364 * *
365 ************************************************************************
366 -}
367
368 tcDeriving :: [DerivInfo] -- All `deriving` clauses
369 -> [LDerivDecl Name] -- All stand-alone deriving declarations
370 -> TcM (TcGblEnv, Bag (InstInfo Name), HsValBinds Name)
371 tcDeriving deriv_infos deriv_decls
372 = recoverM (do { g <- getGblEnv
373 ; return (g, emptyBag, emptyValBindsOut)}) $
374 do { -- Fish the "deriving"-related information out of the TcEnv
375 -- And make the necessary "equations".
376 is_boot <- tcIsHsBootOrSig
377 ; traceTc "tcDeriving" (ppr is_boot)
378
379 ; early_specs <- makeDerivSpecs is_boot deriv_infos deriv_decls
380 ; traceTc "tcDeriving 1" (ppr early_specs)
381
382 ; let (infer_specs, given_specs) = splitEarlyDerivSpec early_specs
383 ; insts1 <- mapM genInst given_specs
384
385 -- the stand-alone derived instances (@insts1@) are used when inferring
386 -- the contexts for "deriving" clauses' instances (@infer_specs@)
387 ; final_specs <- extendLocalInstEnv (map (iSpec . fstOf3) insts1) $
388 simplifyInstanceContexts infer_specs
389
390 ; insts2 <- mapM genInst final_specs
391
392 ; let (inst_infos, deriv_stuff, maybe_fvs) = unzip3 (insts1 ++ insts2)
393 ; loc <- getSrcSpanM
394 ; let (binds, famInsts) = genAuxBinds loc (unionManyBags deriv_stuff)
395
396 ; dflags <- getDynFlags
397
398 ; (inst_info, rn_binds, rn_dus) <-
399 renameDeriv is_boot inst_infos binds
400
401 ; unless (isEmptyBag inst_info) $
402 liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances"
403 (ddump_deriving inst_info rn_binds famInsts))
404
405 ; gbl_env <- tcExtendLocalFamInstEnv (bagToList famInsts) $
406 tcExtendLocalInstEnv (map iSpec (bagToList inst_info)) getGblEnv
407 ; let all_dus = rn_dus `plusDU` usesOnly (NameSet.mkFVs $ catMaybes maybe_fvs)
408 ; return (addTcgDUs gbl_env all_dus, inst_info, rn_binds) }
409 where
410 ddump_deriving :: Bag (InstInfo Name) -> HsValBinds Name
411 -> Bag FamInst -- ^ Rep type family instances
412 -> SDoc
413 ddump_deriving inst_infos extra_binds repFamInsts
414 = hang (text "Derived instances:")
415 2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") (bagToList inst_infos))
416 $$ ppr extra_binds)
417 $$ hangP "GHC.Generics representation types:"
418 (vcat (map pprRepTy (bagToList repFamInsts)))
419
420 hangP s x = text "" $$ hang (ptext (sLit s)) 2 x
421
422 -- Prints the representable type family instance
423 pprRepTy :: FamInst -> SDoc
424 pprRepTy fi@(FamInst { fi_tys = lhs })
425 = text "type" <+> ppr (mkTyConApp (famInstTyCon fi) lhs) <+>
426 equals <+> ppr rhs
427 where rhs = famInstRHS fi
428
429 renameDeriv :: Bool
430 -> [InstInfo RdrName]
431 -> Bag (LHsBind RdrName, LSig RdrName)
432 -> TcM (Bag (InstInfo Name), HsValBinds Name, DefUses)
433 renameDeriv is_boot inst_infos bagBinds
434 | is_boot -- If we are compiling a hs-boot file, don't generate any derived bindings
435 -- The inst-info bindings will all be empty, but it's easier to
436 -- just use rn_inst_info to change the type appropriately
437 = do { (rn_inst_infos, fvs) <- mapAndUnzipM rn_inst_info inst_infos
438 ; return ( listToBag rn_inst_infos
439 , emptyValBindsOut, usesOnly (plusFVs fvs)) }
440
441 | otherwise
442 = discardWarnings $ -- Discard warnings about unused bindings etc
443 setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have
444 -- case x of {}
445 setXOptM LangExt.ScopedTypeVariables $ -- Derived decls (for newtype-deriving) can
446 setXOptM LangExt.KindSignatures $ -- used ScopedTypeVariables & KindSignatures
447 do {
448 -- Bring the extra deriving stuff into scope
449 -- before renaming the instances themselves
450 ; traceTc "rnd" (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos))
451 ; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds
452 ; let aux_val_binds = ValBindsIn aux_binds (bagToList aux_sigs)
453 ; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
454 ; let bndrs = collectHsValBinders rn_aux_lhs
455 ; envs <- extendGlobalRdrEnvRn (map avail bndrs) emptyFsEnv ;
456 ; setEnvs envs $
457 do { (rn_aux, dus_aux) <- rnValBindsRHS (TopSigCtxt (mkNameSet bndrs)) rn_aux_lhs
458 ; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
459 ; return (listToBag rn_inst_infos, rn_aux,
460 dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
461
462 where
463 rn_inst_info :: InstInfo RdrName -> TcM (InstInfo Name, FreeVars)
464 rn_inst_info
465 inst_info@(InstInfo { iSpec = inst
466 , iBinds = InstBindings
467 { ib_binds = binds
468 , ib_tyvars = tyvars
469 , ib_pragmas = sigs
470 , ib_extensions = exts -- Only for type-checking
471 , ib_derived = sa } })
472 = ASSERT( null sigs )
473 bindLocalNamesFV tyvars $
474 do { (rn_binds,_, fvs) <- rnMethodBinds False (is_cls_nm inst) [] binds []
475 ; let binds' = InstBindings { ib_binds = rn_binds
476 , ib_tyvars = tyvars
477 , ib_pragmas = []
478 , ib_extensions = exts
479 , ib_derived = sa }
480 ; return (inst_info { iBinds = binds' }, fvs) }
481
482 {-
483 Note [Newtype deriving and unused constructors]
484 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
485 Consider this (see Trac #1954):
486
487 module Bug(P) where
488 newtype P a = MkP (IO a) deriving Monad
489
490 If you compile with -Wunused-binds you do not expect the warning
491 "Defined but not used: data consructor MkP". Yet the newtype deriving
492 code does not explicitly mention MkP, but it should behave as if you
493 had written
494 instance Monad P where
495 return x = MkP (return x)
496 ...etc...
497
498 So we want to signal a user of the data constructor 'MkP'.
499 This is the reason behind the (Maybe Name) part of the return type
500 of genInst.
501
502 Note [Why we don't pass rep_tc into deriveTyData]
503 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
504 Down in the bowels of mkEqnHelp, we need to convert the fam_tc back into
505 the rep_tc by means of a lookup. And yet we have the rep_tc right here!
506 Why look it up again? Answer: it's just easier this way.
507 We drop some number of arguments from the end of the datatype definition
508 in deriveTyData. The arguments are dropped from the fam_tc.
509 This action may drop a *different* number of arguments
510 passed to the rep_tc, depending on how many free variables, etc., the
511 dropped patterns have.
512
513 Also, this technique carries over the kind substitution from deriveTyData
514 nicely.
515
516 ************************************************************************
517 * *
518 From HsSyn to DerivSpec
519 * *
520 ************************************************************************
521
522 @makeDerivSpecs@ fishes around to find the info about needed derived instances.
523 -}
524
525 makeDerivSpecs :: Bool
526 -> [DerivInfo]
527 -> [LDerivDecl Name]
528 -> TcM [EarlyDerivSpec]
529 makeDerivSpecs is_boot deriv_infos deriv_decls
530 = do { eqns1 <- concatMapM (recoverM (return []) . deriveDerivInfo) deriv_infos
531 ; eqns2 <- concatMapM (recoverM (return []) . deriveStandalone) deriv_decls
532 ; let eqns = eqns1 ++ eqns2
533
534 ; if is_boot then -- No 'deriving' at all in hs-boot files
535 do { unless (null eqns) (add_deriv_err (head eqns))
536 ; return [] }
537 else return eqns }
538 where
539 add_deriv_err eqn
540 = setSrcSpan (earlyDSLoc eqn) $
541 addErr (hang (text "Deriving not permitted in hs-boot file")
542 2 (text "Use an instance declaration instead"))
543
544 ------------------------------------------------------------------
545 -- | Process a `deriving` clause
546 deriveDerivInfo :: DerivInfo -> TcM [EarlyDerivSpec]
547 deriveDerivInfo (DerivInfo { di_rep_tc = rep_tc, di_clauses = clauses
548 , di_ctxt = err_ctxt })
549 = addErrCtxt err_ctxt $
550 concatMapM (deriveForClause . unLoc) clauses
551 where
552 tvs = tyConTyVars rep_tc
553 (tc, tys) = case tyConFamInstSig_maybe rep_tc of
554 -- data family:
555 Just (fam_tc, pats, _) -> (fam_tc, pats)
556 -- NB: deriveTyData wants the *user-specified*
557 -- name. See Note [Why we don't pass rep_tc into deriveTyData]
558
559 _ -> (rep_tc, mkTyVarTys tvs) -- datatype
560
561 deriveForClause :: HsDerivingClause Name -> TcM [EarlyDerivSpec]
562 deriveForClause (HsDerivingClause { deriv_clause_strategy = dcs
563 , deriv_clause_tys = L _ preds })
564 = concatMapM (deriveTyData tvs tc tys (fmap unLoc dcs)) preds
565
566 ------------------------------------------------------------------
567 deriveStandalone :: LDerivDecl Name -> TcM [EarlyDerivSpec]
568 -- Standalone deriving declarations
569 -- e.g. deriving instance Show a => Show (T a)
570 -- Rather like tcLocalInstDecl
571 deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode))
572 = setSrcSpan loc $
573 addErrCtxt (standaloneCtxt deriv_ty) $
574 do { traceTc "Standalone deriving decl for" (ppr deriv_ty)
575 ; let deriv_strat = fmap unLoc deriv_strat'
576 ; traceTc "Deriving strategy (standalone deriving)" $
577 vcat [ppr deriv_strat, ppr deriv_ty]
578 ; (tvs, theta, cls, inst_tys) <- tcHsClsInstType TcType.InstDeclCtxt deriv_ty
579 ; traceTc "Standalone deriving;" $ vcat
580 [ text "tvs:" <+> ppr tvs
581 , text "theta:" <+> ppr theta
582 , text "cls:" <+> ppr cls
583 , text "tys:" <+> ppr inst_tys ]
584 -- C.f. TcInstDcls.tcLocalInstDecl1
585 ; checkTc (not (null inst_tys)) derivingNullaryErr
586
587 ; let cls_tys = take (length inst_tys - 1) inst_tys
588 inst_ty = last inst_tys
589 ; traceTc "Standalone deriving:" $ vcat
590 [ text "class:" <+> ppr cls
591 , text "class types:" <+> ppr cls_tys
592 , text "type:" <+> ppr inst_ty ]
593
594 ; let bale_out msg = failWithTc (derivingThingErr False cls cls_tys
595 inst_ty deriv_strat msg)
596
597 ; case tcSplitTyConApp_maybe inst_ty of
598 Just (tc, tc_args)
599 | className cls == typeableClassName
600 -> do warnUselessTypeable
601 return []
602
603 | isUnboxedTupleTyCon tc
604 -> bale_out $ unboxedTyConErr "tuple"
605
606 | isUnboxedSumTyCon tc
607 -> bale_out $ unboxedTyConErr "sum"
608
609 | isAlgTyCon tc || isDataFamilyTyCon tc -- All other classes
610 -> do { spec <- mkEqnHelp (fmap unLoc overlap_mode)
611 tvs cls cls_tys tc tc_args
612 (Just theta) deriv_strat
613 ; return [spec] }
614
615 _ -> -- Complain about functions, primitive types, etc,
616 bale_out $
617 text "The last argument of the instance must be a data or newtype application"
618 }
619
620 warnUselessTypeable :: TcM ()
621 warnUselessTypeable
622 = do { warn <- woptM Opt_WarnDerivingTypeable
623 ; when warn $ addWarnTc (Reason Opt_WarnDerivingTypeable)
624 $ text "Deriving" <+> quotes (ppr typeableClassName) <+>
625 text "has no effect: all types now auto-derive Typeable" }
626
627 ------------------------------------------------------------------
628 deriveTyData :: [TyVar] -> TyCon -> [Type] -- LHS of data or data instance
629 -- Can be a data instance, hence [Type] args
630 -> Maybe DerivStrategy -- The optional deriving strategy
631 -> LHsSigType Name -- The deriving predicate
632 -> TcM [EarlyDerivSpec]
633 -- The deriving clause of a data or newtype declaration
634 -- I.e. not standalone deriving
635 deriveTyData tvs tc tc_args deriv_strat deriv_pred
636 = setSrcSpan (getLoc (hsSigType deriv_pred)) $ -- Use loc of the 'deriving' item
637 do { (deriv_tvs, cls, cls_tys, cls_arg_kinds)
638 <- tcExtendTyVarEnv tvs $
639 tcHsDeriv deriv_pred
640 -- Deriving preds may (now) mention
641 -- the type variables for the type constructor, hence tcExtendTyVarenv
642 -- The "deriv_pred" is a LHsType to take account of the fact that for
643 -- newtype deriving we allow deriving (forall a. C [a]).
644
645 -- Typeable is special, because Typeable :: forall k. k -> Constraint
646 -- so the argument kind 'k' is not decomposable by splitKindFunTys
647 -- as is the case for all other derivable type classes
648 ; when (length cls_arg_kinds /= 1) $
649 failWithTc (nonUnaryErr deriv_pred)
650 ; let [cls_arg_kind] = cls_arg_kinds
651 ; if className cls == typeableClassName
652 then do warnUselessTypeable
653 return []
654 else
655
656 do { -- Given data T a b c = ... deriving( C d ),
657 -- we want to drop type variables from T so that (C d (T a)) is well-kinded
658 let (arg_kinds, _) = splitFunTys cls_arg_kind
659 n_args_to_drop = length arg_kinds
660 n_args_to_keep = tyConArity tc - n_args_to_drop
661 (tc_args_to_keep, args_to_drop)
662 = splitAt n_args_to_keep tc_args
663 inst_ty_kind = typeKind (mkTyConApp tc tc_args_to_keep)
664
665 -- Match up the kinds, and apply the resulting kind substitution
666 -- to the types. See Note [Unify kinds in deriving]
667 -- We are assuming the tycon tyvars and the class tyvars are distinct
668 mb_match = tcUnifyTy inst_ty_kind cls_arg_kind
669 enough_args = n_args_to_keep >= 0
670
671 -- Check that the result really is well-kinded
672 ; checkTc (enough_args && isJust mb_match)
673 (derivingKindErr tc cls cls_tys cls_arg_kind enough_args)
674
675 ; let Just kind_subst = mb_match
676 ki_subst_range = getTCvSubstRangeFVs kind_subst
677 all_tkvs = toposortTyVars $
678 fvVarList $ unionFV
679 (tyCoFVsOfTypes tc_args_to_keep)
680 (FV.mkFVs deriv_tvs)
681 -- See Note [Unification of two kind variables in deriving]
682 unmapped_tkvs = filter (\v -> v `notElemTCvSubst` kind_subst
683 && not (v `elemVarSet` ki_subst_range))
684 all_tkvs
685 (subst, _) = mapAccumL substTyVarBndr
686 kind_subst unmapped_tkvs
687 final_tc_args = substTys subst tc_args_to_keep
688 final_cls_tys = substTys subst cls_tys
689 tkvs = tyCoVarsOfTypesWellScoped $
690 final_cls_tys ++ final_tc_args
691
692 ; traceTc "Deriving strategy (deriving clause)" $
693 vcat [ppr deriv_strat, ppr deriv_pred]
694
695 ; traceTc "derivTyData1" (vcat [ pprTvBndrs tvs, ppr tc, ppr tc_args, ppr deriv_pred
696 , pprTvBndrs (tyCoVarsOfTypesList tc_args)
697 , ppr n_args_to_keep, ppr n_args_to_drop
698 , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
699 , ppr final_tc_args, ppr final_cls_tys ])
700
701 ; traceTc "derivTyData2" (vcat [ ppr tkvs ])
702
703 ; checkTc (allDistinctTyVars (mkVarSet tkvs) args_to_drop) -- (a, b, c)
704 (derivingEtaErr cls final_cls_tys (mkTyConApp tc final_tc_args))
705 -- Check that
706 -- (a) The args to drop are all type variables; eg reject:
707 -- data instance T a Int = .... deriving( Monad )
708 -- (b) The args to drop are all *distinct* type variables; eg reject:
709 -- class C (a :: * -> * -> *) where ...
710 -- data instance T a a = ... deriving( C )
711 -- (c) The type class args, or remaining tycon args,
712 -- do not mention any of the dropped type variables
713 -- newtype T a s = ... deriving( ST s )
714 -- newtype instance K a a = ... deriving( Monad )
715
716 ; spec <- mkEqnHelp Nothing tkvs
717 cls final_cls_tys tc final_tc_args
718 Nothing deriv_strat
719 ; traceTc "derivTyData" (ppr spec)
720 ; return [spec] } }
721
722
723 {-
724 Note [Unify kinds in deriving]
725 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
726 Consider (Trac #8534)
727 data T a b = MkT a deriving( Functor )
728 -- where Functor :: (*->*) -> Constraint
729
730 So T :: forall k. * -> k -> *. We want to get
731 instance Functor (T * (a:*)) where ...
732 Notice the '*' argument to T.
733
734 Moreover, as well as instantiating T's kind arguments, we may need to instantiate
735 C's kind args. Consider (Trac #8865):
736 newtype T a b = MkT (Either a b) deriving( Category )
737 where
738 Category :: forall k. (k -> k -> *) -> Constraint
739 We need to generate the instance
740 instance Category * (Either a) where ...
741 Notice the '*' argument to Category.
742
743 So we need to
744 * drop arguments from (T a b) to match the number of
745 arrows in the (last argument of the) class;
746 * and then *unify* kind of the remaining type against the
747 expected kind, to figure out how to instantiate C's and T's
748 kind arguments.
749
750 In the two examples,
751 * we unify kind-of( T k (a:k) ) ~ kind-of( Functor )
752 i.e. (k -> *) ~ (* -> *) to find k:=*.
753 yielding k:=*
754
755 * we unify kind-of( Either ) ~ kind-of( Category )
756 i.e. (* -> * -> *) ~ (k -> k -> k)
757 yielding k:=*
758
759 Now we get a kind substitution. We then need to:
760
761 1. Remove the substituted-out kind variables from the quantified kind vars
762
763 2. Apply the substitution to the kinds of quantified *type* vars
764 (and extend the substitution to reflect this change)
765
766 3. Apply that extended substitution to the non-dropped args (types and
767 kinds) of the type and class
768
769 Forgetting step (2) caused Trac #8893:
770 data V a = V [a] deriving Functor
771 data P (x::k->*) (a:k) = P (x a) deriving Functor
772 data C (x::k->*) (a:k) = C (V (P x a)) deriving Functor
773
774 When deriving Functor for P, we unify k to *, but we then want
775 an instance $df :: forall (x:*->*). Functor x => Functor (P * (x:*->*))
776 and similarly for C. Notice the modified kind of x, both at binding
777 and occurrence sites.
778
779 This can lead to some surprising results when *visible* kind binder is
780 unified (in contrast to the above examples, in which only non-visible kind
781 binders were considered). Consider this example from Trac #11732:
782
783 data T k (a :: k) = MkT deriving Functor
784
785 Since unification yields k:=*, this results in a generated instance of:
786
787 instance Functor (T *) where ...
788
789 which looks odd at first glance, since one might expect the instance head
790 to be of the form Functor (T k). Indeed, one could envision an alternative
791 generated instance of:
792
793 instance (k ~ *) => Functor (T k) where
794
795 But this does not typecheck as the result of a -XTypeInType design decision:
796 kind equalities are not allowed to be bound in types, only terms. But in
797 essence, the two instance declarations are entirely equivalent, since even
798 though (T k) matches any kind k, the only possibly value for k is *, since
799 anything else is ill-typed. As a result, we can just as comfortably use (T *).
800
801 Another way of thinking about is: deriving clauses often infer constraints.
802 For example:
803
804 data S a = S a deriving Eq
805
806 infers an (Eq a) constraint in the derived instance. By analogy, when we
807 are deriving Functor, we might infer an equality constraint (e.g., k ~ *).
808 The only distinction is that GHC instantiates equality constraints directly
809 during the deriving process.
810
811 Another quirk of this design choice manifests when typeclasses have visible
812 kind parameters. Consider this code (also from Trac #11732):
813
814 class Cat k (cat :: k -> k -> *) where
815 catId :: cat a a
816 catComp :: cat b c -> cat a b -> cat a c
817
818 instance Cat * (->) where
819 catId = id
820 catComp = (.)
821
822 newtype Fun a b = Fun (a -> b) deriving (Cat k)
823
824 Even though we requested an derived instance of the form (Cat k Fun), the
825 kind unification will actually generate (Cat * Fun) (i.e., the same thing as if
826 the user wrote deriving (Cat *)).
827
828 Note [Unification of two kind variables in deriving]
829 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
830 As a special case of the Note above, it is possible to derive an instance of
831 a poly-kinded typeclass for a poly-kinded datatype. For example:
832
833 class Category (cat :: k -> k -> *) where
834 newtype T (c :: k -> k -> *) a b = MkT (c a b) deriving Category
835
836 This case is suprisingly tricky. To see why, let's write out what instance GHC
837 will attempt to derive (using -fprint-explicit-kinds syntax):
838
839 instance Category k1 (T k2 c) where ...
840
841 GHC will attempt to unify k1 and k2, which produces a substitution (kind_subst)
842 that looks like [k2 :-> k1]. Importantly, we need to apply this substitution to
843 the type variable binder for c, since its kind is (k2 -> k2 -> *).
844
845 We used to accomplish this by doing the following:
846
847 unmapped_tkvs = filter (`notElemTCvSubst` kind_subst) all_tkvs
848 (subst, _) = mapAccumL substTyVarBndr kind_subst unmapped_tkvs
849
850 Where all_tkvs contains all kind variables in the class and instance types (in
851 this case, all_tkvs = [k1,k2]). But since kind_subst only has one mapping,
852 this results in unmapped_tkvs being [k1], and as a consequence, k1 gets mapped
853 to another kind variable in subst! That is, subst = [k2 :-> k1, k1 :-> k_new].
854 This is bad, because applying that substitution yields the following instance:
855
856 instance Category k_new (T k1 c) where ...
857
858 In other words, keeping k1 in unmapped_tvks taints the substitution, resulting
859 in an ill-kinded instance (this caused Trac #11837).
860
861 To prevent this, we need to filter out any variable from all_tkvs which either
862
863 1. Appears in the domain of kind_subst. notElemTCvSubst checks this.
864 2. Appears in the range of kind_subst. To do this, we compute the free
865 variable set of the range of kind_subst with getTCvSubstRangeFVs, and check
866 if a kind variable appears in that set.
867
868 Note [Eta-reducing type synonyms]
869 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
870 One can instantiate a type in a data family instance with a type synonym that
871 mentions other type variables:
872
873 type Const a b = a
874 data family Fam (f :: * -> *) (a :: *)
875 newtype instance Fam f (Const a f) = Fam (f a) deriving Functor
876
877 With -XTypeInType, it is also possible to define kind synonyms, and they can
878 mention other types in a datatype declaration. For example,
879
880 type Const a b = a
881 newtype T f (a :: Const * f) = T (f a) deriving Functor
882
883 When deriving, we need to perform eta-reduction analysis to ensure that none of
884 the eta-reduced type variables are mentioned elsewhere in the declaration. But
885 we need to be careful, because if we don't expand through the Const type
886 synonym, we will mistakenly believe that f is an eta-reduced type variable and
887 fail to derive Functor, even though the code above is correct (see Trac #11416,
888 where this was first noticed).
889
890 For this reason, we call exactTyCoVarsOfTypes on the eta-reduced types so that
891 we only consider the type variables that remain after expanding through type
892 synonyms.
893
894 -- Use exactTyCoVarsOfTypes, not tyCoVarsOfTypes, so that we
895 -- don't mistakenly grab a type variable mentioned in a type
896 -- synonym that drops it.
897 -- See Note [Eta-reducing type synonyms].
898 dropped_tvs = exactTyCoVarsOfTypes args_to_drop
899 -}
900
901 mkEqnHelp :: Maybe OverlapMode
902 -> [TyVar]
903 -> Class -> [Type]
904 -> TyCon -> [Type]
905 -> DerivContext -- Just => context supplied (standalone deriving)
906 -- Nothing => context inferred (deriving on data decl)
907 -> Maybe DerivStrategy
908 -> TcRn EarlyDerivSpec
909 -- Make the EarlyDerivSpec for an instance
910 -- forall tvs. theta => cls (tys ++ [ty])
911 -- where the 'theta' is optional (that's the Maybe part)
912 -- Assumes that this declaration is well-kinded
913
914 mkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args mtheta deriv_strat
915 = do { -- Find the instance of a data family
916 -- Note [Looking up family instances for deriving]
917 fam_envs <- tcGetFamInstEnvs
918 ; let (rep_tc, rep_tc_args, _co) = tcLookupDataFamInst fam_envs tycon tc_args
919 -- If it's still a data family, the lookup failed; i.e no instance exists
920 ; when (isDataFamilyTyCon rep_tc)
921 (bale_out (text "No family instance for" <+> quotes (pprTypeApp tycon tc_args)))
922
923 -- For standalone deriving (mtheta /= Nothing),
924 -- check that all the data constructors are in scope.
925 ; rdr_env <- getGlobalRdrEnv
926 ; let data_con_names = map dataConName (tyConDataCons rep_tc)
927 hidden_data_cons = not (isWiredInName (tyConName rep_tc)) &&
928 (isAbstractTyCon rep_tc ||
929 any not_in_scope data_con_names)
930 not_in_scope dc = isNothing (lookupGRE_Name rdr_env dc)
931
932 ; addUsedDataCons rdr_env rep_tc
933 ; unless (isNothing mtheta || not hidden_data_cons)
934 (bale_out (derivingHiddenErr tycon))
935
936 ; dflags <- getDynFlags
937 ; if isDataTyCon rep_tc then
938 mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
939 tycon tc_args rep_tc rep_tc_args mtheta deriv_strat
940 else
941 mkNewTypeEqn dflags overlap_mode tvs cls cls_tys
942 tycon tc_args rep_tc rep_tc_args mtheta deriv_strat }
943 where
944 bale_out msg = failWithTc (derivingThingErr False cls cls_tys
945 (mkTyConApp tycon tc_args) deriv_strat msg)
946
947 {-
948 Note [Looking up family instances for deriving]
949 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
950 tcLookupFamInstExact is an auxiliary lookup wrapper which requires
951 that looked-up family instances exist. If called with a vanilla
952 tycon, the old type application is simply returned.
953
954 If we have
955 data instance F () = ... deriving Eq
956 data instance F () = ... deriving Eq
957 then tcLookupFamInstExact will be confused by the two matches;
958 but that can't happen because tcInstDecls1 doesn't call tcDeriving
959 if there are any overlaps.
960
961 There are two other things that might go wrong with the lookup.
962 First, we might see a standalone deriving clause
963 deriving Eq (F ())
964 when there is no data instance F () in scope.
965
966 Note that it's OK to have
967 data instance F [a] = ...
968 deriving Eq (F [(a,b)])
969 where the match is not exact; the same holds for ordinary data types
970 with standalone deriving declarations.
971
972 Note [Deriving, type families, and partial applications]
973 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
974 When there are no type families, it's quite easy:
975
976 newtype S a = MkS [a]
977 -- :CoS :: S ~ [] -- Eta-reduced
978
979 instance Eq [a] => Eq (S a) -- by coercion sym (Eq (:CoS a)) : Eq [a] ~ Eq (S a)
980 instance Monad [] => Monad S -- by coercion sym (Monad :CoS) : Monad [] ~ Monad S
981
982 When type familes are involved it's trickier:
983
984 data family T a b
985 newtype instance T Int a = MkT [a] deriving( Eq, Monad )
986 -- :RT is the representation type for (T Int a)
987 -- :Co:RT :: :RT ~ [] -- Eta-reduced!
988 -- :CoF:RT a :: T Int a ~ :RT a -- Also eta-reduced!
989
990 instance Eq [a] => Eq (T Int a) -- easy by coercion
991 -- d1 :: Eq [a]
992 -- d2 :: Eq (T Int a) = d1 |> Eq (sym (:Co:RT a ; :coF:RT a))
993
994 instance Monad [] => Monad (T Int) -- only if we can eta reduce???
995 -- d1 :: Monad []
996 -- d2 :: Monad (T Int) = d1 |> Monad (sym (:Co:RT ; :coF:RT))
997
998 Note the need for the eta-reduced rule axioms. After all, we can
999 write it out
1000 instance Monad [] => Monad (T Int) -- only if we can eta reduce???
1001 return x = MkT [x]
1002 ... etc ...
1003
1004 See Note [Eta reduction for data families] in FamInstEnv
1005
1006 %************************************************************************
1007 %* *
1008 Deriving data types
1009 * *
1010 ************************************************************************
1011 -}
1012
1013 mkDataTypeEqn :: DynFlags
1014 -> Maybe OverlapMode
1015 -> [TyVar] -- Universally quantified type variables in the instance
1016 -> Class -- Class for which we need to derive an instance
1017 -> [Type] -- Other parameters to the class except the last
1018 -> TyCon -- Type constructor for which the instance is requested
1019 -- (last parameter to the type class)
1020 -> [Type] -- Parameters to the type constructor
1021 -> TyCon -- rep of the above (for type families)
1022 -> [Type] -- rep of the above
1023 -> DerivContext -- Context of the instance, for standalone deriving
1024 -> Maybe DerivStrategy -- 'Just' if user requests a particular
1025 -- deriving strategy.
1026 -- Otherwise, 'Nothing'.
1027 -> TcRn EarlyDerivSpec -- Return 'Nothing' if error
1028
1029 mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
1030 tycon tc_args rep_tc rep_tc_args mtheta deriv_strat
1031 = case deriv_strat of
1032 Just DerivStock -> mk_eqn_stock dflags mtheta cls cls_tys rep_tc
1033 go_for_it bale_out
1034 Just DerivAnyclass -> mk_eqn_anyclass dflags rep_tc cls
1035 go_for_it bale_out
1036 -- GeneralizedNewtypeDeriving makes no sense for non-newtypes
1037 Just DerivNewtype -> bale_out gndNonNewtypeErr
1038 -- Lacking a user-requested deriving strategy, we will try to pick
1039 -- between the stock or anyclass strategies
1040 Nothing -> mk_eqn_no_mechanism dflags mtheta cls cls_tys rep_tc
1041 go_for_it bale_out
1042 where
1043 go_for_it = mk_data_eqn overlap_mode tvs cls cls_tys tycon tc_args rep_tc rep_tc_args mtheta
1044 bale_out msg = failWithTc (derivingThingErr False cls cls_tys
1045 (mkTyConApp tycon tc_args) deriv_strat msg)
1046
1047 mk_data_eqn :: Maybe OverlapMode -> [TyVar] -> Class -> [Type]
1048 -> TyCon -> [TcType] -> TyCon -> [TcType] -> DerivContext
1049 -> DerivSpecMechanism -- How GHC should proceed attempting to
1050 -- derive this instance, determined in
1051 -- mkDataTypeEqn/mkNewTypeEqn
1052 -> TcM EarlyDerivSpec
1053 mk_data_eqn overlap_mode tvs cls cls_tys tycon tc_args rep_tc rep_tc_args
1054 mtheta mechanism
1055 = do loc <- getSrcSpanM
1056 dfun_name <- newDFunName' cls tycon
1057 case mtheta of
1058 Nothing -> -- Infer context
1059 inferConstraints tvs cls cls_tys
1060 inst_ty rep_tc rep_tc_args
1061 $ \inferred_constraints tvs' inst_tys' ->
1062 return $ InferTheta $ DS
1063 { ds_loc = loc
1064 , ds_name = dfun_name, ds_tvs = tvs'
1065 , ds_cls = cls, ds_tys = inst_tys'
1066 , ds_tc = rep_tc
1067 , ds_theta = inferred_constraints
1068 , ds_overlap = overlap_mode
1069 , ds_mechanism = mechanism }
1070 Just theta -> do -- Specified context
1071 return $ GivenTheta $ DS
1072 { ds_loc = loc
1073 , ds_name = dfun_name, ds_tvs = tvs
1074 , ds_cls = cls, ds_tys = inst_tys
1075 , ds_tc = rep_tc
1076 , ds_theta = theta
1077 , ds_overlap = overlap_mode
1078 , ds_mechanism = mechanism }
1079 where
1080 inst_ty = mkTyConApp tycon tc_args
1081 inst_tys = cls_tys ++ [inst_ty]
1082
1083 mk_eqn_stock :: DynFlags -> DerivContext -> Class -> [Type] -> TyCon
1084 -> (DerivSpecMechanism -> TcRn EarlyDerivSpec)
1085 -> (SDoc -> TcRn EarlyDerivSpec)
1086 -> TcRn EarlyDerivSpec
1087 mk_eqn_stock dflags mtheta cls cls_tys rep_tc go_for_it bale_out
1088 = case checkSideConditions dflags mtheta cls cls_tys rep_tc of
1089 CanDerive -> mk_eqn_stock' cls go_for_it
1090 DerivableClassError msg -> bale_out msg
1091 _ -> bale_out (nonStdErr cls)
1092
1093 mk_eqn_stock' :: Class -> (DerivSpecMechanism -> TcRn EarlyDerivSpec)
1094 -> TcRn EarlyDerivSpec
1095 mk_eqn_stock' cls go_for_it
1096 | let ck = classKey cls
1097 , ck `elem` [genClassKey, gen1ClassKey]
1098 = let gk = if ck == genClassKey then Gen0 else Gen1
1099 in go_for_it . DerivSpecGeneric . gen_Generic_binds $ gk
1100
1101 | otherwise = go_for_it $ case hasStockDeriving cls of
1102 Just gen_fn -> DerivSpecStock gen_fn
1103 Nothing ->
1104 pprPanic "mk_eqn_stock': Not a stock class!" (ppr cls)
1105
1106 mk_eqn_anyclass :: DynFlags -> TyCon -> Class
1107 -> (DerivSpecMechanism -> TcRn EarlyDerivSpec)
1108 -> (SDoc -> TcRn EarlyDerivSpec)
1109 -> TcRn EarlyDerivSpec
1110 mk_eqn_anyclass dflags rep_tc cls go_for_it bale_out
1111 = case canDeriveAnyClass dflags rep_tc cls of
1112 Nothing -> go_for_it DerivSpecAnyClass
1113 Just msg -> bale_out msg
1114
1115 mk_eqn_no_mechanism :: DynFlags -> DerivContext -> Class -> [Type] -> TyCon
1116 -> (DerivSpecMechanism -> TcRn EarlyDerivSpec)
1117 -> (SDoc -> TcRn EarlyDerivSpec)
1118 -> TcRn EarlyDerivSpec
1119 mk_eqn_no_mechanism dflags mtheta cls cls_tys rep_tc go_for_it bale_out
1120 = case checkSideConditions dflags mtheta cls cls_tys rep_tc of
1121 -- NB: pass the *representation* tycon to checkSideConditions
1122 NonDerivableClass msg -> bale_out (nonStdErr cls $$ msg)
1123 DerivableClassError msg -> bale_out msg
1124 CanDerive -> mk_eqn_stock' cls go_for_it
1125 DerivableViaInstance -> go_for_it DerivSpecAnyClass
1126
1127
1128 ----------------------
1129
1130 inferConstraints :: [TyVar] -> Class -> [TcType] -> TcType
1131 -> TyCon -> [TcType]
1132 -> (ThetaOrigin -> [TyVar] -> [TcType] -> TcM a)
1133 -> TcM a
1134 -- inferConstraints figures out the constraints needed for the
1135 -- instance declaration generated by a 'deriving' clause on a
1136 -- data type declaration. It also returns the new in-scope type
1137 -- variables and instance types, in case they were changed due to
1138 -- the presence of functor-like constraints.
1139 -- See Note [Inferring the instance context]
1140
1141 -- e.g. inferConstraints
1142 -- C Int (T [a]) -- Class and inst_tys
1143 -- :RTList a -- Rep tycon and its arg tys
1144 -- where T [a] ~R :RTList a
1145 --
1146 -- Generate a sufficiently large set of constraints that typechecking the
1147 -- generated method definitions should succeed. This set will be simplified
1148 -- before being used in the instance declaration
1149 inferConstraints tvs main_cls cls_tys inst_ty rep_tc rep_tc_args mkTheta
1150 | is_generic -- Generic constraints are easy
1151 = mkTheta [] tvs inst_tys
1152
1153 | is_generic1 -- Generic1 needs Functor
1154 = ASSERT( length rep_tc_tvs > 0 ) -- See Note [Getting base classes]
1155 ASSERT( length cls_tys == 1 ) -- Generic1 has a single kind variable
1156 do { functorClass <- tcLookupClass functorClassName
1157 ; con_arg_constraints (get_gen1_constraints functorClass) mkTheta }
1158
1159 | otherwise -- The others are a bit more complicated
1160 = ASSERT2( equalLength rep_tc_tvs all_rep_tc_args
1161 , ppr main_cls <+> ppr rep_tc
1162 $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args )
1163 con_arg_constraints get_std_constrained_tys
1164 $ \arg_constraints tvs' inst_tys' ->
1165 do { traceTc "inferConstraints" $ vcat
1166 [ ppr main_cls <+> ppr inst_tys'
1167 , ppr arg_constraints
1168 ]
1169 ; mkTheta (stupid_constraints ++ extra_constraints
1170 ++ sc_constraints ++ arg_constraints)
1171 tvs' inst_tys' }
1172 where
1173 tc_binders = tyConBinders rep_tc
1174 choose_level bndr
1175 | isNamedTyConBinder bndr = KindLevel
1176 | otherwise = TypeLevel
1177 t_or_ks = map choose_level tc_binders ++ repeat TypeLevel
1178 -- want to report *kind* errors when possible
1179
1180 -- Constraints arising from the arguments of each constructor
1181 con_arg_constraints :: (CtOrigin -> TypeOrKind
1182 -> Type
1183 -> [(ThetaOrigin, Maybe TCvSubst)])
1184 -> (ThetaOrigin -> [TyVar] -> [TcType] -> TcM a)
1185 -> TcM a
1186 con_arg_constraints get_arg_constraints mkTheta
1187 = let (predss, mbSubsts) = unzip
1188 [ preds_and_mbSubst
1189 | data_con <- tyConDataCons rep_tc
1190 , (arg_n, arg_t_or_k, arg_ty)
1191 <- zip3 [1..] t_or_ks $
1192 dataConInstOrigArgTys data_con all_rep_tc_args
1193 -- No constraints for unlifted types
1194 -- See Note [Deriving and unboxed types]
1195 , not (isUnliftedType arg_ty)
1196 , let orig = DerivOriginDC data_con arg_n
1197 , preds_and_mbSubst <- get_arg_constraints orig arg_t_or_k arg_ty
1198 ]
1199 preds = concat predss
1200 -- If the constraints require a subtype to be of kind (* -> *)
1201 -- (which is the case for functor-like constraints), then we
1202 -- explicitly unify the subtype's kinds with (* -> *).
1203 -- See Note [Inferring the instance context]
1204 subst = foldl' composeTCvSubst
1205 emptyTCvSubst (catMaybes mbSubsts)
1206 unmapped_tvs = filter (\v -> v `notElemTCvSubst` subst
1207 && not (v `isInScope` subst)) tvs
1208 (subst', _) = mapAccumL substTyVarBndr subst unmapped_tvs
1209 preds' = substThetaOrigin subst' preds
1210 inst_tys' = substTys subst' inst_tys
1211 tvs' = tyCoVarsOfTypesWellScoped inst_tys'
1212 in mkTheta preds' tvs' inst_tys'
1213
1214 is_generic = main_cls `hasKey` genClassKey
1215 is_generic1 = main_cls `hasKey` gen1ClassKey
1216 -- is_functor_like: see Note [Inferring the instance context]
1217 is_functor_like = typeKind inst_ty `tcEqKind` typeToTypeKind
1218 || is_generic1 -- Technically, Generic1 requires a type of
1219 -- kind (k -> *), not (* -> *), but we still
1220 -- label it "functor-like" to make sure
1221 -- all_rep_tc_args has all the necessary type
1222 -- variables it needs to function.
1223
1224 get_gen1_constraints :: Class -> CtOrigin -> TypeOrKind -> Type
1225 -> [(ThetaOrigin, Maybe TCvSubst)]
1226 get_gen1_constraints functor_cls orig t_or_k ty
1227 = mk_functor_like_constraints orig t_or_k functor_cls $
1228 get_gen1_constrained_tys last_tv ty
1229
1230 get_std_constrained_tys :: CtOrigin -> TypeOrKind -> Type
1231 -> [(ThetaOrigin, Maybe TCvSubst)]
1232 get_std_constrained_tys orig t_or_k ty
1233 | is_functor_like = mk_functor_like_constraints orig t_or_k main_cls $
1234 deepSubtypesContaining last_tv ty
1235 | otherwise = [( [mk_cls_pred orig t_or_k main_cls ty]
1236 , Nothing )]
1237
1238 mk_functor_like_constraints :: CtOrigin -> TypeOrKind
1239 -> Class -> [Type]
1240 -> [(ThetaOrigin, Maybe TCvSubst)]
1241 -- 'cls' is usually main_cls (Functor or Traversable etc), but if
1242 -- main_cls = Generic1, then 'cls' can be Functor; see get_gen1_constraints
1243 --
1244 -- For each type, generate two constraints, [cls ty, kind(ty) ~ (*->*)],
1245 -- and a kind substitution that results from unifying kind(ty) with * -> *.
1246 -- If the unification is successful, it will ensure that the resulting
1247 -- instance is well kinded. If not, the second constraint will result
1248 -- in an error message which points out the kind mismatch.
1249 -- See Note [Inferring the instance context]
1250 mk_functor_like_constraints orig t_or_k cls
1251 = map $ \ty -> let ki = typeKind ty in
1252 ( [ mk_cls_pred orig t_or_k cls ty
1253 , mkPredOrigin orig KindLevel
1254 (mkPrimEqPred ki typeToTypeKind) ]
1255 , tcUnifyTy ki typeToTypeKind
1256 )
1257
1258 rep_tc_tvs = tyConTyVars rep_tc
1259 last_tv = last rep_tc_tvs
1260 all_rep_tc_args | is_functor_like = rep_tc_args ++ [mkTyVarTy last_tv]
1261 | otherwise = rep_tc_args
1262
1263 -- Constraints arising from superclasses
1264 -- See Note [Superclasses of derived instance]
1265 cls_tvs = classTyVars main_cls
1266 inst_tys = cls_tys ++ [inst_ty]
1267 sc_constraints = ASSERT2( equalLength cls_tvs inst_tys, ppr main_cls <+> ppr rep_tc)
1268 mkThetaOrigin DerivOrigin TypeLevel $
1269 substTheta cls_subst (classSCTheta main_cls)
1270 cls_subst = ASSERT( equalLength cls_tvs inst_tys )
1271 zipTvSubst cls_tvs inst_tys
1272
1273 -- Stupid constraints
1274 stupid_constraints = mkThetaOrigin DerivOrigin TypeLevel $
1275 substTheta tc_subst (tyConStupidTheta rep_tc)
1276 tc_subst = ASSERT( equalLength rep_tc_tvs all_rep_tc_args )
1277 zipTvSubst rep_tc_tvs all_rep_tc_args
1278
1279 -- Extra Data constraints
1280 -- The Data class (only) requires that for
1281 -- instance (...) => Data (T t1 t2)
1282 -- IF t1:*, t2:*
1283 -- THEN (Data t1, Data t2) are among the (...) constraints
1284 -- Reason: when the IF holds, we generate a method
1285 -- dataCast2 f = gcast2 f
1286 -- and we need the Data constraints to typecheck the method
1287 extra_constraints
1288 | main_cls `hasKey` dataClassKey
1289 , all (isLiftedTypeKind . typeKind) rep_tc_args
1290 = [ mk_cls_pred DerivOrigin t_or_k main_cls ty
1291 | (t_or_k, ty) <- zip t_or_ks rep_tc_args]
1292 | otherwise
1293 = []
1294
1295 mk_cls_pred orig t_or_k cls ty -- Don't forget to apply to cls_tys' too
1296 = mkPredOrigin orig t_or_k (mkClassPred cls (cls_tys' ++ [ty]))
1297 cls_tys' | is_generic1 = [] -- In the awkward Generic1 case, cls_tys'
1298 -- should be empty, since we are applying the
1299 -- class Functor.
1300 | otherwise = cls_tys
1301
1302 {- Note [Getting base classes]
1303 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1304 Functor and Typeable are defined in package 'base', and that is not available
1305 when compiling 'ghc-prim'. So we must be careful that 'deriving' for stuff in
1306 ghc-prim does not use Functor or Typeable implicitly via these lookups.
1307
1308 Note [Deriving and unboxed types]
1309 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1310 We have some special hacks to support things like
1311 data T = MkT Int# deriving ( Show )
1312
1313 Specifically, we use TcGenDeriv.box to box the Int# into an Int
1314 (which we know how to show), and append a '#'. Parenthesis are not required
1315 for unboxed values (`MkT -3#` is a valid expression).
1316
1317 Note [Deriving any class]
1318 ~~~~~~~~~~~~~~~~~~~~~~~~~
1319 Classic uses of a deriving clause, or a standalone-deriving declaration, are
1320 for:
1321 * a stock class like Eq or Show, for which GHC knows how to generate
1322 the instance code
1323 * a newtype, via the mechanism enabled by GeneralizedNewtypeDeriving
1324
1325 The DeriveAnyClass extension adds a third way to derive instances, based on
1326 empty instance declarations.
1327
1328 The canonical use case is in combination with GHC.Generics and default method
1329 signatures. These allow us to have instance declarations being empty, but still
1330 useful, e.g.
1331
1332 data T a = ...blah..blah... deriving( Generic )
1333 instance C a => C (T a) -- No 'where' clause
1334
1335 where C is some "random" user-defined class.
1336
1337 This boilerplate code can be replaced by the more compact
1338
1339 data T a = ...blah..blah... deriving( Generic, C )
1340
1341 if DeriveAnyClass is enabled.
1342
1343 This is not restricted to Generics; any class can be derived, simply giving
1344 rise to an empty instance.
1345
1346 Unfortunately, it is not clear how to determine the context (when using a
1347 deriving clause; in standalone deriving, the user provides the context).
1348 GHC uses the same heuristic for figuring out the class context that it uses for
1349 Eq in the case of *-kinded classes, and for Functor in the case of
1350 * -> *-kinded classes. That may not be optimal or even wrong. But in such
1351 cases, standalone deriving can still be used.
1352 -}
1353
1354 ------------------------------------------------------------------
1355 -- Check side conditions that dis-allow derivability for particular classes
1356 -- This is *apart* from the newtype-deriving mechanism
1357 --
1358 -- Here we get the representation tycon in case of family instances as it has
1359 -- the data constructors - but we need to be careful to fall back to the
1360 -- family tycon (with indexes) in error messages.
1361
1362 data DerivStatus = CanDerive -- Stock class, can derive
1363 | DerivableClassError SDoc -- Stock class, but can't do it
1364 | DerivableViaInstance -- See Note [Deriving any class]
1365 | NonDerivableClass SDoc -- Non-stock class
1366
1367 -- A stock class is one either defined in the Haskell report or for which GHC
1368 -- otherwise knows how to generate code for (possibly requiring the use of a
1369 -- language extension), such as Eq, Ord, Ix, Data, Generic, etc.
1370
1371 checkSideConditions :: DynFlags -> DerivContext -> Class -> [TcType]
1372 -> TyCon -- tycon
1373 -> DerivStatus
1374 checkSideConditions dflags mtheta cls cls_tys rep_tc
1375 | Just cond <- sideConditions mtheta cls
1376 = case (cond (dflags, rep_tc)) of
1377 NotValid err -> DerivableClassError err -- Class-specific error
1378 IsValid | null (filterOutInvisibleTypes (classTyCon cls) cls_tys)
1379 -> CanDerive
1380 -- All stock derivable classes are unary in the sense that
1381 -- there should be not types in cls_tys (i.e., no type args
1382 -- other than last). Note that cls_types can contain
1383 -- invisible types as well (e.g., for Generic1, which is
1384 -- poly-kinded), so make sure those are not counted.
1385 | otherwise -> DerivableClassError (classArgsErr cls cls_tys)
1386 -- e.g. deriving( Eq s )
1387
1388 | Just err <- canDeriveAnyClass dflags rep_tc cls
1389 = NonDerivableClass err -- DeriveAnyClass does not work
1390
1391 | otherwise
1392 = DerivableViaInstance -- DeriveAnyClass should work
1393
1394
1395 classArgsErr :: Class -> [Type] -> SDoc
1396 classArgsErr cls cls_tys = quotes (ppr (mkClassPred cls cls_tys)) <+> text "is not a class"
1397
1398 nonUnaryErr :: LHsSigType Name -> SDoc
1399 nonUnaryErr ct = quotes (ppr ct)
1400 <+> text "is not a unary constraint, as expected by a deriving clause"
1401
1402 nonStdErr :: Class -> SDoc
1403 nonStdErr cls =
1404 quotes (ppr cls)
1405 <+> text "is not a stock derivable class (Eq, Show, etc.)"
1406
1407 gndNonNewtypeErr :: SDoc
1408 gndNonNewtypeErr =
1409 text "GeneralizedNewtypeDeriving cannot be used on non-newtypes"
1410
1411 -- Side conditions (whether the datatype must have at least one constructor,
1412 -- required language extensions, etc.) for using GHC's stock deriving
1413 -- mechanism on certain classes (as opposed to classes that require
1414 -- GeneralizedNewtypeDeriving or DeriveAnyClass). Returns Nothing for a
1415 -- class for which stock deriving isn't possible.
1416 --
1417 -- NB: The classes listed below should be in sync with the ones listed in the
1418 -- definition of hasStockDeriving in TcGenDeriv (except for Generic(1),
1419 -- which are handled specially). If you add new class to sideConditions,
1420 -- make sure to update hasStockDeriving as well!
1421 sideConditions :: DerivContext -> Class -> Maybe Condition
1422 sideConditions mtheta cls
1423 | cls_key == eqClassKey = Just (cond_std `andCond` cond_args cls)
1424 | cls_key == ordClassKey = Just (cond_std `andCond` cond_args cls)
1425 | cls_key == showClassKey = Just (cond_std `andCond` cond_args cls)
1426 | cls_key == readClassKey = Just (cond_std `andCond` cond_args cls)
1427 | cls_key == enumClassKey = Just (cond_std `andCond` cond_isEnumeration)
1428 | cls_key == ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
1429 | cls_key == boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
1430 | cls_key == dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond`
1431 cond_std `andCond`
1432 cond_args cls)
1433 | cls_key == functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond`
1434 cond_vanilla `andCond`
1435 cond_functorOK True False)
1436 | cls_key == foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond`
1437 cond_vanilla `andCond`
1438 cond_functorOK False True)
1439 -- Functor/Fold/Trav works ok
1440 -- for rank-n types
1441 | cls_key == traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond`
1442 cond_vanilla `andCond`
1443 cond_functorOK False False)
1444 | cls_key == genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
1445 cond_vanilla `andCond`
1446 cond_RepresentableOk)
1447 | cls_key == gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
1448 cond_vanilla `andCond`
1449 cond_Representable1Ok)
1450 | cls_key == liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond`
1451 cond_vanilla `andCond`
1452 cond_args cls)
1453 | otherwise = Nothing
1454 where
1455 cls_key = getUnique cls
1456 cond_std = cond_stdOK mtheta False -- Vanilla data constructors, at least one,
1457 -- and monotype arguments
1458 cond_vanilla = cond_stdOK mtheta True -- Vanilla data constructors but
1459 -- allow no data cons or polytype arguments
1460
1461 canDeriveAnyClass :: DynFlags -> TyCon -> Class -> Maybe SDoc
1462 -- Nothing: we can (try to) derive it via an empty instance declaration
1463 -- Just s: we can't, reason s
1464 -- Precondition: the class is not one of the standard ones
1465 canDeriveAnyClass dflags _tycon clas
1466 | not (xopt LangExt.DeriveAnyClass dflags)
1467 = Just (text "Try enabling DeriveAnyClass")
1468 | not (any (target_kind `tcEqKind`) [ liftedTypeKind, typeToTypeKind ])
1469 = Just (text "The last argument of class" <+> quotes (ppr clas)
1470 <+> text "does not have kind * or (* -> *)")
1471 | otherwise
1472 = Nothing -- OK!
1473 where
1474 -- We are making an instance (C t1 .. tn (T s1 .. sm))
1475 -- and we can only do so if the kind of C's last argument
1476 -- is * or (* -> *). Because only then can we make a reasonable
1477 -- guess at the instance context
1478 target_kind = tyVarKind (last (classTyVars clas))
1479
1480 typeToTypeKind :: Kind
1481 typeToTypeKind = liftedTypeKind `mkFunTy` liftedTypeKind
1482
1483 type Condition = (DynFlags, TyCon) -> Validity
1484 -- TyCon is the *representation* tycon if the data type is an indexed one
1485 -- Nothing => OK
1486
1487 orCond :: Condition -> Condition -> Condition
1488 orCond c1 c2 tc
1489 = case (c1 tc, c2 tc) of
1490 (IsValid, _) -> IsValid -- c1 succeeds
1491 (_, IsValid) -> IsValid -- c21 succeeds
1492 (NotValid x, NotValid y) -> NotValid (x $$ text " or" $$ y)
1493 -- Both fail
1494
1495 andCond :: Condition -> Condition -> Condition
1496 andCond c1 c2 tc = c1 tc `andValid` c2 tc
1497
1498 cond_stdOK :: DerivContext -- Says whether this is standalone deriving or not;
1499 -- if standalone, we just say "yes, go for it"
1500 -> Bool -- True <=> permissive: allow higher rank
1501 -- args and no data constructors
1502 -> Condition
1503 cond_stdOK (Just _) _ _
1504 = IsValid -- Don't check these conservative conditions for
1505 -- standalone deriving; just generate the code
1506 -- and let the typechecker handle the result
1507 cond_stdOK Nothing permissive (_, rep_tc)
1508 | null data_cons
1509 , not permissive = NotValid (no_cons_why rep_tc $$ suggestion)
1510 | not (null con_whys) = NotValid (vcat con_whys $$ suggestion)
1511 | otherwise = IsValid
1512 where
1513 suggestion = text "Possible fix: use a standalone deriving declaration instead"
1514 data_cons = tyConDataCons rep_tc
1515 con_whys = getInvalids (map check_con data_cons)
1516
1517 check_con :: DataCon -> Validity
1518 check_con con
1519 | not (null eq_spec)
1520 = bad "is a GADT"
1521 | not (null ex_tvs)
1522 = bad "has existential type variables in its type"
1523 | not (null theta)
1524 = bad "has constraints in its type"
1525 | not (permissive || all isTauTy (dataConOrigArgTys con))
1526 = bad "has a higher-rank type"
1527 | otherwise
1528 = IsValid
1529 where
1530 (_, ex_tvs, eq_spec, theta, _, _) = dataConFullSig con
1531 bad msg = NotValid (badCon con (text msg))
1532
1533 no_cons_why :: TyCon -> SDoc
1534 no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+>
1535 text "must have at least one data constructor"
1536
1537 cond_RepresentableOk :: Condition
1538 cond_RepresentableOk (_, tc) = canDoGenerics tc
1539
1540 cond_Representable1Ok :: Condition
1541 cond_Representable1Ok (_, tc) = canDoGenerics1 tc
1542
1543 cond_enumOrProduct :: Class -> Condition
1544 cond_enumOrProduct cls = cond_isEnumeration `orCond`
1545 (cond_isProduct `andCond` cond_args cls)
1546
1547 cond_args :: Class -> Condition
1548 -- For some classes (eg Eq, Ord) we allow unlifted arg types
1549 -- by generating specialised code. For others (eg Data) we don't.
1550 cond_args cls (_, tc)
1551 = case bad_args of
1552 [] -> IsValid
1553 (ty:_) -> NotValid (hang (text "Don't know how to derive" <+> quotes (ppr cls))
1554 2 (text "for type" <+> quotes (ppr ty)))
1555 where
1556 bad_args = [ arg_ty | con <- tyConDataCons tc
1557 , arg_ty <- dataConOrigArgTys con
1558 , isUnliftedType arg_ty
1559 , not (ok_ty arg_ty) ]
1560
1561 cls_key = classKey cls
1562 ok_ty arg_ty
1563 | cls_key == eqClassKey = check_in arg_ty ordOpTbl
1564 | cls_key == ordClassKey = check_in arg_ty ordOpTbl
1565 | cls_key == showClassKey = check_in arg_ty boxConTbl
1566 | cls_key == liftClassKey = check_in arg_ty litConTbl
1567 | otherwise = False -- Read, Ix etc
1568
1569 check_in :: Type -> [(Type,a)] -> Bool
1570 check_in arg_ty tbl = any (eqType arg_ty . fst) tbl
1571
1572
1573 cond_isEnumeration :: Condition
1574 cond_isEnumeration (_, rep_tc)
1575 | isEnumerationTyCon rep_tc = IsValid
1576 | otherwise = NotValid why
1577 where
1578 why = sep [ quotes (pprSourceTyCon rep_tc) <+>
1579 text "must be an enumeration type"
1580 , text "(an enumeration consists of one or more nullary, non-GADT constructors)" ]
1581 -- See Note [Enumeration types] in TyCon
1582
1583 cond_isProduct :: Condition
1584 cond_isProduct (_, rep_tc)
1585 | isProductTyCon rep_tc = IsValid
1586 | otherwise = NotValid why
1587 where
1588 why = quotes (pprSourceTyCon rep_tc) <+>
1589 text "must have precisely one constructor"
1590
1591 cond_functorOK :: Bool -> Bool -> Condition
1592 -- OK for Functor/Foldable/Traversable class
1593 -- Currently: (a) at least one argument
1594 -- (b) don't use argument contravariantly
1595 -- (c) don't use argument in the wrong place, e.g. data T a = T (X a a)
1596 -- (d) optionally: don't use function types
1597 -- (e) no "stupid context" on data type
1598 cond_functorOK allowFunctions allowExQuantifiedLastTyVar (_, rep_tc)
1599 | null tc_tvs
1600 = NotValid (text "Data type" <+> quotes (ppr rep_tc)
1601 <+> text "must have some type parameters")
1602
1603 | not (null bad_stupid_theta)
1604 = NotValid (text "Data type" <+> quotes (ppr rep_tc)
1605 <+> text "must not have a class context:" <+> pprTheta bad_stupid_theta)
1606
1607 | otherwise
1608 = allValid (map check_con data_cons)
1609 where
1610 tc_tvs = tyConTyVars rep_tc
1611 Just (_, last_tv) = snocView tc_tvs
1612 bad_stupid_theta = filter is_bad (tyConStupidTheta rep_tc)
1613 is_bad pred = last_tv `elemVarSet` tyCoVarsOfType pred
1614
1615 data_cons = tyConDataCons rep_tc
1616 check_con con = allValid (check_universal con : foldDataConArgs (ft_check con) con)
1617
1618 check_universal :: DataCon -> Validity
1619 check_universal con
1620 | allowExQuantifiedLastTyVar
1621 = IsValid -- See Note [DeriveFoldable with ExistentialQuantification]
1622 -- in TcGenDeriv
1623 | Just tv <- getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con)))
1624 , tv `elem` dataConUnivTyVars con
1625 , not (tv `elemVarSet` tyCoVarsOfTypes (dataConTheta con))
1626 = IsValid -- See Note [Check that the type variable is truly universal]
1627 | otherwise
1628 = NotValid (badCon con existential)
1629
1630 ft_check :: DataCon -> FFoldType Validity
1631 ft_check con = FT { ft_triv = IsValid, ft_var = IsValid
1632 , ft_co_var = NotValid (badCon con covariant)
1633 , ft_fun = \x y -> if allowFunctions then x `andValid` y
1634 else NotValid (badCon con functions)
1635 , ft_tup = \_ xs -> allValid xs
1636 , ft_ty_app = \_ x -> x
1637 , ft_bad_app = NotValid (badCon con wrong_arg)
1638 , ft_forall = \_ x -> x }
1639
1640 existential = text "must be truly polymorphic in the last argument of the data type"
1641 covariant = text "must not use the type variable in a function argument"
1642 functions = text "must not contain function types"
1643 wrong_arg = text "must use the type variable only as the last argument of a data type"
1644
1645 checkFlag :: LangExt.Extension -> Condition
1646 checkFlag flag (dflags, _)
1647 | xopt flag dflags = IsValid
1648 | otherwise = NotValid why
1649 where
1650 why = text "You need " <> text flag_str
1651 <+> text "to derive an instance for this class"
1652 flag_str = case [ flagSpecName f | f <- xFlags , flagSpecFlag f == flag ] of
1653 [s] -> s
1654 other -> pprPanic "checkFlag" (ppr other)
1655
1656 std_class_via_coercible :: Class -> Bool
1657 -- These standard classes can be derived for a newtype
1658 -- using the coercible trick *even if no -XGeneralizedNewtypeDeriving
1659 -- because giving so gives the same results as generating the boilerplate
1660 std_class_via_coercible clas
1661 = classKey clas `elem` [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]
1662 -- Not Read/Show because they respect the type
1663 -- Not Enum, because newtypes are never in Enum
1664
1665
1666 non_coercible_class :: Class -> Bool
1667 -- *Never* derive Read, Show, Typeable, Data, Generic, Generic1, Lift
1668 -- by Coercible, even with -XGeneralizedNewtypeDeriving
1669 -- Also, avoid Traversable, as the Coercible-derived instance and the "normal"-derived
1670 -- instance behave differently if there's a non-lawful Applicative out there.
1671 -- Besides, with roles, Coercible-deriving Traversable is ill-roled.
1672 non_coercible_class cls
1673 = classKey cls `elem` ([ readClassKey, showClassKey, dataClassKey
1674 , genClassKey, gen1ClassKey, typeableClassKey
1675 , traversableClassKey, liftClassKey ])
1676
1677 badCon :: DataCon -> SDoc -> SDoc
1678 badCon con msg = text "Constructor" <+> quotes (ppr con) <+> msg
1679
1680 {-
1681 Note [Check that the type variable is truly universal]
1682 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1683 For Functor and Traversable instances, we must check that the *last argument*
1684 of the type constructor is used truly universally quantified. Example
1685
1686 data T a b where
1687 T1 :: a -> b -> T a b -- Fine! Vanilla H-98
1688 T2 :: b -> c -> T a b -- Fine! Existential c, but we can still map over 'b'
1689 T3 :: b -> T Int b -- Fine! Constraint 'a', but 'b' is still polymorphic
1690 T4 :: Ord b => b -> T a b -- No! 'b' is constrained
1691 T5 :: b -> T b b -- No! 'b' is constrained
1692 T6 :: T a (b,b) -- No! 'b' is constrained
1693
1694 Notice that only the first of these constructors is vanilla H-98. We only
1695 need to take care about the last argument (b in this case). See Trac #8678.
1696 Eg. for T1-T3 we can write
1697
1698 fmap f (T1 a b) = T1 a (f b)
1699 fmap f (T2 b c) = T2 (f b) c
1700 fmap f (T3 x) = T3 (f x)
1701
1702 We need not perform these checks for Foldable instances, however, since
1703 functions in Foldable can only consume existentially quantified type variables,
1704 rather than produce them (as is the case in Functor and Traversable functions.)
1705 As a result, T can have a derived Foldable instance:
1706
1707 foldr f z (T1 a b) = f b z
1708 foldr f z (T2 b c) = f b z
1709 foldr f z (T3 x) = f x z
1710 foldr f z (T4 x) = f x z
1711 foldr f z (T5 x) = f x z
1712 foldr _ z T6 = z
1713
1714 See Note [DeriveFoldable with ExistentialQuantification] in TcGenDeriv.
1715
1716
1717 Note [Superclasses of derived instance]
1718 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1719 In general, a derived instance decl needs the superclasses of the derived
1720 class too. So if we have
1721 data T a = ...deriving( Ord )
1722 then the initial context for Ord (T a) should include Eq (T a). Often this is
1723 redundant; we'll also generate an Ord constraint for each constructor argument,
1724 and that will probably generate enough constraints to make the Eq (T a) constraint
1725 be satisfied too. But not always; consider:
1726
1727 data S a = S
1728 instance Eq (S a)
1729 instance Ord (S a)
1730
1731 data T a = MkT (S a) deriving( Ord )
1732 instance Num a => Eq (T a)
1733
1734 The derived instance for (Ord (T a)) must have a (Num a) constraint!
1735 Similarly consider:
1736 data T a = MkT deriving( Data )
1737 Here there *is* no argument field, but we must nevertheless generate
1738 a context for the Data instances:
1739 instance Typeable a => Data (T a) where ...
1740
1741 ************************************************************************
1742 * *
1743 Deriving newtypes
1744 * *
1745 ************************************************************************
1746 -}
1747
1748 mkNewTypeEqn :: DynFlags -> Maybe OverlapMode -> [TyVar] -> Class
1749 -> [Type] -> TyCon -> [Type] -> TyCon -> [Type]
1750 -> DerivContext -> Maybe DerivStrategy
1751 -> TcRn EarlyDerivSpec
1752 mkNewTypeEqn dflags overlap_mode tvs
1753 cls cls_tys tycon tc_args rep_tycon rep_tc_args
1754 mtheta deriv_strat
1755 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
1756 = ASSERT( length cls_tys + 1 == classArity cls )
1757 case deriv_strat of
1758 Just DerivStock -> mk_eqn_stock dflags mtheta cls cls_tys rep_tycon
1759 go_for_it_other bale_out
1760 Just DerivAnyclass -> mk_eqn_anyclass dflags rep_tycon cls
1761 go_for_it_other bale_out
1762 Just DerivNewtype ->
1763 -- Since the user explicitly asked for GeneralizedNewtypeDeriving, we
1764 -- don't need to perform all of the checks we normally would, such as
1765 -- if the class being derived is known to produce ill-roled coercions
1766 -- (e.g., Traversable), since we can just derive the instance and let
1767 -- it error if need be.
1768 -- See Note [Determining whether newtype-deriving is appropriate]
1769 if coercion_looks_sensible && newtype_deriving
1770 then go_for_it_gnd
1771 else bale_out (cant_derive_err $$
1772 if newtype_deriving then empty else suggest_gnd)
1773 Nothing
1774 | might_derive_via_coercible
1775 && ((newtype_deriving && not deriveAnyClass)
1776 || std_class_via_coercible cls)
1777 -> go_for_it_gnd
1778 | otherwise
1779 -> case checkSideConditions dflags mtheta cls cls_tys rep_tycon of
1780 DerivableClassError msg
1781 -- There's a particular corner case where
1782 --
1783 -- 1. -XGeneralizedNewtypeDeriving and -XDeriveAnyClass are both
1784 -- enabled at the same time
1785 -- 2. We're deriving a particular stock derivable class
1786 -- (such as Functor)
1787 --
1788 -- and the previous cases won't catch it. This fixes the bug
1789 -- reported in Trac #10598.
1790 | might_derive_via_coercible && newtype_deriving
1791 -> go_for_it_gnd
1792 -- Otherwise, throw an error for a stock class
1793 | might_derive_via_coercible && not newtype_deriving
1794 -> bale_out (msg $$ suggest_gnd)
1795 | otherwise
1796 -> bale_out msg
1797
1798 -- Must use newtype deriving or DeriveAnyClass
1799 NonDerivableClass _msg
1800 -- Too hard, even with newtype deriving
1801 | newtype_deriving -> bale_out cant_derive_err
1802 -- Try newtype deriving!
1803 -- Here we suggest GeneralizedNewtypeDeriving even in cases where
1804 -- it may not be applicable. See Trac #9600.
1805 | otherwise -> bale_out (non_std $$ suggest_gnd)
1806
1807 -- DerivableViaInstance
1808 DerivableViaInstance -> do
1809 -- If both DeriveAnyClass and GeneralizedNewtypeDeriving are
1810 -- enabled, we take the diplomatic approach of defaulting to
1811 -- DeriveAnyClass, but emitting a warning about the choice.
1812 -- See Note [Deriving strategies]
1813 when (newtype_deriving && deriveAnyClass) $
1814 addWarnTc NoReason $ sep
1815 [ text "Both DeriveAnyClass and"
1816 <+> text "GeneralizedNewtypeDeriving are enabled"
1817 , text "Defaulting to the DeriveAnyClass strategy"
1818 <+> text "for instantiating" <+> ppr cls ]
1819 go_for_it_other DerivSpecAnyClass
1820 -- CanDerive
1821 CanDerive -> mk_eqn_stock' cls go_for_it_other
1822 where
1823 newtype_deriving = xopt LangExt.GeneralizedNewtypeDeriving dflags
1824 deriveAnyClass = xopt LangExt.DeriveAnyClass dflags
1825 go_for_it_gnd = do
1826 traceTc "newtype deriving:" $
1827 ppr tycon <+> ppr rep_tys <+> ppr all_preds
1828 dfun_name <- newDFunName' cls tycon
1829 loc <- getSrcSpanM
1830 case mtheta of
1831 Just theta -> return $ GivenTheta $ DS
1832 { ds_loc = loc
1833 , ds_name = dfun_name, ds_tvs = dfun_tvs
1834 , ds_cls = cls, ds_tys = inst_tys
1835 , ds_tc = rep_tycon
1836 , ds_theta = theta
1837 , ds_overlap = overlap_mode
1838 , ds_mechanism = DerivSpecNewtype rep_inst_ty }
1839 Nothing -> return $ InferTheta $ DS
1840 { ds_loc = loc
1841 , ds_name = dfun_name, ds_tvs = dfun_tvs
1842 , ds_cls = cls, ds_tys = inst_tys
1843 , ds_tc = rep_tycon
1844 , ds_theta = all_preds
1845 , ds_overlap = overlap_mode
1846 , ds_mechanism = DerivSpecNewtype rep_inst_ty }
1847 go_for_it_other = mk_data_eqn overlap_mode tvs cls cls_tys tycon
1848 tc_args rep_tycon rep_tc_args mtheta
1849 bale_out = bale_out' newtype_deriving
1850 bale_out' b = failWithTc . derivingThingErr b cls cls_tys inst_ty
1851 deriv_strat
1852
1853 non_std = nonStdErr cls
1854 suggest_gnd = text "Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension"
1855
1856 -- Here is the plan for newtype derivings. We see
1857 -- newtype T a1...an = MkT (t ak+1...an) deriving (.., C s1 .. sm, ...)
1858 -- where t is a type,
1859 -- ak+1...an is a suffix of a1..an, and are all tyvars
1860 -- ak+1...an do not occur free in t, nor in the s1..sm
1861 -- (C s1 ... sm) is a *partial applications* of class C
1862 -- with the last parameter missing
1863 -- (T a1 .. ak) matches the kind of C's last argument
1864 -- (and hence so does t)
1865 -- The latter kind-check has been done by deriveTyData already,
1866 -- and tc_args are already trimmed
1867 --
1868 -- We generate the instance
1869 -- instance forall ({a1..ak} u fvs(s1..sm)).
1870 -- C s1 .. sm t => C s1 .. sm (T a1...ak)
1871 -- where T a1...ap is the partial application of
1872 -- the LHS of the correct kind and p >= k
1873 --
1874 -- NB: the variables below are:
1875 -- tc_tvs = [a1, ..., an]
1876 -- tyvars_to_keep = [a1, ..., ak]
1877 -- rep_ty = t ak .. an
1878 -- deriv_tvs = fvs(s1..sm) \ tc_tvs
1879 -- tys = [s1, ..., sm]
1880 -- rep_fn' = t
1881 --
1882 -- Running example: newtype T s a = MkT (ST s a) deriving( Monad )
1883 -- We generate the instance
1884 -- instance Monad (ST s) => Monad (T s) where
1885
1886 nt_eta_arity = newTyConEtadArity rep_tycon
1887 -- For newtype T a b = MkT (S a a b), the TyCon machinery already
1888 -- eta-reduces the representation type, so we know that
1889 -- T a ~ S a a
1890 -- That's convenient here, because we may have to apply
1891 -- it to fewer than its original complement of arguments
1892
1893 -- Note [Newtype representation]
1894 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1895 -- Need newTyConRhs (*not* a recursive representation finder)
1896 -- to get the representation type. For example
1897 -- newtype B = MkB Int
1898 -- newtype A = MkA B deriving( Num )
1899 -- We want the Num instance of B, *not* the Num instance of Int,
1900 -- when making the Num instance of A!
1901 rep_inst_ty = newTyConInstRhs rep_tycon rep_tc_args
1902 rep_tys = cls_tys ++ [rep_inst_ty]
1903 rep_pred = mkClassPred cls rep_tys
1904 rep_pred_o = mkPredOrigin DerivOrigin TypeLevel rep_pred
1905 -- rep_pred is the representation dictionary, from where
1906 -- we are gong to get all the methods for the newtype
1907 -- dictionary
1908
1909 -- Next we figure out what superclass dictionaries to use
1910 -- See Note [Newtype deriving superclasses] above
1911 cls_tyvars = classTyVars cls
1912 dfun_tvs = tyCoVarsOfTypesWellScoped inst_tys
1913 inst_ty = mkTyConApp tycon tc_args
1914 inst_tys = cls_tys ++ [inst_ty]
1915 sc_theta = mkThetaOrigin DerivOrigin TypeLevel $
1916 substTheta (zipTvSubst cls_tyvars inst_tys) $
1917 classSCTheta cls
1918
1919 -- Next we collect Coercible constraints between
1920 -- the Class method types, instantiated with the representation and the
1921 -- newtype type; precisely the constraints required for the
1922 -- calls to coercible that we are going to generate.
1923 coercible_constraints =
1924 [ let (Pair t1 t2) = mkCoerceClassMethEqn cls dfun_tvs inst_tys rep_inst_ty meth
1925 in mkPredOrigin (DerivOriginCoerce meth t1 t2) TypeLevel
1926 (mkReprPrimEqPred t1 t2)
1927 | meth <- classMethods cls ]
1928
1929 -- If there are no tyvars, there's no need
1930 -- to abstract over the dictionaries we need
1931 -- Example: newtype T = MkT Int deriving( C )
1932 -- We get the derived instance
1933 -- instance C T
1934 -- rather than
1935 -- instance C Int => C T
1936 all_preds = rep_pred_o : coercible_constraints ++ sc_theta -- NB: rep_pred comes first
1937
1938 -------------------------------------------------------------------
1939 -- Figuring out whether we can only do this newtype-deriving thing
1940
1941 -- See Note [Determining whether newtype-deriving is appropriate]
1942 might_derive_via_coercible
1943 = not (non_coercible_class cls)
1944 && coercion_looks_sensible
1945 -- && not (isRecursiveTyCon tycon) -- Note [Recursive newtypes]
1946 coercion_looks_sensible = eta_ok && ats_ok
1947
1948 -- Check that eta reduction is OK
1949 eta_ok = nt_eta_arity <= length rep_tc_args
1950 -- The newtype can be eta-reduced to match the number
1951 -- of type argument actually supplied
1952 -- newtype T a b = MkT (S [a] b) deriving( Monad )
1953 -- Here the 'b' must be the same in the rep type (S [a] b)
1954 -- And the [a] must not mention 'b'. That's all handled
1955 -- by nt_eta_rity.
1956
1957 ats_ok = null (classATs cls)
1958 -- No associated types for the class, because we don't
1959 -- currently generate type 'instance' decls; and cannot do
1960 -- so for 'data' instance decls
1961
1962 cant_derive_err
1963 = vcat [ ppUnless eta_ok eta_msg
1964 , ppUnless ats_ok ats_msg ]
1965 eta_msg = text "cannot eta-reduce the representation type enough"
1966 ats_msg = text "the class has associated types"
1967
1968 {-
1969 Note [Recursive newtypes]
1970 ~~~~~~~~~~~~~~~~~~~~~~~~~
1971 Newtype deriving works fine, even if the newtype is recursive.
1972 e.g. newtype S1 = S1 [T1 ()]
1973 newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad )
1974 Remember, too, that type families are currently (conservatively) given
1975 a recursive flag, so this also allows newtype deriving to work
1976 for type famillies.
1977
1978 We used to exclude recursive types, because we had a rather simple
1979 minded way of generating the instance decl:
1980 newtype A = MkA [A]
1981 instance Eq [A] => Eq A -- Makes typechecker loop!
1982 But now we require a simple context, so it's ok.
1983
1984 Note [Determining whether newtype-deriving is appropriate]
1985 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1986 When we see
1987 newtype NT = MkNT Foo
1988 deriving C
1989 we have to decide how to perform the deriving. Do we do newtype deriving,
1990 or do we do normal deriving? In general, we prefer to do newtype deriving
1991 wherever possible. So, we try newtype deriving unless there's a glaring
1992 reason not to.
1993
1994 "Glaring reasons not to" include trying to derive a class for which a
1995 coercion-based instance doesn't make sense. These classes are listed in
1996 the definition of non_coercible_class. They include Show (since it must
1997 show the name of the datatype) and Traversable (since a coercion-based
1998 Traversable instance is ill-roled).
1999
2000 However, non_coercible_class is ignored if the user explicitly requests
2001 to derive an instance with GeneralizedNewtypeDeriving using the newtype
2002 deriving strategy. In such a scenario, GHC will unquestioningly try to
2003 derive the instance via coercions (even if the final generated code is
2004 ill-roled!). See Note [Deriving strategies].
2005
2006 Note that newtype deriving might fail, even after we commit to it. This
2007 is because the derived instance uses `coerce`, which must satisfy its
2008 `Coercible` constraint. This is different than other deriving scenarios,
2009 where we're sure that the resulting instance will type-check.
2010
2011 ************************************************************************
2012 * *
2013 Finding the fixed point of deriving equations
2014 * *
2015 ************************************************************************
2016
2017 Note [Simplifying the instance context]
2018 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2019 Consider
2020
2021 data T a b = C1 (Foo a) (Bar b)
2022 | C2 Int (T b a)
2023 | C3 (T a a)
2024 deriving (Eq)
2025
2026 We want to come up with an instance declaration of the form
2027
2028 instance (Ping a, Pong b, ...) => Eq (T a b) where
2029 x == y = ...
2030
2031 It is pretty easy, albeit tedious, to fill in the code "...". The
2032 trick is to figure out what the context for the instance decl is,
2033 namely Ping, Pong and friends.
2034
2035 Let's call the context reqd for the T instance of class C at types
2036 (a,b, ...) C (T a b). Thus:
2037
2038 Eq (T a b) = (Ping a, Pong b, ...)
2039
2040 Now we can get a (recursive) equation from the data decl. This part
2041 is done by inferConstraints.
2042
2043 Eq (T a b) = Eq (Foo a) u Eq (Bar b) -- From C1
2044 u Eq (T b a) u Eq Int -- From C2
2045 u Eq (T a a) -- From C3
2046
2047
2048 Foo and Bar may have explicit instances for Eq, in which case we can
2049 just substitute for them. Alternatively, either or both may have
2050 their Eq instances given by deriving clauses, in which case they
2051 form part of the system of equations.
2052
2053 Now all we need do is simplify and solve the equations, iterating to
2054 find the least fixpoint. This is done by simplifyInstanceConstraints.
2055 Notice that the order of the arguments can
2056 switch around, as here in the recursive calls to T.
2057
2058 Let's suppose Eq (Foo a) = Eq a, and Eq (Bar b) = Ping b.
2059
2060 We start with:
2061
2062 Eq (T a b) = {} -- The empty set
2063
2064 Next iteration:
2065 Eq (T a b) = Eq (Foo a) u Eq (Bar b) -- From C1
2066 u Eq (T b a) u Eq Int -- From C2
2067 u Eq (T a a) -- From C3
2068
2069 After simplification:
2070 = Eq a u Ping b u {} u {} u {}
2071 = Eq a u Ping b
2072
2073 Next iteration:
2074
2075 Eq (T a b) = Eq (Foo a) u Eq (Bar b) -- From C1
2076 u Eq (T b a) u Eq Int -- From C2
2077 u Eq (T a a) -- From C3
2078
2079 After simplification:
2080 = Eq a u Ping b
2081 u (Eq b u Ping a)
2082 u (Eq a u Ping a)
2083
2084 = Eq a u Ping b u Eq b u Ping a
2085
2086 The next iteration gives the same result, so this is the fixpoint. We
2087 need to make a canonical form of the RHS to ensure convergence. We do
2088 this by simplifying the RHS to a form in which
2089
2090 - the classes constrain only tyvars
2091 - the list is sorted by tyvar (major key) and then class (minor key)
2092 - no duplicates, of course
2093
2094 Note [Deterministic simplifyInstanceContexts]
2095 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2096 Canonicalisation uses nonDetCmpType which is nondeterministic. Sorting
2097 with nonDetCmpType puts the returned lists in a nondeterministic order.
2098 If we were to return them, we'd get class constraints in
2099 nondeterministic order.
2100
2101 Consider:
2102
2103 data ADT a b = Z a b deriving Eq
2104
2105 The generated code could be either:
2106
2107 instance (Eq a, Eq b) => Eq (Z a b) where
2108
2109 Or:
2110
2111 instance (Eq b, Eq a) => Eq (Z a b) where
2112
2113 To prevent the order from being nondeterministic we only
2114 canonicalize when comparing and return them in the same order as
2115 simplifyDeriv returned them.
2116 See also Note [nonDetCmpType nondeterminism]
2117 -}
2118
2119
2120 simplifyInstanceContexts :: [DerivSpec ThetaOrigin] -> TcM [DerivSpec ThetaType]
2121 -- Used only for deriving clauses (InferTheta)
2122 -- not for standalone deriving
2123 -- See Note [Simplifying the instance context]
2124
2125 simplifyInstanceContexts [] = return []
2126
2127 simplifyInstanceContexts infer_specs
2128 = do { traceTc "simplifyInstanceContexts" $ vcat (map pprDerivSpec infer_specs)
2129 ; iterate_deriv 1 initial_solutions }
2130 where
2131 ------------------------------------------------------------------
2132 -- The initial solutions for the equations claim that each
2133 -- instance has an empty context; this solution is certainly
2134 -- in canonical form.
2135 initial_solutions :: [ThetaType]
2136 initial_solutions = [ [] | _ <- infer_specs ]
2137
2138 ------------------------------------------------------------------
2139 -- iterate_deriv calculates the next batch of solutions,
2140 -- compares it with the current one; finishes if they are the
2141 -- same, otherwise recurses with the new solutions.
2142 -- It fails if any iteration fails
2143 iterate_deriv :: Int -> [ThetaType] -> TcM [DerivSpec ThetaType]
2144 iterate_deriv n current_solns
2145 | n > 20 -- Looks as if we are in an infinite loop
2146 -- This can happen if we have -XUndecidableInstances
2147 -- (See TcSimplify.tcSimplifyDeriv.)
2148 = pprPanic "solveDerivEqns: probable loop"
2149 (vcat (map pprDerivSpec infer_specs) $$ ppr current_solns)
2150 | otherwise
2151 = do { -- Extend the inst info from the explicit instance decls
2152 -- with the current set of solutions, and simplify each RHS
2153 inst_specs <- zipWithM newDerivClsInst current_solns infer_specs
2154 ; new_solns <- checkNoErrs $
2155 extendLocalInstEnv inst_specs $
2156 mapM gen_soln infer_specs
2157
2158 ; if (current_solns `eqSolution` new_solns) then
2159 return [ spec { ds_theta = soln }
2160 | (spec, soln) <- zip infer_specs current_solns ]
2161 else
2162 iterate_deriv (n+1) new_solns }
2163
2164 eqSolution a b = eqListBy (eqListBy eqType) (canSolution a) (canSolution b)
2165 -- Canonicalise for comparison
2166 -- See Note [Deterministic simplifyInstanceContexts]
2167 canSolution = map (sortBy nonDetCmpType)
2168 ------------------------------------------------------------------
2169 gen_soln :: DerivSpec ThetaOrigin -> TcM ThetaType
2170 gen_soln (DS { ds_loc = loc, ds_tvs = tyvars
2171 , ds_cls = clas, ds_tys = inst_tys, ds_theta = deriv_rhs })
2172 = setSrcSpan loc $
2173 addErrCtxt (derivInstCtxt the_pred) $
2174 do { theta <- simplifyDeriv the_pred tyvars deriv_rhs
2175 -- checkValidInstance tyvars theta clas inst_tys
2176 -- Not necessary; see Note [Exotic derived instance contexts]
2177
2178 ; traceTc "TcDeriv" (ppr deriv_rhs $$ ppr theta)
2179 -- Claim: the result instance declaration is guaranteed valid
2180 -- Hence no need to call:
2181 -- checkValidInstance tyvars theta clas inst_tys
2182 ; return theta }
2183 where
2184 the_pred = mkClassPred clas inst_tys
2185
2186 ------------------------------------------------------------------
2187 newDerivClsInst :: ThetaType -> DerivSpec theta -> TcM ClsInst
2188 newDerivClsInst theta (DS { ds_name = dfun_name, ds_overlap = overlap_mode
2189 , ds_tvs = tvs, ds_cls = clas, ds_tys = tys })
2190 = newClsInst overlap_mode dfun_name tvs theta clas tys
2191
2192 extendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
2193 -- Add new locally-defined instances; don't bother to check
2194 -- for functional dependency errors -- that'll happen in TcInstDcls
2195 extendLocalInstEnv dfuns thing_inside
2196 = do { env <- getGblEnv
2197 ; let inst_env' = extendInstEnvList (tcg_inst_env env) dfuns
2198 env' = env { tcg_inst_env = inst_env' }
2199 ; setGblEnv env' thing_inside }
2200
2201 {-
2202 ***********************************************************************************
2203 * *
2204 * Simplify derived constraints
2205 * *
2206 ***********************************************************************************
2207 -}
2208
2209 -- | Given @instance (wanted) => C inst_ty@, simplify 'wanted' as much
2210 -- as possible. Fail if not possible.
2211 simplifyDeriv :: PredType -- ^ @C inst_ty@, head of the instance we are
2212 -- deriving. Only used for SkolemInfo.
2213 -> [TyVar] -- ^ The tyvars bound by @inst_ty@.
2214 -> ThetaOrigin -- ^ @wanted@ constraints, i.e. @['PredOrigin']@.
2215 -> TcM ThetaType -- ^ Needed constraints (after simplification),
2216 -- i.e. @['PredType']@.
2217 simplifyDeriv pred tvs theta
2218 = do { (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize
2219 -- The constraint solving machinery
2220 -- expects *TcTyVars* not TyVars.
2221 -- We use *non-overlappable* (vanilla) skolems
2222 -- See Note [Overlap and deriving]
2223
2224 ; let skol_set = mkVarSet tvs_skols
2225 skol_info = DerivSkol pred
2226 doc = text "deriving" <+> parens (ppr pred)
2227 mk_ct (PredOrigin t o t_or_k)
2228 = newWanted o (Just t_or_k) (substTy skol_subst t)
2229
2230 -- Generate the wanted constraints with the skolemized variables
2231 ; (wanted, tclvl) <- pushTcLevelM (mapM mk_ct theta)
2232
2233 ; traceTc "simplifyDeriv inputs" $
2234 vcat [ pprTvBndrs tvs $$ ppr theta $$ ppr wanted, doc ]
2235 -- Simplify the constraints
2236 ; residual_wanted <- simplifyWantedsTcM wanted
2237 -- Result is zonked
2238
2239 -- Split the resulting constraints into bad and good constraints,
2240 -- building an @unsolved :: WantedConstraints@ representing all
2241 -- the constraints we can't just shunt to the predicates.
2242 -- See Note [Exotic derived instance contexts]
2243 ; let residual_simple = wc_simple residual_wanted
2244 (bad, good) = partitionBagWith get_good residual_simple
2245 unsolved = residual_wanted { wc_simple = bad }
2246
2247 -- See Note [Exotic derived instance contexts]
2248
2249 get_good :: Ct -> Either Ct PredType
2250 get_good ct | validDerivPred skol_set p
2251 , isWantedCt ct
2252 = Right p
2253 -- NB re 'isWantedCt': residual_wanted may contain
2254 -- unsolved CtDerived and we stick them into the
2255 -- bad set so that reportUnsolved may decide what
2256 -- to do with them
2257 | otherwise
2258 = Left ct
2259 where p = ctPred ct
2260
2261 ; traceTc "simplifyDeriv outputs" $
2262 vcat [ ppr tvs_skols, ppr residual_simple, ppr good, ppr bad ]
2263
2264 -- If we are deferring type errors, simply ignore any insoluble
2265 -- constraints. They'll come up again when we typecheck the
2266 -- generated instance declaration
2267 ; defer <- goptM Opt_DeferTypeErrors
2268 ; (implic, _) <- buildImplicationFor tclvl skol_info tvs_skols [] unsolved
2269 -- The buildImplicationFor is just to bind the skolems,
2270 -- in case they are mentioned in error messages
2271 -- See Trac #11347
2272 -- Report the (bad) unsolved constraints
2273 ; unless defer (reportAllUnsolved (mkImplicWC implic))
2274
2275
2276 -- Return the good unsolved constraints (unskolemizing on the way out.)
2277 ; let min_theta = mkMinimalBySCs (bagToList good)
2278 subst_skol = zipTvSubst tvs_skols $ mkTyVarTys tvs
2279 -- The reverse substitution (sigh)
2280 ; return (substTheta subst_skol min_theta) }
2281
2282 {-
2283 Note [Overlap and deriving]
2284 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
2285 Consider some overlapping instances:
2286 data Show a => Show [a] where ..
2287 data Show [Char] where ...
2288
2289 Now a data type with deriving:
2290 data T a = MkT [a] deriving( Show )
2291
2292 We want to get the derived instance
2293 instance Show [a] => Show (T a) where...
2294 and NOT
2295 instance Show a => Show (T a) where...
2296 so that the (Show (T Char)) instance does the Right Thing
2297
2298 It's very like the situation when we're inferring the type
2299 of a function
2300 f x = show [x]
2301 and we want to infer
2302 f :: Show [a] => a -> String
2303
2304 BOTTOM LINE: use vanilla, non-overlappable skolems when inferring
2305 the context for the derived instance.
2306 Hence tcInstSkolTyVars not tcInstSuperSkolTyVars
2307
2308 Note [Exotic derived instance contexts]
2309 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2310 In a 'derived' instance declaration, we *infer* the context. It's a
2311 bit unclear what rules we should apply for this; the Haskell report is
2312 silent. Obviously, constraints like (Eq a) are fine, but what about
2313 data T f a = MkT (f a) deriving( Eq )
2314 where we'd get an Eq (f a) constraint. That's probably fine too.
2315
2316 One could go further: consider
2317 data T a b c = MkT (Foo a b c) deriving( Eq )
2318 instance (C Int a, Eq b, Eq c) => Eq (Foo a b c)
2319
2320 Notice that this instance (just) satisfies the Paterson termination
2321 conditions. Then we *could* derive an instance decl like this:
2322
2323 instance (C Int a, Eq b, Eq c) => Eq (T a b c)
2324 even though there is no instance for (C Int a), because there just
2325 *might* be an instance for, say, (C Int Bool) at a site where we
2326 need the equality instance for T's.
2327
2328 However, this seems pretty exotic, and it's quite tricky to allow
2329 this, and yet give sensible error messages in the (much more common)
2330 case where we really want that instance decl for C.
2331
2332 So for now we simply require that the derived instance context
2333 should have only type-variable constraints.
2334
2335 Here is another example:
2336 data Fix f = In (f (Fix f)) deriving( Eq )
2337 Here, if we are prepared to allow -XUndecidableInstances we
2338 could derive the instance
2339 instance Eq (f (Fix f)) => Eq (Fix f)
2340 but this is so delicate that I don't think it should happen inside
2341 'deriving'. If you want this, write it yourself!
2342
2343 NB: if you want to lift this condition, make sure you still meet the
2344 termination conditions! If not, the deriving mechanism generates
2345 larger and larger constraints. Example:
2346 data Succ a = S a
2347 data Seq a = Cons a (Seq (Succ a)) | Nil deriving Show
2348
2349 Note the lack of a Show instance for Succ. First we'll generate
2350 instance (Show (Succ a), Show a) => Show (Seq a)
2351 and then
2352 instance (Show (Succ (Succ a)), Show (Succ a), Show a) => Show (Seq a)
2353 and so on. Instead we want to complain of no instance for (Show (Succ a)).
2354
2355 The bottom line
2356 ~~~~~~~~~~~~~~~
2357 Allow constraints which consist only of type variables, with no repeats.
2358
2359
2360 ************************************************************************
2361 * *
2362 \subsection[TcDeriv-normal-binds]{Bindings for the various classes}
2363 * *
2364 ************************************************************************
2365
2366 After all the trouble to figure out the required context for the
2367 derived instance declarations, all that's left is to chug along to
2368 produce them. They will then be shoved into @tcInstDecls2@, which
2369 will do all its usual business.
2370
2371 There are lots of possibilities for code to generate. Here are
2372 various general remarks.
2373
2374 PRINCIPLES:
2375 \begin{itemize}
2376 \item
2377 We want derived instances of @Eq@ and @Ord@ (both v common) to be
2378 ``you-couldn't-do-better-by-hand'' efficient.
2379
2380 \item
2381 Deriving @Show@---also pretty common--- should also be reasonable good code.
2382
2383 \item
2384 Deriving for the other classes isn't that common or that big a deal.
2385 \end{itemize}
2386
2387 PRAGMATICS:
2388
2389 \begin{itemize}
2390 \item
2391 Deriving @Ord@ is done mostly with the 1.3 @compare@ method.
2392
2393 \item
2394 Deriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.
2395
2396 \item
2397 We {\em normally} generate code only for the non-defaulted methods;
2398 there are some exceptions for @Eq@ and (especially) @Ord@...
2399
2400 \item
2401 Sometimes we use a @_con2tag_<tycon>@ function, which returns a data
2402 constructor's numeric (@Int#@) tag. These are generated by
2403 @gen_tag_n_con_binds@, and the heuristic for deciding if one of
2404 these is around is given by @hasCon2TagFun@.
2405
2406 The examples under the different sections below will make this
2407 clearer.
2408
2409 \item
2410 Much less often (really just for deriving @Ix@), we use a
2411 @_tag2con_<tycon>@ function. See the examples.
2412
2413 \item
2414 We use the renamer!!! Reason: we're supposed to be
2415 producing @LHsBinds Name@ for the methods, but that means
2416 producing correctly-uniquified code on the fly. This is entirely
2417 possible (the @TcM@ monad has a @UniqueSupply@), but it is painful.
2418 So, instead, we produce @MonoBinds RdrName@ then heave 'em through
2419 the renamer. What a great hack!
2420 \end{itemize}
2421 -}
2422
2423 -- Generate the InstInfo for the required instance paired with the
2424 -- *representation* tycon for that instance,
2425 -- plus any auxiliary bindings required
2426 --
2427 -- Representation tycons differ from the tycon in the instance signature in
2428 -- case of instances for indexed families.
2429 --
2430 genInst :: DerivSpec ThetaType
2431 -> TcM (InstInfo RdrName, BagDerivStuff, Maybe Name)
2432 genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon
2433 , ds_theta = theta, ds_mechanism = mechanism, ds_tys = tys
2434 , ds_cls = clas, ds_loc = loc })
2435 -- See Note [Bindings for Generalised Newtype Deriving]
2436 | DerivSpecNewtype rhs_ty <- mechanism
2437 = do { inst_spec <- newDerivClsInst theta spec
2438 ; doDerivInstErrorChecks clas inst_spec mechanism
2439 ; return ( InstInfo
2440 { iSpec = inst_spec
2441 , iBinds = InstBindings
2442 { ib_binds = gen_Newtype_binds loc clas
2443 tvs tys rhs_ty
2444 -- Scope over bindings
2445 , ib_tyvars = map Var.varName tvs
2446 , ib_pragmas = []
2447 , ib_extensions = [ LangExt.ImpredicativeTypes
2448 , LangExt.RankNTypes ]
2449 -- Both these flags are needed for higher-rank uses of coerce
2450 -- See Note [Newtype-deriving instances] in TcGenDeriv
2451 , ib_derived = True } }
2452 , emptyBag
2453 , Just $ getName $ head $ tyConDataCons rep_tycon ) }
2454 -- See Note [Newtype deriving and unused constructors]
2455 | otherwise
2456 = do { (meth_binds, deriv_stuff) <- genDerivStuff mechanism loc clas
2457 rep_tycon tys tvs
2458 ; inst_spec <- newDerivClsInst theta spec
2459 ; doDerivInstErrorChecks clas inst_spec mechanism
2460 ; traceTc "newder" (ppr inst_spec)
2461 ; let inst_info
2462 = InstInfo { iSpec = inst_spec
2463 , iBinds = InstBindings
2464 { ib_binds = meth_binds
2465 , ib_tyvars = map Var.varName tvs
2466 , ib_pragmas = []
2467 , ib_extensions = []
2468 , ib_derived = True } }
2469 ; return ( inst_info, deriv_stuff, Nothing ) }
2470
2471 doDerivInstErrorChecks :: Class -> ClsInst -> DerivSpecMechanism -> TcM ()
2472 doDerivInstErrorChecks clas clas_inst mechanism
2473 = do { traceTc "doDerivInstErrorChecks" (ppr clas_inst)
2474 ; dflags <- getDynFlags
2475 -- Check for Generic instances that are derived with an exotic
2476 -- deriving strategy like DAC
2477 -- See Note [Deriving strategies]
2478 ; when (exotic_mechanism && className clas `elem` genericClassNames) $
2479 do { failIfTc (safeLanguageOn dflags) gen_inst_err
2480 ; when (safeInferOn dflags) (recordUnsafeInfer emptyBag) } }
2481 where
2482 exotic_mechanism = case mechanism of
2483 DerivSpecGeneric _ -> False
2484 _ -> True
2485
2486 gen_inst_err = hang (text ("Generic instances can only be derived in "
2487 ++ "Safe Haskell using the stock strategy.") $+$
2488 text "In the following instance:")
2489 2 (pprInstanceHdr clas_inst)
2490
2491 -- Generate the bindings needed for a derived class that isn't handled by
2492 -- -XGeneralizedNewtypeDeriving.
2493 genDerivStuff :: DerivSpecMechanism -> SrcSpan -> Class
2494 -> TyCon -> [Type] -> [TyVar]
2495 -> TcM (LHsBinds RdrName, BagDerivStuff)
2496 genDerivStuff mechanism loc clas tycon inst_tys tyvars
2497 = case mechanism of
2498 -- Special case for DeriveGeneric, since it's monadic
2499 DerivSpecGeneric gen_fn -> do
2500 -- TODO NSF: correctly identify when we're building Both instead of One
2501 (binds, faminst) <- gen_fn tycon inst_tys
2502 return (binds, unitBag (DerivFamInst faminst))
2503
2504 -- The rest of the stock derivers
2505 DerivSpecStock gen_fn -> gen_fn loc tycon
2506
2507 -- If there isn't compiler support for deriving the class, our last
2508 -- resort is -XDeriveAnyClass (since -XGeneralizedNewtypeDeriving
2509 -- fell through).
2510 DerivSpecAnyClass -> do
2511 let mini_env = mkVarEnv (classTyVars clas `zip` inst_tys)
2512 mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
2513 dflags <- getDynFlags
2514 tyfam_insts <-
2515 ASSERT2( isNothing (canDeriveAnyClass dflags tycon clas)
2516 , ppr "genDerivStuff: bad derived class" <+> ppr clas )
2517 mapM (tcATDefault False loc mini_subst emptyNameSet)
2518 (classATItems clas)
2519 return ( emptyBag -- No method bindings are needed...
2520 , listToBag (map DerivFamInst (concat tyfam_insts))
2521 -- ...but we may need to generate binding for associated type
2522 -- family default instances.
2523 -- See Note [DeriveAnyClass and default family instances]
2524 )
2525
2526 _ -> panic "genDerivStuff"
2527
2528 {-
2529 Note [Bindings for Generalised Newtype Deriving]
2530 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2531 Consider
2532 class Eq a => C a where
2533 f :: a -> a
2534 newtype N a = MkN [a] deriving( C )
2535 instance Eq (N a) where ...
2536
2537 The 'deriving C' clause generates, in effect
2538 instance (C [a], Eq a) => C (N a) where
2539 f = coerce (f :: [a] -> [a])
2540
2541 This generates a cast for each method, but allows the superclasse to
2542 be worked out in the usual way. In this case the superclass (Eq (N
2543 a)) will be solved by the explicit Eq (N a) instance. We do *not*
2544 create the superclasses by casting the superclass dictionaries for the
2545 representation type.
2546
2547 See the paper "Safe zero-cost coercions for Haskell".
2548
2549 Note [DeriveAnyClass and default family instances]
2550 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2551
2552 When a class has a associated type family with a default instance, e.g.:
2553
2554 class C a where
2555 type T a
2556 type T a = Char
2557
2558 then there are a couple of scenarios in which a user would expect T a to
2559 default to Char. One is when an instance declaration for C is given without
2560 an implementation for T:
2561
2562 instance C Int
2563
2564 Another scenario in which this can occur is when the -XDeriveAnyClass extension
2565 is used:
2566
2567 data Example = Example deriving (C, Generic)
2568
2569 In the latter case, we must take care to check if C has any associated type
2570 families with default instances, because -XDeriveAnyClass will never provide
2571 an implementation for them. We "fill in" the default instances using the
2572 tcATDefault function from TcClsDcl (which is also used in TcInstDcls to handle
2573 the empty instance declaration case).
2574
2575 Note [Deriving strategies]
2576 ~~~~~~~~~~~~~~~~~~~~~~~~~~
2577 GHC has a notion of deriving strategies, which allow the user to explicitly
2578 request which approach to use when deriving an instance (enabled with the
2579 -XDerivingStrategies language extension). For more information, refer to the
2580 original Trac ticket (#10598) or the associated wiki page:
2581 https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies
2582
2583 A deriving strategy can be specified in a deriving clause:
2584
2585 newtype Foo = MkFoo Bar
2586 deriving newtype C
2587
2588 Or in a standalone deriving declaration:
2589
2590 deriving anyclass instance C Foo
2591
2592 -XDerivingStrategies also allows the use of multiple deriving clauses per data
2593 declaration so that a user can derive some instance with one deriving strategy
2594 and other instances with another deriving strategy. For example:
2595
2596 newtype Baz = Baz Quux
2597 deriving (Eq, Ord)
2598 deriving stock (Read, Show)
2599 deriving newtype (Num, Floating)
2600 deriving anyclass C
2601
2602 Currently, the deriving strategies are:
2603
2604 * stock: Have GHC implement a "standard" instance for a data type, if possible
2605 (e.g., Eq, Ord, Generic, Data, Functor, etc.)
2606
2607 * anyclass: Use -XDeriveAnyClass
2608
2609 * newtype: Use -XGeneralizedNewtypeDeriving
2610
2611 If an explicit deriving strategy is not given, GHC has an algorithm it uses to
2612 determine which strategy it will actually use. The algorithm is quite long,
2613 so it lives in the Haskell wiki at
2614 https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies
2615 ("The deriving strategy resolution algorithm" section).
2616
2617 Internally, GHC uses the DerivStrategy datatype to denote a user-requested
2618 deriving strategy, and it uses the DerivSpecMechanism datatype to denote what
2619 GHC will use to derive the instance after taking the above steps. In other
2620 words, GHC will always settle on a DerivSpecMechnism, even if the user did not
2621 ask for a particular DerivStrategy (using the algorithm linked to above).
2622
2623 ************************************************************************
2624 * *
2625 \subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
2626 * *
2627 ************************************************************************
2628 -}
2629
2630 derivingNullaryErr :: MsgDoc
2631 derivingNullaryErr = text "Cannot derive instances for nullary classes"
2632
2633 derivingKindErr :: TyCon -> Class -> [Type] -> Kind -> Bool -> MsgDoc
2634 derivingKindErr tc cls cls_tys cls_kind enough_args
2635 = sep [ hang (text "Cannot derive well-kinded instance of form"
2636 <+> quotes (pprClassPred cls cls_tys
2637 <+> parens (ppr tc <+> text "...")))
2638 2 gen1_suggestion
2639 , nest 2 (text "Class" <+> quotes (ppr cls)
2640 <+> text "expects an argument of kind"
2641 <+> quotes (pprKind cls_kind))
2642 ]
2643 where
2644 gen1_suggestion | cls `hasKey` gen1ClassKey && enough_args
2645 = text "(Perhaps you intended to use PolyKinds)"
2646 | otherwise = Outputable.empty
2647
2648 derivingEtaErr :: Class -> [Type] -> Type -> MsgDoc
2649 derivingEtaErr cls cls_tys inst_ty
2650 = sep [text "Cannot eta-reduce to an instance of form",
2651 nest 2 (text "instance (...) =>"
2652 <+> pprClassPred cls (cls_tys ++ [inst_ty]))]
2653
2654 derivingThingErr :: Bool -> Class -> [Type] -> Type -> Maybe DerivStrategy
2655 -> MsgDoc -> MsgDoc
2656 derivingThingErr newtype_deriving clas tys ty deriv_strat why
2657 = sep [(hang (text "Can't make a derived instance of")
2658 2 (quotes (ppr pred) <+> via_mechanism)
2659 $$ nest 2 extra) <> colon,
2660 nest 2 why]
2661 where
2662 extra | Nothing <- deriv_strat, newtype_deriving
2663 = text "(even with cunning GeneralizedNewtypeDeriving)"
2664 | otherwise = Outputable.empty
2665 pred = mkClassPred clas (tys ++ [ty])
2666 via_mechanism = case deriv_strat of
2667 Just strat -> text "with the" <+> ppr strat
2668 <+> text "strategy"
2669 Nothing -> empty
2670
2671 derivingHiddenErr :: TyCon -> SDoc
2672 derivingHiddenErr tc
2673 = hang (text "The data constructors of" <+> quotes (ppr tc) <+> ptext (sLit "are not all in scope"))
2674 2 (text "so you cannot derive an instance for it")
2675
2676 standaloneCtxt :: LHsSigType Name -> SDoc
2677 standaloneCtxt ty = hang (text "In the stand-alone deriving instance for")
2678 2 (quotes (ppr ty))
2679
2680 derivInstCtxt :: PredType -> MsgDoc
2681 derivInstCtxt pred
2682 = text "When deriving the instance for" <+> parens (ppr pred)
2683
2684 unboxedTyConErr :: String -> MsgDoc
2685 unboxedTyConErr thing =
2686 text "The last argument of the instance cannot be an unboxed" <+> text thing