8076115b6c8d1045654cdfad67e14f213ace7d82
[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
11 module TcDeriv ( tcDeriving, DerivInfo(..), mkDerivInfos ) where
12
13 #include "HsVersions.h"
14
15 import HsSyn
16 import DynFlags
17
18 import TcRnMonad
19 import FamInst
20 import TcDerivInfer
21 import TcDerivUtils
22 import TcValidity( allDistinctTyVars )
23 import TcClassDcl( tcATDefault, tcMkDeclCtxt )
24 import TcEnv
25 import TcGenDeriv -- Deriv stuff
26 import InstEnv
27 import Inst
28 import FamInstEnv
29 import TcHsType
30 import TcMType
31
32 import RnNames( extendGlobalRdrEnvRn )
33 import RnBinds
34 import RnEnv
35 import RnUtils ( bindLocalNamesFV )
36 import RnSource ( addTcgDUs )
37 import Avail
38
39 import Unify( tcUnifyTy )
40 import BasicTypes ( DerivStrategy(..) )
41 import Class
42 import Type
43 import ErrUtils
44 import DataCon
45 import Maybes
46 import RdrName
47 import Name
48 import NameSet
49 import TyCon
50 import TcType
51 import Var
52 import VarEnv
53 import VarSet
54 import PrelNames
55 import SrcLoc
56 import Util
57 import Outputable
58 import FastString
59 import Bag
60 import Pair
61 import FV (fvVarList, unionFV, mkFVs)
62 import qualified GHC.LanguageExtensions as LangExt
63
64 import Control.Monad
65 import Data.List
66
67 {-
68 ************************************************************************
69 * *
70 Overview
71 * *
72 ************************************************************************
73
74 Overall plan
75 ~~~~~~~~~~~~
76 1. Convert the decls (i.e. data/newtype deriving clauses,
77 plus standalone deriving) to [EarlyDerivSpec]
78
79 2. Infer the missing contexts for the InferTheta's
80
81 3. Add the derived bindings, generating InstInfos
82 -}
83
84 data EarlyDerivSpec = InferTheta (DerivSpec [ThetaOrigin])
85 | GivenTheta (DerivSpec ThetaType)
86 -- InferTheta ds => the context for the instance should be inferred
87 -- In this case ds_theta is the list of all the sets of
88 -- constraints needed, such as (Eq [a], Eq a), together with a
89 -- suitable CtLoc to get good error messages.
90 -- The inference process is to reduce this to a
91 -- simpler form (e.g. Eq a)
92 --
93 -- GivenTheta ds => the exact context for the instance is supplied
94 -- by the programmer; it is ds_theta
95 -- See Note [Inferring the instance context] in TcDerivInfer
96
97 earlyDSLoc :: EarlyDerivSpec -> SrcSpan
98 earlyDSLoc (InferTheta spec) = ds_loc spec
99 earlyDSLoc (GivenTheta spec) = ds_loc spec
100
101 splitEarlyDerivSpec :: [EarlyDerivSpec]
102 -> ([DerivSpec [ThetaOrigin]], [DerivSpec ThetaType])
103 splitEarlyDerivSpec [] = ([],[])
104 splitEarlyDerivSpec (InferTheta spec : specs) =
105 case splitEarlyDerivSpec specs of (is, gs) -> (spec : is, gs)
106 splitEarlyDerivSpec (GivenTheta spec : specs) =
107 case splitEarlyDerivSpec specs of (is, gs) -> (is, spec : gs)
108
109 instance Outputable EarlyDerivSpec where
110 ppr (InferTheta spec) = ppr spec <+> text "(Infer)"
111 ppr (GivenTheta spec) = ppr spec <+> text "(Given)"
112
113 {-
114 Note [Data decl contexts]
115 ~~~~~~~~~~~~~~~~~~~~~~~~~
116 Consider
117
118 data (RealFloat a) => Complex a = !a :+ !a deriving( Read )
119
120 We will need an instance decl like:
121
122 instance (Read a, RealFloat a) => Read (Complex a) where
123 ...
124
125 The RealFloat in the context is because the read method for Complex is bound
126 to construct a Complex, and doing that requires that the argument type is
127 in RealFloat.
128
129 But this ain't true for Show, Eq, Ord, etc, since they don't construct
130 a Complex; they only take them apart.
131
132 Our approach: identify the offending classes, and add the data type
133 context to the instance decl. The "offending classes" are
134
135 Read, Enum?
136
137 FURTHER NOTE ADDED March 2002. In fact, Haskell98 now requires that
138 pattern matching against a constructor from a data type with a context
139 gives rise to the constraints for that context -- or at least the thinned
140 version. So now all classes are "offending".
141
142 Note [Newtype deriving]
143 ~~~~~~~~~~~~~~~~~~~~~~~
144 Consider this:
145 class C a b
146 instance C [a] Char
147 newtype T = T Char deriving( C [a] )
148
149 Notice the free 'a' in the deriving. We have to fill this out to
150 newtype T = T Char deriving( forall a. C [a] )
151
152 And then translate it to:
153 instance C [a] Char => C [a] T where ...
154
155
156 Note [Newtype deriving superclasses]
157 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
158 (See also Trac #1220 for an interesting exchange on newtype
159 deriving and superclasses.)
160
161 The 'tys' here come from the partial application in the deriving
162 clause. The last arg is the new instance type.
163
164 We must pass the superclasses; the newtype might be an instance
165 of them in a different way than the representation type
166 E.g. newtype Foo a = Foo a deriving( Show, Num, Eq )
167 Then the Show instance is not done via Coercible; it shows
168 Foo 3 as "Foo 3"
169 The Num instance is derived via Coercible, but the Show superclass
170 dictionary must the Show instance for Foo, *not* the Show dictionary
171 gotten from the Num dictionary. So we must build a whole new dictionary
172 not just use the Num one. The instance we want is something like:
173 instance (Num a, Show (Foo a), Eq (Foo a)) => Num (Foo a) where
174 (+) = ((+)@a)
175 ...etc...
176 There may be a coercion needed which we get from the tycon for the newtype
177 when the dict is constructed in TcInstDcls.tcInstDecl2
178
179
180 Note [Unused constructors and deriving clauses]
181 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
182 See Trac #3221. Consider
183 data T = T1 | T2 deriving( Show )
184 Are T1 and T2 unused? Well, no: the deriving clause expands to mention
185 both of them. So we gather defs/uses from deriving just like anything else.
186
187 -}
188
189 -- | Stuff needed to process a datatype's `deriving` clauses
190 data DerivInfo = DerivInfo { di_rep_tc :: TyCon
191 -- ^ The data tycon for normal datatypes,
192 -- or the *representation* tycon for data families
193 , di_clauses :: [LHsDerivingClause Name]
194 , di_ctxt :: SDoc -- ^ error context
195 }
196
197 -- | Extract `deriving` clauses of proper data type (skips data families)
198 mkDerivInfos :: [LTyClDecl Name] -> TcM [DerivInfo]
199 mkDerivInfos decls = concatMapM (mk_deriv . unLoc) decls
200 where
201
202 mk_deriv decl@(DataDecl { tcdLName = L _ data_name
203 , tcdDataDefn =
204 HsDataDefn { dd_derivs = L _ clauses } })
205 = do { tycon <- tcLookupTyCon data_name
206 ; return [DerivInfo { di_rep_tc = tycon, di_clauses = clauses
207 , di_ctxt = tcMkDeclCtxt decl }] }
208 mk_deriv _ = return []
209
210 {-
211
212 ************************************************************************
213 * *
214 \subsection[TcDeriv-driver]{Top-level function for \tr{derivings}}
215 * *
216 ************************************************************************
217 -}
218
219 tcDeriving :: [DerivInfo] -- All `deriving` clauses
220 -> [LDerivDecl Name] -- All stand-alone deriving declarations
221 -> TcM (TcGblEnv, Bag (InstInfo Name), HsValBinds Name)
222 tcDeriving deriv_infos deriv_decls
223 = recoverM (do { g <- getGblEnv
224 ; return (g, emptyBag, emptyValBindsOut)}) $
225 do { -- Fish the "deriving"-related information out of the TcEnv
226 -- And make the necessary "equations".
227 is_boot <- tcIsHsBootOrSig
228 ; traceTc "tcDeriving" (ppr is_boot)
229
230 ; early_specs <- makeDerivSpecs is_boot deriv_infos deriv_decls
231 ; traceTc "tcDeriving 1" (ppr early_specs)
232
233 ; let (infer_specs, given_specs) = splitEarlyDerivSpec early_specs
234 ; insts1 <- mapM genInst given_specs
235 ; insts2 <- mapM genInst infer_specs
236
237 ; dflags <- getDynFlags
238
239 ; let (_, deriv_stuff, maybe_fvs) = unzip3 (insts1 ++ insts2)
240 ; loc <- getSrcSpanM
241 ; let (binds, famInsts) = genAuxBinds dflags loc
242 (unionManyBags deriv_stuff)
243
244 ; let mk_inst_infos1 = map fstOf3 insts1
245 ; inst_infos1 <- apply_inst_infos mk_inst_infos1 given_specs
246
247 -- We must put all the derived type family instances (from both
248 -- infer_specs and given_specs) in the local instance environment
249 -- before proceeding, or else simplifyInstanceContexts might
250 -- get stuck if it has to reason about any of those family instances.
251 -- See Note [Staging of tcDeriving]
252 ; tcExtendLocalFamInstEnv (bagToList famInsts) $
253 -- NB: only call tcExtendLocalFamInstEnv once, as it performs
254 -- validity checking for all of the family instances you give it.
255 -- If the family instances have errors, calling it twice will result
256 -- in duplicate error messages!
257
258 do {
259 -- the stand-alone derived instances (@inst_infos1@) are used when
260 -- inferring the contexts for "deriving" clauses' instances
261 -- (@infer_specs@)
262 ; final_specs <- extendLocalInstEnv (map iSpec inst_infos1) $
263 simplifyInstanceContexts infer_specs
264
265 ; let mk_inst_infos2 = map fstOf3 insts2
266 ; inst_infos2 <- apply_inst_infos mk_inst_infos2 final_specs
267 ; let inst_infos = inst_infos1 ++ inst_infos2
268
269 ; (inst_info, rn_binds, rn_dus) <-
270 renameDeriv is_boot inst_infos binds
271
272 ; unless (isEmptyBag inst_info) $
273 liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances"
274 (ddump_deriving inst_info rn_binds famInsts))
275
276 ; gbl_env <- tcExtendLocalInstEnv (map iSpec (bagToList inst_info))
277 getGblEnv
278 ; let all_dus = rn_dus `plusDU` usesOnly (NameSet.mkFVs $ catMaybes maybe_fvs)
279 ; return (addTcgDUs gbl_env all_dus, inst_info, rn_binds) } }
280 where
281 ddump_deriving :: Bag (InstInfo Name) -> HsValBinds Name
282 -> Bag FamInst -- ^ Rep type family instances
283 -> SDoc
284 ddump_deriving inst_infos extra_binds repFamInsts
285 = hang (text "Derived class instances:")
286 2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") (bagToList inst_infos))
287 $$ ppr extra_binds)
288 $$ hangP "Derived type family instances:"
289 (vcat (map pprRepTy (bagToList repFamInsts)))
290
291 hangP s x = text "" $$ hang (ptext (sLit s)) 2 x
292
293 -- Apply the suspended computations given by genInst calls.
294 -- See Note [Staging of tcDeriving]
295 apply_inst_infos :: [ThetaType -> TcM (InstInfo RdrName)]
296 -> [DerivSpec ThetaType] -> TcM [InstInfo RdrName]
297 apply_inst_infos = zipWithM (\f ds -> f (ds_theta ds))
298
299 -- Prints the representable type family instance
300 pprRepTy :: FamInst -> SDoc
301 pprRepTy fi@(FamInst { fi_tys = lhs })
302 = text "type" <+> ppr (mkTyConApp (famInstTyCon fi) lhs) <+>
303 equals <+> ppr rhs
304 where rhs = famInstRHS fi
305
306 renameDeriv :: Bool
307 -> [InstInfo RdrName]
308 -> Bag (LHsBind RdrName, LSig RdrName)
309 -> TcM (Bag (InstInfo Name), HsValBinds Name, DefUses)
310 renameDeriv is_boot inst_infos bagBinds
311 | is_boot -- If we are compiling a hs-boot file, don't generate any derived bindings
312 -- The inst-info bindings will all be empty, but it's easier to
313 -- just use rn_inst_info to change the type appropriately
314 = do { (rn_inst_infos, fvs) <- mapAndUnzipM rn_inst_info inst_infos
315 ; return ( listToBag rn_inst_infos
316 , emptyValBindsOut, usesOnly (plusFVs fvs)) }
317
318 | otherwise
319 = discardWarnings $
320 -- Discard warnings about unused bindings etc
321 setXOptM LangExt.EmptyCase $
322 -- Derived decls (for empty types) can have
323 -- case x of {}
324 setXOptM LangExt.ScopedTypeVariables $
325 setXOptM LangExt.KindSignatures $
326 -- Derived decls (for newtype-deriving) can use ScopedTypeVariables &
327 -- KindSignatures
328 unsetXOptM LangExt.RebindableSyntax $
329 -- See Note [Avoid RebindableSyntax when deriving]
330 do {
331 -- Bring the extra deriving stuff into scope
332 -- before renaming the instances themselves
333 ; traceTc "rnd" (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos))
334 ; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds
335 ; let aux_val_binds = ValBindsIn aux_binds (bagToList aux_sigs)
336 ; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
337 ; let bndrs = collectHsValBinders rn_aux_lhs
338 ; envs <- extendGlobalRdrEnvRn (map avail bndrs) emptyFsEnv ;
339 ; setEnvs envs $
340 do { (rn_aux, dus_aux) <- rnValBindsRHS (TopSigCtxt (mkNameSet bndrs)) rn_aux_lhs
341 ; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
342 ; return (listToBag rn_inst_infos, rn_aux,
343 dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
344
345 where
346 rn_inst_info :: InstInfo RdrName -> TcM (InstInfo Name, FreeVars)
347 rn_inst_info
348 inst_info@(InstInfo { iSpec = inst
349 , iBinds = InstBindings
350 { ib_binds = binds
351 , ib_tyvars = tyvars
352 , ib_pragmas = sigs
353 , ib_extensions = exts -- Only for type-checking
354 , ib_derived = sa } })
355 = ASSERT( null sigs )
356 bindLocalNamesFV tyvars $
357 do { (rn_binds,_, fvs) <- rnMethodBinds False (is_cls_nm inst) [] binds []
358 ; let binds' = InstBindings { ib_binds = rn_binds
359 , ib_tyvars = tyvars
360 , ib_pragmas = []
361 , ib_extensions = exts
362 , ib_derived = sa }
363 ; return (inst_info { iBinds = binds' }, fvs) }
364
365 {-
366 Note [Newtype deriving and unused constructors]
367 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
368 Consider this (see Trac #1954):
369
370 module Bug(P) where
371 newtype P a = MkP (IO a) deriving Monad
372
373 If you compile with -Wunused-binds you do not expect the warning
374 "Defined but not used: data constructor MkP". Yet the newtype deriving
375 code does not explicitly mention MkP, but it should behave as if you
376 had written
377 instance Monad P where
378 return x = MkP (return x)
379 ...etc...
380
381 So we want to signal a user of the data constructor 'MkP'.
382 This is the reason behind the (Maybe Name) part of the return type
383 of genInst.
384
385 Note [Staging of tcDeriving]
386 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
387 Here's a tricky corner case for deriving (adapted from Trac #2721):
388
389 class C a where
390 type T a
391 foo :: a -> T a
392
393 instance C Int where
394 type T Int = Int
395 foo = id
396
397 newtype N = N Int deriving C
398
399 This will produce an instance something like this:
400
401 instance C N where
402 type T N = T Int
403 foo = coerce (foo :: Int -> T Int) :: N -> T N
404
405 We must be careful in order to typecheck this code. When determining the
406 context for the instance (in simplifyInstanceContexts), we need to determine
407 that T N and T Int have the same representation, but to do that, the T N
408 instance must be in the local family instance environment. Otherwise, GHC
409 would be unable to conclude that T Int is representationally equivalent to
410 T Int, and simplifyInstanceContexts would get stuck.
411
412 Previously, tcDeriving would defer adding any derived type family instances to
413 the instance environment until the very end, which meant that
414 simplifyInstanceContexts would get called without all the type family instances
415 it needed in the environment in order to properly simplify instance like
416 the C N instance above.
417
418 To avoid this scenario, we carefully structure the order of events in
419 tcDeriving. We first call genInst on the standalone derived instance specs and
420 the instance specs obtained from deriving clauses. Note that the return type of
421 genInst is a triple:
422
423 TcM (ThetaType -> TcM (InstInfo RdrName), BagDerivStuff, Maybe Name)
424
425 The type family instances are in the BagDerivStuff. The first field of the
426 triple is a suspended computation which, given an instance context, produces
427 the rest of the instance. The fact that it is suspended is important, because
428 right now, we don't have ThetaTypes for the instances that use deriving clauses
429 (only the standalone-derived ones).
430
431 Now we can can collect the type family instances and extend the local instance
432 environment. At this point, it is safe to run simplifyInstanceContexts on the
433 deriving-clause instance specs, which gives us the ThetaTypes for the
434 deriving-clause instances. Now we can feed all the ThetaTypes to the
435 suspended computations and obtain our InstInfos, at which point
436 tcDeriving is done.
437
438 An alternative design would be to split up genInst so that the
439 family instances are generated separately from the InstInfos. But this would
440 require carving up a lot of the GHC deriving internals to accommodate the
441 change. On the other hand, we can keep all of the InstInfo and type family
442 instance logic together in genInst simply by converting genInst to
443 continuation-returning style, so we opt for that route.
444
445 Note [Why we don't pass rep_tc into deriveTyData]
446 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
447 Down in the bowels of mkEqnHelp, we need to convert the fam_tc back into
448 the rep_tc by means of a lookup. And yet we have the rep_tc right here!
449 Why look it up again? Answer: it's just easier this way.
450 We drop some number of arguments from the end of the datatype definition
451 in deriveTyData. The arguments are dropped from the fam_tc.
452 This action may drop a *different* number of arguments
453 passed to the rep_tc, depending on how many free variables, etc., the
454 dropped patterns have.
455
456 Also, this technique carries over the kind substitution from deriveTyData
457 nicely.
458
459 Note [Avoid RebindableSyntax when deriving]
460 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
461 The RebindableSyntax extension interacts awkwardly with the derivation of
462 any stock class whose methods require the use of string literals. The Show
463 class is a simple example (see Trac #12688):
464
465 {-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
466 newtype Text = Text String
467 fromString :: String -> Text
468 fromString = Text
469
470 data Foo = Foo deriving Show
471
472 This will generate code to the effect of:
473
474 instance Show Foo where
475 showsPrec _ Foo = showString "Foo"
476
477 But because RebindableSyntax and OverloadedStrings are enabled, the "Foo"
478 string literal is now of type Text, not String, which showString doesn't
479 accept! This causes the generated Show instance to fail to typecheck.
480
481 To avoid this kind of scenario, we simply turn off RebindableSyntax entirely
482 in derived code.
483
484 ************************************************************************
485 * *
486 From HsSyn to DerivSpec
487 * *
488 ************************************************************************
489
490 @makeDerivSpecs@ fishes around to find the info about needed derived instances.
491 -}
492
493 makeDerivSpecs :: Bool
494 -> [DerivInfo]
495 -> [LDerivDecl Name]
496 -> TcM [EarlyDerivSpec]
497 makeDerivSpecs is_boot deriv_infos deriv_decls
498 = do { eqns1 <- concatMapM (recoverM (return []) . deriveDerivInfo) deriv_infos
499 ; eqns2 <- concatMapM (recoverM (return []) . deriveStandalone) deriv_decls
500 ; let eqns = eqns1 ++ eqns2
501
502 ; if is_boot then -- No 'deriving' at all in hs-boot files
503 do { unless (null eqns) (add_deriv_err (head eqns))
504 ; return [] }
505 else return eqns }
506 where
507 add_deriv_err eqn
508 = setSrcSpan (earlyDSLoc eqn) $
509 addErr (hang (text "Deriving not permitted in hs-boot file")
510 2 (text "Use an instance declaration instead"))
511
512 ------------------------------------------------------------------
513 -- | Process a `deriving` clause
514 deriveDerivInfo :: DerivInfo -> TcM [EarlyDerivSpec]
515 deriveDerivInfo (DerivInfo { di_rep_tc = rep_tc, di_clauses = clauses
516 , di_ctxt = err_ctxt })
517 = addErrCtxt err_ctxt $
518 concatMapM (deriveForClause . unLoc) clauses
519 where
520 tvs = tyConTyVars rep_tc
521 (tc, tys) = case tyConFamInstSig_maybe rep_tc of
522 -- data family:
523 Just (fam_tc, pats, _) -> (fam_tc, pats)
524 -- NB: deriveTyData wants the *user-specified*
525 -- name. See Note [Why we don't pass rep_tc into deriveTyData]
526
527 _ -> (rep_tc, mkTyVarTys tvs) -- datatype
528
529 deriveForClause :: HsDerivingClause Name -> TcM [EarlyDerivSpec]
530 deriveForClause (HsDerivingClause { deriv_clause_strategy = dcs
531 , deriv_clause_tys = L _ preds })
532 = concatMapM (deriveTyData tvs tc tys (fmap unLoc dcs)) preds
533
534 ------------------------------------------------------------------
535 deriveStandalone :: LDerivDecl Name -> TcM [EarlyDerivSpec]
536 -- Standalone deriving declarations
537 -- e.g. deriving instance Show a => Show (T a)
538 -- Rather like tcLocalInstDecl
539 deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode))
540 = setSrcSpan loc $
541 addErrCtxt (standaloneCtxt deriv_ty) $
542 do { traceTc "Standalone deriving decl for" (ppr deriv_ty)
543 ; let deriv_strat = fmap unLoc deriv_strat'
544 ; traceTc "Deriving strategy (standalone deriving)" $
545 vcat [ppr deriv_strat, ppr deriv_ty]
546 ; (tvs, theta, cls, inst_tys) <- tcHsClsInstType TcType.InstDeclCtxt deriv_ty
547 ; traceTc "Standalone deriving;" $ vcat
548 [ text "tvs:" <+> ppr tvs
549 , text "theta:" <+> ppr theta
550 , text "cls:" <+> ppr cls
551 , text "tys:" <+> ppr inst_tys ]
552 -- C.f. TcInstDcls.tcLocalInstDecl1
553 ; checkTc (not (null inst_tys)) derivingNullaryErr
554
555 ; let cls_tys = take (length inst_tys - 1) inst_tys
556 inst_ty = last inst_tys
557 ; traceTc "Standalone deriving:" $ vcat
558 [ text "class:" <+> ppr cls
559 , text "class types:" <+> ppr cls_tys
560 , text "type:" <+> ppr inst_ty ]
561
562 ; let bale_out msg = failWithTc (derivingThingErr False cls cls_tys
563 inst_ty deriv_strat msg)
564
565 ; case tcSplitTyConApp_maybe inst_ty of
566 Just (tc, tc_args)
567 | className cls == typeableClassName
568 -> do warnUselessTypeable
569 return []
570
571 | isUnboxedTupleTyCon tc
572 -> bale_out $ unboxedTyConErr "tuple"
573
574 | isUnboxedSumTyCon tc
575 -> bale_out $ unboxedTyConErr "sum"
576
577 | isAlgTyCon tc || isDataFamilyTyCon tc -- All other classes
578 -> do { spec <- mkEqnHelp (fmap unLoc overlap_mode)
579 tvs cls cls_tys tc tc_args
580 (Just theta) deriv_strat
581 ; return [spec] }
582
583 _ -> -- Complain about functions, primitive types, etc,
584 bale_out $
585 text "The last argument of the instance must be a data or newtype application"
586 }
587
588 warnUselessTypeable :: TcM ()
589 warnUselessTypeable
590 = do { warn <- woptM Opt_WarnDerivingTypeable
591 ; when warn $ addWarnTc (Reason Opt_WarnDerivingTypeable)
592 $ text "Deriving" <+> quotes (ppr typeableClassName) <+>
593 text "has no effect: all types now auto-derive Typeable" }
594
595 ------------------------------------------------------------------
596 deriveTyData :: [TyVar] -> TyCon -> [Type] -- LHS of data or data instance
597 -- Can be a data instance, hence [Type] args
598 -> Maybe DerivStrategy -- The optional deriving strategy
599 -> LHsSigType Name -- The deriving predicate
600 -> TcM [EarlyDerivSpec]
601 -- The deriving clause of a data or newtype declaration
602 -- I.e. not standalone deriving
603 deriveTyData tvs tc tc_args deriv_strat deriv_pred
604 = setSrcSpan (getLoc (hsSigType deriv_pred)) $ -- Use loc of the 'deriving' item
605 do { (deriv_tvs, cls, cls_tys, cls_arg_kinds)
606 <- tcExtendTyVarEnv tvs $
607 tcHsDeriv deriv_pred
608 -- Deriving preds may (now) mention
609 -- the type variables for the type constructor, hence tcExtendTyVarenv
610 -- The "deriv_pred" is a LHsType to take account of the fact that for
611 -- newtype deriving we allow deriving (forall a. C [a]).
612
613 -- Typeable is special, because Typeable :: forall k. k -> Constraint
614 -- so the argument kind 'k' is not decomposable by splitKindFunTys
615 -- as is the case for all other derivable type classes
616 ; when (length cls_arg_kinds /= 1) $
617 failWithTc (nonUnaryErr deriv_pred)
618 ; let [cls_arg_kind] = cls_arg_kinds
619 ; if className cls == typeableClassName
620 then do warnUselessTypeable
621 return []
622 else
623
624 do { -- Given data T a b c = ... deriving( C d ),
625 -- we want to drop type variables from T so that (C d (T a)) is well-kinded
626 let (arg_kinds, _) = splitFunTys cls_arg_kind
627 n_args_to_drop = length arg_kinds
628 n_args_to_keep = tyConArity tc - n_args_to_drop
629 (tc_args_to_keep, args_to_drop)
630 = splitAt n_args_to_keep tc_args
631 inst_ty_kind = typeKind (mkTyConApp tc tc_args_to_keep)
632
633 -- Match up the kinds, and apply the resulting kind substitution
634 -- to the types. See Note [Unify kinds in deriving]
635 -- We are assuming the tycon tyvars and the class tyvars are distinct
636 mb_match = tcUnifyTy inst_ty_kind cls_arg_kind
637 enough_args = n_args_to_keep >= 0
638
639 -- Check that the result really is well-kinded
640 ; checkTc (enough_args && isJust mb_match)
641 (derivingKindErr tc cls cls_tys cls_arg_kind enough_args)
642
643 ; let Just kind_subst = mb_match
644 ki_subst_range = getTCvSubstRangeFVs kind_subst
645 all_tkvs = toposortTyVars $
646 fvVarList $ unionFV
647 (tyCoFVsOfTypes tc_args_to_keep)
648 (FV.mkFVs deriv_tvs)
649 -- See Note [Unification of two kind variables in deriving]
650 unmapped_tkvs = filter (\v -> v `notElemTCvSubst` kind_subst
651 && not (v `elemVarSet` ki_subst_range))
652 all_tkvs
653 (subst, _) = mapAccumL substTyVarBndr
654 kind_subst unmapped_tkvs
655 final_tc_args = substTys subst tc_args_to_keep
656 final_cls_tys = substTys subst cls_tys
657 tkvs = tyCoVarsOfTypesWellScoped $
658 final_cls_tys ++ final_tc_args
659
660 ; traceTc "Deriving strategy (deriving clause)" $
661 vcat [ppr deriv_strat, ppr deriv_pred]
662
663 ; traceTc "derivTyData1" (vcat [ pprTyVars tvs, ppr tc, ppr tc_args
664 , ppr deriv_pred
665 , pprTyVars (tyCoVarsOfTypesList tc_args)
666 , ppr n_args_to_keep, ppr n_args_to_drop
667 , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
668 , ppr final_tc_args, ppr final_cls_tys ])
669
670 ; traceTc "derivTyData2" (vcat [ ppr tkvs ])
671
672 ; checkTc (allDistinctTyVars (mkVarSet tkvs) args_to_drop) -- (a, b, c)
673 (derivingEtaErr cls final_cls_tys (mkTyConApp tc final_tc_args))
674 -- Check that
675 -- (a) The args to drop are all type variables; eg reject:
676 -- data instance T a Int = .... deriving( Monad )
677 -- (b) The args to drop are all *distinct* type variables; eg reject:
678 -- class C (a :: * -> * -> *) where ...
679 -- data instance T a a = ... deriving( C )
680 -- (c) The type class args, or remaining tycon args,
681 -- do not mention any of the dropped type variables
682 -- newtype T a s = ... deriving( ST s )
683 -- newtype instance K a a = ... deriving( Monad )
684 --
685 -- It is vital that the implementation of allDistinctTyVars
686 -- expand any type synonyms.
687 -- See Note [Eta-reducing type synonyms]
688
689 ; spec <- mkEqnHelp Nothing tkvs
690 cls final_cls_tys tc final_tc_args
691 Nothing deriv_strat
692 ; traceTc "derivTyData" (ppr spec)
693 ; return [spec] } }
694
695
696 {-
697 Note [Unify kinds in deriving]
698 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
699 Consider (Trac #8534)
700 data T a b = MkT a deriving( Functor )
701 -- where Functor :: (*->*) -> Constraint
702
703 So T :: forall k. * -> k -> *. We want to get
704 instance Functor (T * (a:*)) where ...
705 Notice the '*' argument to T.
706
707 Moreover, as well as instantiating T's kind arguments, we may need to instantiate
708 C's kind args. Consider (Trac #8865):
709 newtype T a b = MkT (Either a b) deriving( Category )
710 where
711 Category :: forall k. (k -> k -> *) -> Constraint
712 We need to generate the instance
713 instance Category * (Either a) where ...
714 Notice the '*' argument to Category.
715
716 So we need to
717 * drop arguments from (T a b) to match the number of
718 arrows in the (last argument of the) class;
719 * and then *unify* kind of the remaining type against the
720 expected kind, to figure out how to instantiate C's and T's
721 kind arguments.
722
723 In the two examples,
724 * we unify kind-of( T k (a:k) ) ~ kind-of( Functor )
725 i.e. (k -> *) ~ (* -> *) to find k:=*.
726 yielding k:=*
727
728 * we unify kind-of( Either ) ~ kind-of( Category )
729 i.e. (* -> * -> *) ~ (k -> k -> k)
730 yielding k:=*
731
732 Now we get a kind substitution. We then need to:
733
734 1. Remove the substituted-out kind variables from the quantified kind vars
735
736 2. Apply the substitution to the kinds of quantified *type* vars
737 (and extend the substitution to reflect this change)
738
739 3. Apply that extended substitution to the non-dropped args (types and
740 kinds) of the type and class
741
742 Forgetting step (2) caused Trac #8893:
743 data V a = V [a] deriving Functor
744 data P (x::k->*) (a:k) = P (x a) deriving Functor
745 data C (x::k->*) (a:k) = C (V (P x a)) deriving Functor
746
747 When deriving Functor for P, we unify k to *, but we then want
748 an instance $df :: forall (x:*->*). Functor x => Functor (P * (x:*->*))
749 and similarly for C. Notice the modified kind of x, both at binding
750 and occurrence sites.
751
752 This can lead to some surprising results when *visible* kind binder is
753 unified (in contrast to the above examples, in which only non-visible kind
754 binders were considered). Consider this example from Trac #11732:
755
756 data T k (a :: k) = MkT deriving Functor
757
758 Since unification yields k:=*, this results in a generated instance of:
759
760 instance Functor (T *) where ...
761
762 which looks odd at first glance, since one might expect the instance head
763 to be of the form Functor (T k). Indeed, one could envision an alternative
764 generated instance of:
765
766 instance (k ~ *) => Functor (T k) where
767
768 But this does not typecheck as the result of a -XTypeInType design decision:
769 kind equalities are not allowed to be bound in types, only terms. But in
770 essence, the two instance declarations are entirely equivalent, since even
771 though (T k) matches any kind k, the only possibly value for k is *, since
772 anything else is ill-typed. As a result, we can just as comfortably use (T *).
773
774 Another way of thinking about is: deriving clauses often infer constraints.
775 For example:
776
777 data S a = S a deriving Eq
778
779 infers an (Eq a) constraint in the derived instance. By analogy, when we
780 are deriving Functor, we might infer an equality constraint (e.g., k ~ *).
781 The only distinction is that GHC instantiates equality constraints directly
782 during the deriving process.
783
784 Another quirk of this design choice manifests when typeclasses have visible
785 kind parameters. Consider this code (also from Trac #11732):
786
787 class Cat k (cat :: k -> k -> *) where
788 catId :: cat a a
789 catComp :: cat b c -> cat a b -> cat a c
790
791 instance Cat * (->) where
792 catId = id
793 catComp = (.)
794
795 newtype Fun a b = Fun (a -> b) deriving (Cat k)
796
797 Even though we requested an derived instance of the form (Cat k Fun), the
798 kind unification will actually generate (Cat * Fun) (i.e., the same thing as if
799 the user wrote deriving (Cat *)).
800
801 Note [Unification of two kind variables in deriving]
802 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
803 As a special case of the Note above, it is possible to derive an instance of
804 a poly-kinded typeclass for a poly-kinded datatype. For example:
805
806 class Category (cat :: k -> k -> *) where
807 newtype T (c :: k -> k -> *) a b = MkT (c a b) deriving Category
808
809 This case is suprisingly tricky. To see why, let's write out what instance GHC
810 will attempt to derive (using -fprint-explicit-kinds syntax):
811
812 instance Category k1 (T k2 c) where ...
813
814 GHC will attempt to unify k1 and k2, which produces a substitution (kind_subst)
815 that looks like [k2 :-> k1]. Importantly, we need to apply this substitution to
816 the type variable binder for c, since its kind is (k2 -> k2 -> *).
817
818 We used to accomplish this by doing the following:
819
820 unmapped_tkvs = filter (`notElemTCvSubst` kind_subst) all_tkvs
821 (subst, _) = mapAccumL substTyVarBndr kind_subst unmapped_tkvs
822
823 Where all_tkvs contains all kind variables in the class and instance types (in
824 this case, all_tkvs = [k1,k2]). But since kind_subst only has one mapping,
825 this results in unmapped_tkvs being [k1], and as a consequence, k1 gets mapped
826 to another kind variable in subst! That is, subst = [k2 :-> k1, k1 :-> k_new].
827 This is bad, because applying that substitution yields the following instance:
828
829 instance Category k_new (T k1 c) where ...
830
831 In other words, keeping k1 in unmapped_tvks taints the substitution, resulting
832 in an ill-kinded instance (this caused Trac #11837).
833
834 To prevent this, we need to filter out any variable from all_tkvs which either
835
836 1. Appears in the domain of kind_subst. notElemTCvSubst checks this.
837 2. Appears in the range of kind_subst. To do this, we compute the free
838 variable set of the range of kind_subst with getTCvSubstRangeFVs, and check
839 if a kind variable appears in that set.
840
841 Note [Eta-reducing type synonyms]
842 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
843 One can instantiate a type in a data family instance with a type synonym that
844 mentions other type variables:
845
846 type Const a b = a
847 data family Fam (f :: * -> *) (a :: *)
848 newtype instance Fam f (Const a f) = Fam (f a) deriving Functor
849
850 With -XTypeInType, it is also possible to define kind synonyms, and they can
851 mention other types in a datatype declaration. For example,
852
853 type Const a b = a
854 newtype T f (a :: Const * f) = T (f a) deriving Functor
855
856 When deriving, we need to perform eta-reduction analysis to ensure that none of
857 the eta-reduced type variables are mentioned elsewhere in the declaration. But
858 we need to be careful, because if we don't expand through the Const type
859 synonym, we will mistakenly believe that f is an eta-reduced type variable and
860 fail to derive Functor, even though the code above is correct (see Trac #11416,
861 where this was first noticed). For this reason, we expand the type synonyms in
862 the eta-reduced types before doing any analysis.
863 -}
864
865 mkEqnHelp :: Maybe OverlapMode
866 -> [TyVar]
867 -> Class -> [Type]
868 -> TyCon -> [Type]
869 -> DerivContext -- Just => context supplied (standalone deriving)
870 -- Nothing => context inferred (deriving on data decl)
871 -> Maybe DerivStrategy
872 -> TcRn EarlyDerivSpec
873 -- Make the EarlyDerivSpec for an instance
874 -- forall tvs. theta => cls (tys ++ [ty])
875 -- where the 'theta' is optional (that's the Maybe part)
876 -- Assumes that this declaration is well-kinded
877
878 mkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args mtheta deriv_strat
879 = do { -- Find the instance of a data family
880 -- Note [Looking up family instances for deriving]
881 fam_envs <- tcGetFamInstEnvs
882 ; let (rep_tc, rep_tc_args, _co) = tcLookupDataFamInst fam_envs tycon tc_args
883 -- If it's still a data family, the lookup failed; i.e no instance exists
884 ; when (isDataFamilyTyCon rep_tc)
885 (bale_out (text "No family instance for" <+> quotes (pprTypeApp tycon tc_args)))
886
887 ; dflags <- getDynFlags
888 ; if isDataTyCon rep_tc then
889 mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
890 tycon tc_args rep_tc rep_tc_args mtheta deriv_strat
891 else
892 mkNewTypeEqn dflags overlap_mode tvs cls cls_tys
893 tycon tc_args rep_tc rep_tc_args mtheta deriv_strat }
894 where
895 bale_out msg = failWithTc (derivingThingErr False cls cls_tys
896 (mkTyConApp tycon tc_args) deriv_strat msg)
897
898 {-
899 Note [Looking up family instances for deriving]
900 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
901 tcLookupFamInstExact is an auxiliary lookup wrapper which requires
902 that looked-up family instances exist. If called with a vanilla
903 tycon, the old type application is simply returned.
904
905 If we have
906 data instance F () = ... deriving Eq
907 data instance F () = ... deriving Eq
908 then tcLookupFamInstExact will be confused by the two matches;
909 but that can't happen because tcInstDecls1 doesn't call tcDeriving
910 if there are any overlaps.
911
912 There are two other things that might go wrong with the lookup.
913 First, we might see a standalone deriving clause
914 deriving Eq (F ())
915 when there is no data instance F () in scope.
916
917 Note that it's OK to have
918 data instance F [a] = ...
919 deriving Eq (F [(a,b)])
920 where the match is not exact; the same holds for ordinary data types
921 with standalone deriving declarations.
922
923 Note [Deriving, type families, and partial applications]
924 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
925 When there are no type families, it's quite easy:
926
927 newtype S a = MkS [a]
928 -- :CoS :: S ~ [] -- Eta-reduced
929
930 instance Eq [a] => Eq (S a) -- by coercion sym (Eq (:CoS a)) : Eq [a] ~ Eq (S a)
931 instance Monad [] => Monad S -- by coercion sym (Monad :CoS) : Monad [] ~ Monad S
932
933 When type familes are involved it's trickier:
934
935 data family T a b
936 newtype instance T Int a = MkT [a] deriving( Eq, Monad )
937 -- :RT is the representation type for (T Int a)
938 -- :Co:RT :: :RT ~ [] -- Eta-reduced!
939 -- :CoF:RT a :: T Int a ~ :RT a -- Also eta-reduced!
940
941 instance Eq [a] => Eq (T Int a) -- easy by coercion
942 -- d1 :: Eq [a]
943 -- d2 :: Eq (T Int a) = d1 |> Eq (sym (:Co:RT a ; :coF:RT a))
944
945 instance Monad [] => Monad (T Int) -- only if we can eta reduce???
946 -- d1 :: Monad []
947 -- d2 :: Monad (T Int) = d1 |> Monad (sym (:Co:RT ; :coF:RT))
948
949 Note the need for the eta-reduced rule axioms. After all, we can
950 write it out
951 instance Monad [] => Monad (T Int) -- only if we can eta reduce???
952 return x = MkT [x]
953 ... etc ...
954
955 See Note [Eta reduction for data families] in FamInstEnv
956
957 %************************************************************************
958 %* *
959 Deriving data types
960 * *
961 ************************************************************************
962 -}
963
964 mkDataTypeEqn :: DynFlags
965 -> Maybe OverlapMode
966 -> [TyVar] -- Universally quantified type variables in the instance
967 -> Class -- Class for which we need to derive an instance
968 -> [Type] -- Other parameters to the class except the last
969 -> TyCon -- Type constructor for which the instance is requested
970 -- (last parameter to the type class)
971 -> [Type] -- Parameters to the type constructor
972 -> TyCon -- rep of the above (for type families)
973 -> [Type] -- rep of the above
974 -> DerivContext -- Context of the instance, for standalone deriving
975 -> Maybe DerivStrategy -- 'Just' if user requests a particular
976 -- deriving strategy.
977 -- Otherwise, 'Nothing'.
978 -> TcRn EarlyDerivSpec -- Return 'Nothing' if error
979
980 mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
981 tycon tc_args rep_tc rep_tc_args mtheta deriv_strat
982 = case deriv_strat of
983 Just StockStrategy -> mk_eqn_stock dflags mtheta cls cls_tys rep_tc
984 go_for_it bale_out
985 Just AnyclassStrategy -> mk_eqn_anyclass dflags go_for_it bale_out
986 -- GeneralizedNewtypeDeriving makes no sense for non-newtypes
987 Just NewtypeStrategy -> bale_out gndNonNewtypeErr
988 -- Lacking a user-requested deriving strategy, we will try to pick
989 -- between the stock or anyclass strategies
990 Nothing -> mk_eqn_no_mechanism dflags tycon mtheta cls cls_tys rep_tc
991 go_for_it bale_out
992 where
993 go_for_it = mk_data_eqn overlap_mode tvs cls cls_tys tycon tc_args
994 rep_tc rep_tc_args mtheta (isJust deriv_strat)
995 bale_out msg = failWithTc (derivingThingErr False cls cls_tys
996 (mkTyConApp tycon tc_args) deriv_strat msg)
997
998 mk_data_eqn :: Maybe OverlapMode -> [TyVar] -> Class -> [Type]
999 -> TyCon -> [TcType] -> TyCon -> [TcType] -> DerivContext
1000 -> Bool -- True if an explicit deriving strategy keyword was
1001 -- provided
1002 -> DerivSpecMechanism -- How GHC should proceed attempting to
1003 -- derive this instance, determined in
1004 -- mkDataTypeEqn/mkNewTypeEqn
1005 -> TcM EarlyDerivSpec
1006 mk_data_eqn overlap_mode tvs cls cls_tys tycon tc_args rep_tc rep_tc_args
1007 mtheta strat_used mechanism
1008 = do doDerivInstErrorChecks1 cls cls_tys tycon tc_args rep_tc mtheta
1009 strat_used mechanism
1010 loc <- getSrcSpanM
1011 dfun_name <- newDFunName' cls tycon
1012 case mtheta of
1013 Nothing -> -- Infer context
1014 do { (inferred_constraints, tvs', inst_tys')
1015 <- inferConstraints tvs cls cls_tys inst_ty
1016 rep_tc rep_tc_args mechanism
1017 ; return $ InferTheta $ DS
1018 { ds_loc = loc
1019 , ds_name = dfun_name, ds_tvs = tvs'
1020 , ds_cls = cls, ds_tys = inst_tys'
1021 , ds_tc = rep_tc
1022 , ds_theta = inferred_constraints
1023 , ds_overlap = overlap_mode
1024 , ds_mechanism = mechanism } }
1025
1026 Just theta -> do -- Specified context
1027 return $ GivenTheta $ DS
1028 { ds_loc = loc
1029 , ds_name = dfun_name, ds_tvs = tvs
1030 , ds_cls = cls, ds_tys = inst_tys
1031 , ds_tc = rep_tc
1032 , ds_theta = theta
1033 , ds_overlap = overlap_mode
1034 , ds_mechanism = mechanism }
1035 where
1036 inst_ty = mkTyConApp tycon tc_args
1037 inst_tys = cls_tys ++ [inst_ty]
1038
1039 mk_eqn_stock :: DynFlags -> DerivContext -> Class -> [Type] -> TyCon
1040 -> (DerivSpecMechanism -> TcRn EarlyDerivSpec)
1041 -> (SDoc -> TcRn EarlyDerivSpec)
1042 -> TcRn EarlyDerivSpec
1043 mk_eqn_stock dflags mtheta cls cls_tys rep_tc go_for_it bale_out
1044 = case checkSideConditions dflags mtheta cls cls_tys rep_tc of
1045 CanDerive -> mk_eqn_stock' cls go_for_it
1046 DerivableClassError msg -> bale_out msg
1047 _ -> bale_out (nonStdErr cls)
1048
1049 mk_eqn_stock' :: Class -> (DerivSpecMechanism -> TcRn EarlyDerivSpec)
1050 -> TcRn EarlyDerivSpec
1051 mk_eqn_stock' cls go_for_it
1052 = go_for_it $ case hasStockDeriving cls of
1053 Just gen_fn -> DerivSpecStock gen_fn
1054 Nothing ->
1055 pprPanic "mk_eqn_stock': Not a stock class!" (ppr cls)
1056
1057 mk_eqn_anyclass :: DynFlags
1058 -> (DerivSpecMechanism -> TcRn EarlyDerivSpec)
1059 -> (SDoc -> TcRn EarlyDerivSpec)
1060 -> TcRn EarlyDerivSpec
1061 mk_eqn_anyclass dflags go_for_it bale_out
1062 = case canDeriveAnyClass dflags of
1063 IsValid -> go_for_it DerivSpecAnyClass
1064 NotValid msg -> bale_out msg
1065
1066 mk_eqn_no_mechanism :: DynFlags -> TyCon -> DerivContext
1067 -> Class -> [Type] -> TyCon
1068 -> (DerivSpecMechanism -> TcRn EarlyDerivSpec)
1069 -> (SDoc -> TcRn EarlyDerivSpec)
1070 -> TcRn EarlyDerivSpec
1071 mk_eqn_no_mechanism dflags tc mtheta cls cls_tys rep_tc go_for_it bale_out
1072 = case checkSideConditions dflags mtheta cls cls_tys rep_tc of
1073 -- NB: pass the *representation* tycon to checkSideConditions
1074 NonDerivableClass msg -> bale_out (dac_error msg)
1075 DerivableClassError msg -> bale_out msg
1076 CanDerive -> mk_eqn_stock' cls go_for_it
1077 DerivableViaInstance -> go_for_it DerivSpecAnyClass
1078 where
1079 -- See Note [Deriving instances for classes themselves]
1080 dac_error msg
1081 | isClassTyCon rep_tc
1082 = quotes (ppr tc) <+> text "is a type class,"
1083 <+> text "and can only have a derived instance"
1084 $+$ text "if DeriveAnyClass is enabled"
1085 | otherwise
1086 = nonStdErr cls $$ msg
1087
1088 {-
1089 ************************************************************************
1090 * *
1091 Deriving newtypes
1092 * *
1093 ************************************************************************
1094 -}
1095
1096 mkNewTypeEqn :: DynFlags -> Maybe OverlapMode -> [TyVar] -> Class
1097 -> [Type] -> TyCon -> [Type] -> TyCon -> [Type]
1098 -> DerivContext -> Maybe DerivStrategy
1099 -> TcRn EarlyDerivSpec
1100 mkNewTypeEqn dflags overlap_mode tvs
1101 cls cls_tys tycon tc_args rep_tycon rep_tc_args
1102 mtheta deriv_strat
1103 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
1104 = ASSERT( length cls_tys + 1 == classArity cls )
1105 case deriv_strat of
1106 Just StockStrategy -> mk_eqn_stock dflags mtheta cls cls_tys rep_tycon
1107 go_for_it_other bale_out
1108 Just AnyclassStrategy -> mk_eqn_anyclass dflags go_for_it_other bale_out
1109 Just NewtypeStrategy ->
1110 -- Since the user explicitly asked for GeneralizedNewtypeDeriving, we
1111 -- don't need to perform all of the checks we normally would, such as
1112 -- if the class being derived is known to produce ill-roled coercions
1113 -- (e.g., Traversable), since we can just derive the instance and let
1114 -- it error if need be.
1115 -- See Note [Determining whether newtype-deriving is appropriate]
1116 if coercion_looks_sensible && newtype_deriving
1117 then go_for_it_gnd
1118 else bale_out (cant_derive_err $$
1119 if newtype_deriving then empty else suggest_gnd)
1120 Nothing
1121 | might_derive_via_coercible
1122 && ((newtype_deriving && not deriveAnyClass)
1123 || std_class_via_coercible cls)
1124 -> go_for_it_gnd
1125 | otherwise
1126 -> case checkSideConditions dflags mtheta cls cls_tys rep_tycon of
1127 DerivableClassError msg
1128 -- There's a particular corner case where
1129 --
1130 -- 1. -XGeneralizedNewtypeDeriving and -XDeriveAnyClass are both
1131 -- enabled at the same time
1132 -- 2. We're deriving a particular stock derivable class
1133 -- (such as Functor)
1134 --
1135 -- and the previous cases won't catch it. This fixes the bug
1136 -- reported in Trac #10598.
1137 | might_derive_via_coercible && newtype_deriving
1138 -> go_for_it_gnd
1139 -- Otherwise, throw an error for a stock class
1140 | might_derive_via_coercible && not newtype_deriving
1141 -> bale_out (msg $$ suggest_gnd)
1142 | otherwise
1143 -> bale_out msg
1144
1145 -- Must use newtype deriving or DeriveAnyClass
1146 NonDerivableClass _msg
1147 -- Too hard, even with newtype deriving
1148 | newtype_deriving -> bale_out cant_derive_err
1149 -- Try newtype deriving!
1150 -- Here we suggest GeneralizedNewtypeDeriving even in cases where
1151 -- it may not be applicable. See Trac #9600.
1152 | otherwise -> bale_out (non_std $$ suggest_gnd)
1153
1154 -- DerivableViaInstance
1155 DerivableViaInstance -> do
1156 -- If both DeriveAnyClass and GeneralizedNewtypeDeriving are
1157 -- enabled, we take the diplomatic approach of defaulting to
1158 -- DeriveAnyClass, but emitting a warning about the choice.
1159 -- See Note [Deriving strategies]
1160 when (newtype_deriving && deriveAnyClass) $
1161 addWarnTc NoReason $ sep
1162 [ text "Both DeriveAnyClass and"
1163 <+> text "GeneralizedNewtypeDeriving are enabled"
1164 , text "Defaulting to the DeriveAnyClass strategy"
1165 <+> text "for instantiating" <+> ppr cls ]
1166 go_for_it_other DerivSpecAnyClass
1167 -- CanDerive
1168 CanDerive -> mk_eqn_stock' cls go_for_it_other
1169 where
1170 newtype_deriving = xopt LangExt.GeneralizedNewtypeDeriving dflags
1171 deriveAnyClass = xopt LangExt.DeriveAnyClass dflags
1172 go_for_it_gnd = do
1173 traceTc "newtype deriving:" $
1174 ppr tycon <+> ppr rep_tys <+> ppr all_thetas
1175 let mechanism = DerivSpecNewtype rep_inst_ty
1176 doDerivInstErrorChecks1 cls cls_tys tycon tc_args rep_tycon mtheta
1177 strat_used mechanism
1178 dfun_name <- newDFunName' cls tycon
1179 loc <- getSrcSpanM
1180 case mtheta of
1181 Just theta -> return $ GivenTheta $ DS
1182 { ds_loc = loc
1183 , ds_name = dfun_name, ds_tvs = tvs
1184 , ds_cls = cls, ds_tys = inst_tys
1185 , ds_tc = rep_tycon
1186 , ds_theta = theta
1187 , ds_overlap = overlap_mode
1188 , ds_mechanism = mechanism }
1189 Nothing -> return $ InferTheta $ DS
1190 { ds_loc = loc
1191 , ds_name = dfun_name, ds_tvs = tvs
1192 , ds_cls = cls, ds_tys = inst_tys
1193 , ds_tc = rep_tycon
1194 , ds_theta = all_thetas
1195 , ds_overlap = overlap_mode
1196 , ds_mechanism = mechanism }
1197 go_for_it_other = mk_data_eqn overlap_mode tvs cls cls_tys tycon
1198 tc_args rep_tycon rep_tc_args mtheta strat_used
1199 bale_out = bale_out' newtype_deriving
1200 bale_out' b = failWithTc . derivingThingErr b cls cls_tys inst_ty
1201 deriv_strat
1202
1203 strat_used = isJust deriv_strat
1204 non_std = nonStdErr cls
1205 suggest_gnd = text "Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension"
1206
1207 -- Here is the plan for newtype derivings. We see
1208 -- newtype T a1...an = MkT (t ak+1...an) deriving (.., C s1 .. sm, ...)
1209 -- where t is a type,
1210 -- ak+1...an is a suffix of a1..an, and are all tyvars
1211 -- ak+1...an do not occur free in t, nor in the s1..sm
1212 -- (C s1 ... sm) is a *partial applications* of class C
1213 -- with the last parameter missing
1214 -- (T a1 .. ak) matches the kind of C's last argument
1215 -- (and hence so does t)
1216 -- The latter kind-check has been done by deriveTyData already,
1217 -- and tc_args are already trimmed
1218 --
1219 -- We generate the instance
1220 -- instance forall ({a1..ak} u fvs(s1..sm)).
1221 -- C s1 .. sm t => C s1 .. sm (T a1...ak)
1222 -- where T a1...ap is the partial application of
1223 -- the LHS of the correct kind and p >= k
1224 --
1225 -- NB: the variables below are:
1226 -- tc_tvs = [a1, ..., an]
1227 -- tyvars_to_keep = [a1, ..., ak]
1228 -- rep_ty = t ak .. an
1229 -- deriv_tvs = fvs(s1..sm) \ tc_tvs
1230 -- tys = [s1, ..., sm]
1231 -- rep_fn' = t
1232 --
1233 -- Running example: newtype T s a = MkT (ST s a) deriving( Monad )
1234 -- We generate the instance
1235 -- instance Monad (ST s) => Monad (T s) where
1236
1237 nt_eta_arity = newTyConEtadArity rep_tycon
1238 -- For newtype T a b = MkT (S a a b), the TyCon machinery already
1239 -- eta-reduces the representation type, so we know that
1240 -- T a ~ S a a
1241 -- That's convenient here, because we may have to apply
1242 -- it to fewer than its original complement of arguments
1243
1244 -- Note [Newtype representation]
1245 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1246 -- Need newTyConRhs (*not* a recursive representation finder)
1247 -- to get the representation type. For example
1248 -- newtype B = MkB Int
1249 -- newtype A = MkA B deriving( Num )
1250 -- We want the Num instance of B, *not* the Num instance of Int,
1251 -- when making the Num instance of A!
1252 rep_inst_ty = newTyConInstRhs rep_tycon rep_tc_args
1253 rep_tys = cls_tys ++ [rep_inst_ty]
1254 rep_pred = mkClassPred cls rep_tys
1255 rep_pred_o = mkPredOrigin DerivOrigin TypeLevel rep_pred
1256 -- rep_pred is the representation dictionary, from where
1257 -- we are gong to get all the methods for the newtype
1258 -- dictionary
1259
1260 -- Next we figure out what superclass dictionaries to use
1261 -- See Note [Newtype deriving superclasses] above
1262 sc_preds :: [PredOrigin]
1263 cls_tyvars = classTyVars cls
1264 inst_ty = mkTyConApp tycon tc_args
1265 inst_tys = cls_tys ++ [inst_ty]
1266 sc_preds = map (mkPredOrigin DerivOrigin TypeLevel) $
1267 substTheta (zipTvSubst cls_tyvars inst_tys) $
1268 classSCTheta cls
1269
1270 -- Next we collect constraints for the class methods
1271 -- If there are no methods, we don't need any constraints
1272 -- Otherwise we need (C rep_ty), for the representation methods,
1273 -- and constraints to coerce each individual method
1274 meth_preds :: [PredOrigin]
1275 meths = classMethods cls
1276 meth_preds | null meths = [] -- No methods => no constraints
1277 -- (Trac #12814)
1278 | otherwise = rep_pred_o : coercible_constraints
1279 coercible_constraints
1280 = [ mkPredOrigin (DerivOriginCoerce meth t1 t2) TypeLevel
1281 (mkReprPrimEqPred t1 t2)
1282 | meth <- meths
1283 , let (Pair t1 t2) = mkCoerceClassMethEqn cls tvs
1284 inst_tys rep_inst_ty meth ]
1285
1286 all_thetas :: [ThetaOrigin]
1287 all_thetas = [mkThetaOriginFromPreds $ meth_preds ++ sc_preds]
1288
1289 -------------------------------------------------------------------
1290 -- Figuring out whether we can only do this newtype-deriving thing
1291
1292 -- See Note [Determining whether newtype-deriving is appropriate]
1293 might_derive_via_coercible
1294 = not (non_coercible_class cls)
1295 && coercion_looks_sensible
1296 -- && not (isRecursiveTyCon tycon) -- Note [Recursive newtypes]
1297 coercion_looks_sensible
1298 = eta_ok
1299 -- Check (a) from Note [GND and associated type families]
1300 && ats_ok
1301 -- Check (b) from Note [GND and associated type families]
1302 && isNothing at_without_last_cls_tv
1303
1304 -- Check that eta reduction is OK
1305 eta_ok = nt_eta_arity <= length rep_tc_args
1306 -- The newtype can be eta-reduced to match the number
1307 -- of type argument actually supplied
1308 -- newtype T a b = MkT (S [a] b) deriving( Monad )
1309 -- Here the 'b' must be the same in the rep type (S [a] b)
1310 -- And the [a] must not mention 'b'. That's all handled
1311 -- by nt_eta_rity.
1312
1313 (adf_tcs, atf_tcs) = partition isDataFamilyTyCon at_tcs
1314 ats_ok = null adf_tcs
1315 -- We cannot newtype-derive data family instances
1316
1317 at_without_last_cls_tv
1318 = find (\tc -> last_cls_tv `notElem` tyConTyVars tc) atf_tcs
1319 at_tcs = classATs cls
1320 last_cls_tv = ASSERT( notNull cls_tyvars )
1321 last cls_tyvars
1322
1323 cant_derive_err
1324 = vcat [ ppUnless eta_ok eta_msg
1325 , ppUnless ats_ok ats_msg
1326 , maybe empty at_tv_msg
1327 at_without_last_cls_tv]
1328 eta_msg = text "cannot eta-reduce the representation type enough"
1329 ats_msg = text "the class has associated data types"
1330 at_tv_msg at_tc = hang
1331 (text "the associated type" <+> quotes (ppr at_tc)
1332 <+> text "is not parameterized over the last type variable")
1333 2 (text "of the class" <+> quotes (ppr cls))
1334
1335 {-
1336 Note [Recursive newtypes]
1337 ~~~~~~~~~~~~~~~~~~~~~~~~~
1338 Newtype deriving works fine, even if the newtype is recursive.
1339 e.g. newtype S1 = S1 [T1 ()]
1340 newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad )
1341 Remember, too, that type families are currently (conservatively) given
1342 a recursive flag, so this also allows newtype deriving to work
1343 for type famillies.
1344
1345 We used to exclude recursive types, because we had a rather simple
1346 minded way of generating the instance decl:
1347 newtype A = MkA [A]
1348 instance Eq [A] => Eq A -- Makes typechecker loop!
1349 But now we require a simple context, so it's ok.
1350
1351 Note [Determining whether newtype-deriving is appropriate]
1352 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1353 When we see
1354 newtype NT = MkNT Foo
1355 deriving C
1356 we have to decide how to perform the deriving. Do we do newtype deriving,
1357 or do we do normal deriving? In general, we prefer to do newtype deriving
1358 wherever possible. So, we try newtype deriving unless there's a glaring
1359 reason not to.
1360
1361 "Glaring reasons not to" include trying to derive a class for which a
1362 coercion-based instance doesn't make sense. These classes are listed in
1363 the definition of non_coercible_class. They include Show (since it must
1364 show the name of the datatype) and Traversable (since a coercion-based
1365 Traversable instance is ill-roled).
1366
1367 However, non_coercible_class is ignored if the user explicitly requests
1368 to derive an instance with GeneralizedNewtypeDeriving using the newtype
1369 deriving strategy. In such a scenario, GHC will unquestioningly try to
1370 derive the instance via coercions (even if the final generated code is
1371 ill-roled!). See Note [Deriving strategies].
1372
1373 Note that newtype deriving might fail, even after we commit to it. This
1374 is because the derived instance uses `coerce`, which must satisfy its
1375 `Coercible` constraint. This is different than other deriving scenarios,
1376 where we're sure that the resulting instance will type-check.
1377
1378 Note [GND and associated type families]
1379 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1380 It's possible to use GeneralizedNewtypeDeriving (GND) to derive instances for
1381 classes with associated type families. A general recipe is:
1382
1383 class C x y z where
1384 type T y z x
1385 op :: x -> [y] -> z
1386
1387 newtype N a = MkN <rep-type> deriving( C )
1388
1389 =====>
1390
1391 instance C x y <rep-type> => C x y (N a) where
1392 type T y (N a) x = T y <rep-type> x
1393 op = coerce (op :: x -> [y] -> <rep-type>)
1394
1395 However, we must watch out for three things:
1396
1397 (a) The class must not contain any data families. If it did, we'd have to
1398 generate a fresh data constructor name for the derived data family
1399 instance, and it's not clear how to do this.
1400
1401 (b) Each associated type family's type variables must mention the last type
1402 variable of the class. As an example, you wouldn't be able to use GND to
1403 derive an instance of this class:
1404
1405 class C a b where
1406 type T a
1407
1408 But you would be able to derive an instance of this class:
1409
1410 class C a b where
1411 type T b
1412
1413 The difference is that in the latter T mentions the last parameter of C
1414 (i.e., it mentions b), but the former T does not. If you tried, e.g.,
1415
1416 newtype Foo x = Foo x deriving (C a)
1417
1418 with the former definition of C, you'd end up with something like this:
1419
1420 instance C a (Foo x) where
1421 type T a = T ???
1422
1423 This T family instance doesn't mention the newtype (or its representation
1424 type) at all, so we disallow such constructions with GND.
1425
1426 (c) UndecidableInstances might need to be enabled. Here's a case where it is
1427 most definitely necessary:
1428
1429 class C a where
1430 type T a
1431 newtype Loop = Loop MkLoop deriving C
1432
1433 =====>
1434
1435 instance C Loop where
1436 type T Loop = T Loop
1437
1438 Obviously, T Loop would send the typechecker into a loop. Unfortunately,
1439 you might even need UndecidableInstances even in cases where the
1440 typechecker would be guaranteed to terminate. For example:
1441
1442 instance C Int where
1443 type C Int = Int
1444 newtype MyInt = MyInt Int deriving C
1445
1446 =====>
1447
1448 instance C MyInt where
1449 type T MyInt = T Int
1450
1451 GHC's termination checker isn't sophisticated enough to conclude that the
1452 definition of T MyInt terminates, so UndecidableInstances is required.
1453
1454 ************************************************************************
1455 * *
1456 \subsection[TcDeriv-normal-binds]{Bindings for the various classes}
1457 * *
1458 ************************************************************************
1459
1460 After all the trouble to figure out the required context for the
1461 derived instance declarations, all that's left is to chug along to
1462 produce them. They will then be shoved into @tcInstDecls2@, which
1463 will do all its usual business.
1464
1465 There are lots of possibilities for code to generate. Here are
1466 various general remarks.
1467
1468 PRINCIPLES:
1469 \begin{itemize}
1470 \item
1471 We want derived instances of @Eq@ and @Ord@ (both v common) to be
1472 ``you-couldn't-do-better-by-hand'' efficient.
1473
1474 \item
1475 Deriving @Show@---also pretty common--- should also be reasonable good code.
1476
1477 \item
1478 Deriving for the other classes isn't that common or that big a deal.
1479 \end{itemize}
1480
1481 PRAGMATICS:
1482
1483 \begin{itemize}
1484 \item
1485 Deriving @Ord@ is done mostly with the 1.3 @compare@ method.
1486
1487 \item
1488 Deriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.
1489
1490 \item
1491 We {\em normally} generate code only for the non-defaulted methods;
1492 there are some exceptions for @Eq@ and (especially) @Ord@...
1493
1494 \item
1495 Sometimes we use a @_con2tag_<tycon>@ function, which returns a data
1496 constructor's numeric (@Int#@) tag. These are generated by
1497 @gen_tag_n_con_binds@, and the heuristic for deciding if one of
1498 these is around is given by @hasCon2TagFun@.
1499
1500 The examples under the different sections below will make this
1501 clearer.
1502
1503 \item
1504 Much less often (really just for deriving @Ix@), we use a
1505 @_tag2con_<tycon>@ function. See the examples.
1506
1507 \item
1508 We use the renamer!!! Reason: we're supposed to be
1509 producing @LHsBinds Name@ for the methods, but that means
1510 producing correctly-uniquified code on the fly. This is entirely
1511 possible (the @TcM@ monad has a @UniqueSupply@), but it is painful.
1512 So, instead, we produce @MonoBinds RdrName@ then heave 'em through
1513 the renamer. What a great hack!
1514 \end{itemize}
1515 -}
1516
1517 -- Generate the InstInfo for the required instance paired with the
1518 -- *representation* tycon for that instance,
1519 -- plus any auxiliary bindings required
1520 --
1521 -- Representation tycons differ from the tycon in the instance signature in
1522 -- case of instances for indexed families.
1523 --
1524 genInst :: DerivSpec theta
1525 -> TcM (ThetaType -> TcM (InstInfo RdrName), BagDerivStuff, Maybe Name)
1526 -- We must use continuation-returning style here to get the order in which we
1527 -- typecheck family instances and derived instances right.
1528 -- See Note [Staging of tcDeriving]
1529 genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon
1530 , ds_mechanism = mechanism, ds_tys = tys
1531 , ds_cls = clas, ds_loc = loc })
1532 = do (meth_binds, deriv_stuff) <- genDerivStuff mechanism loc clas
1533 rep_tycon tys tvs
1534 let mk_inst_info theta = do
1535 inst_spec <- newDerivClsInst theta spec
1536 doDerivInstErrorChecks2 clas inst_spec mechanism
1537 traceTc "newder" (ppr inst_spec)
1538 return $ InstInfo
1539 { iSpec = inst_spec
1540 , iBinds = InstBindings
1541 { ib_binds = meth_binds
1542 , ib_tyvars = map Var.varName tvs
1543 , ib_pragmas = []
1544 , ib_extensions = extensions
1545 , ib_derived = True } }
1546 return (mk_inst_info, deriv_stuff, unusedConName)
1547 where
1548 unusedConName :: Maybe Name
1549 unusedConName
1550 | isDerivSpecNewtype mechanism
1551 -- See Note [Newtype deriving and unused constructors]
1552 = Just $ getName $ head $ tyConDataCons rep_tycon
1553 | otherwise
1554 = Nothing
1555
1556 extensions :: [LangExt.Extension]
1557 extensions
1558 | isDerivSpecNewtype mechanism
1559 -- Both these flags are needed for higher-rank uses of coerce
1560 -- See Note [Newtype-deriving instances] in TcGenDeriv
1561 = [LangExt.ImpredicativeTypes, LangExt.RankNTypes]
1562 | otherwise
1563 = []
1564
1565 doDerivInstErrorChecks1 :: Class -> [Type] -> TyCon -> [Type] -> TyCon
1566 -> DerivContext -> Bool -> DerivSpecMechanism
1567 -> TcM ()
1568 doDerivInstErrorChecks1 cls cls_tys tc tc_args rep_tc mtheta
1569 strat_used mechanism = do
1570 -- For standalone deriving (mtheta /= Nothing),
1571 -- check that all the data constructors are in scope...
1572 rdr_env <- getGlobalRdrEnv
1573 let data_con_names = map dataConName (tyConDataCons rep_tc)
1574 hidden_data_cons = not (isWiredInName (tyConName rep_tc)) &&
1575 (isAbstractTyCon rep_tc ||
1576 any not_in_scope data_con_names)
1577 not_in_scope dc = isNothing (lookupGRE_Name rdr_env dc)
1578
1579 addUsedDataCons rdr_env rep_tc
1580 -- ...however, we don't perform this check if we're using DeriveAnyClass,
1581 -- since it doesn't generate any code that requires use of a data
1582 -- constructor.
1583 unless (anyclass_strategy || isNothing mtheta || not hidden_data_cons) $
1584 bale_out $ derivingHiddenErr tc
1585 where
1586 anyclass_strategy = isDerivSpecAnyClass mechanism
1587
1588 bale_out msg = failWithTc (derivingThingErrMechanism cls cls_tys
1589 (mkTyConApp tc tc_args) strat_used mechanism msg)
1590
1591 doDerivInstErrorChecks2 :: Class -> ClsInst -> DerivSpecMechanism -> TcM ()
1592 doDerivInstErrorChecks2 clas clas_inst mechanism
1593 = do { traceTc "doDerivInstErrorChecks2" (ppr clas_inst)
1594 ; dflags <- getDynFlags
1595 -- Check for Generic instances that are derived with an exotic
1596 -- deriving strategy like DAC
1597 -- See Note [Deriving strategies]
1598 ; when (exotic_mechanism && className clas `elem` genericClassNames) $
1599 do { failIfTc (safeLanguageOn dflags) gen_inst_err
1600 ; when (safeInferOn dflags) (recordUnsafeInfer emptyBag) } }
1601 where
1602 exotic_mechanism = case mechanism of
1603 DerivSpecStock{} -> False
1604 _ -> True
1605
1606 gen_inst_err = hang (text ("Generic instances can only be derived in "
1607 ++ "Safe Haskell using the stock strategy.") $+$
1608 text "In the following instance:")
1609 2 (pprInstanceHdr clas_inst)
1610
1611 genDerivStuff :: DerivSpecMechanism -> SrcSpan -> Class
1612 -> TyCon -> [Type] -> [TyVar]
1613 -> TcM (LHsBinds RdrName, BagDerivStuff)
1614 genDerivStuff mechanism loc clas tycon inst_tys tyvars
1615 = case mechanism of
1616 -- See Note [Bindings for Generalised Newtype Deriving]
1617 DerivSpecNewtype rhs_ty -> gen_Newtype_binds loc clas tyvars
1618 inst_tys rhs_ty
1619
1620 -- Try a stock deriver
1621 DerivSpecStock gen_fn -> gen_fn loc tycon inst_tys
1622
1623 -- If there isn't a stock deriver, our last resort is -XDeriveAnyClass
1624 -- (since -XGeneralizedNewtypeDeriving fell through).
1625 DerivSpecAnyClass -> do
1626 let mini_env = mkVarEnv (classTyVars clas `zip` inst_tys)
1627 mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
1628 dflags <- getDynFlags
1629 tyfam_insts <-
1630 -- canDeriveAnyClass should ensure that this code can't be reached
1631 -- unless -XDeriveAnyClass is enabled.
1632 ASSERT2( isValid (canDeriveAnyClass dflags)
1633 , ppr "genDerivStuff: bad derived class" <+> ppr clas )
1634 mapM (tcATDefault False loc mini_subst emptyNameSet)
1635 (classATItems clas)
1636 return ( emptyBag -- No method bindings are needed...
1637 , listToBag (map DerivFamInst (concat tyfam_insts))
1638 -- ...but we may need to generate binding for associated type
1639 -- family default instances.
1640 -- See Note [DeriveAnyClass and default family instances]
1641 )
1642
1643 {-
1644 Note [Bindings for Generalised Newtype Deriving]
1645 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1646 Consider
1647 class Eq a => C a where
1648 f :: a -> a
1649 newtype N a = MkN [a] deriving( C )
1650 instance Eq (N a) where ...
1651
1652 The 'deriving C' clause generates, in effect
1653 instance (C [a], Eq a) => C (N a) where
1654 f = coerce (f :: [a] -> [a])
1655
1656 This generates a cast for each method, but allows the superclasse to
1657 be worked out in the usual way. In this case the superclass (Eq (N
1658 a)) will be solved by the explicit Eq (N a) instance. We do *not*
1659 create the superclasses by casting the superclass dictionaries for the
1660 representation type.
1661
1662 See the paper "Safe zero-cost coercions for Haskell".
1663
1664 Note [DeriveAnyClass and default family instances]
1665 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1666
1667 When a class has a associated type family with a default instance, e.g.:
1668
1669 class C a where
1670 type T a
1671 type T a = Char
1672
1673 then there are a couple of scenarios in which a user would expect T a to
1674 default to Char. One is when an instance declaration for C is given without
1675 an implementation for T:
1676
1677 instance C Int
1678
1679 Another scenario in which this can occur is when the -XDeriveAnyClass extension
1680 is used:
1681
1682 data Example = Example deriving (C, Generic)
1683
1684 In the latter case, we must take care to check if C has any associated type
1685 families with default instances, because -XDeriveAnyClass will never provide
1686 an implementation for them. We "fill in" the default instances using the
1687 tcATDefault function from TcClsDcl (which is also used in TcInstDcls to handle
1688 the empty instance declaration case).
1689
1690 Note [Deriving strategies]
1691 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1692 GHC has a notion of deriving strategies, which allow the user to explicitly
1693 request which approach to use when deriving an instance (enabled with the
1694 -XDerivingStrategies language extension). For more information, refer to the
1695 original Trac ticket (#10598) or the associated wiki page:
1696 https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies
1697
1698 A deriving strategy can be specified in a deriving clause:
1699
1700 newtype Foo = MkFoo Bar
1701 deriving newtype C
1702
1703 Or in a standalone deriving declaration:
1704
1705 deriving anyclass instance C Foo
1706
1707 -XDerivingStrategies also allows the use of multiple deriving clauses per data
1708 declaration so that a user can derive some instance with one deriving strategy
1709 and other instances with another deriving strategy. For example:
1710
1711 newtype Baz = Baz Quux
1712 deriving (Eq, Ord)
1713 deriving stock (Read, Show)
1714 deriving newtype (Num, Floating)
1715 deriving anyclass C
1716
1717 Currently, the deriving strategies are:
1718
1719 * stock: Have GHC implement a "standard" instance for a data type, if possible
1720 (e.g., Eq, Ord, Generic, Data, Functor, etc.)
1721
1722 * anyclass: Use -XDeriveAnyClass
1723
1724 * newtype: Use -XGeneralizedNewtypeDeriving
1725
1726 If an explicit deriving strategy is not given, GHC has an algorithm it uses to
1727 determine which strategy it will actually use. The algorithm is quite long,
1728 so it lives in the Haskell wiki at
1729 https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies
1730 ("The deriving strategy resolution algorithm" section).
1731
1732 Internally, GHC uses the DerivStrategy datatype to denote a user-requested
1733 deriving strategy, and it uses the DerivSpecMechanism datatype to denote what
1734 GHC will use to derive the instance after taking the above steps. In other
1735 words, GHC will always settle on a DerivSpecMechnism, even if the user did not
1736 ask for a particular DerivStrategy (using the algorithm linked to above).
1737
1738 Note [Deriving instances for classes themselves]
1739 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1740 Much of the code in TcDeriv assumes that deriving only works on data types.
1741 But this assumption doesn't hold true for DeriveAnyClass, since it's perfectly
1742 reasonable to do something like this:
1743
1744 {-# LANGUAGE DeriveAnyClass #-}
1745 class C1 (a :: Constraint) where
1746 class C2 where
1747 deriving instance C1 C2
1748 -- This is equivalent to `instance C1 C2`
1749
1750 If DeriveAnyClass isn't enabled in the code above (i.e., it defaults to stock
1751 deriving), we throw a special error message indicating that DeriveAnyClass is
1752 the only way to go. We don't bother throwing this error if an explicit 'stock'
1753 or 'newtype' keyword is used, since both options have their own perfectly
1754 sensible error messages in the case of the above code (as C1 isn't a stock
1755 derivable class, and C2 isn't a newtype).
1756
1757 ************************************************************************
1758 * *
1759 \subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
1760 * *
1761 ************************************************************************
1762 -}
1763
1764 nonUnaryErr :: LHsSigType Name -> SDoc
1765 nonUnaryErr ct = quotes (ppr ct)
1766 <+> text "is not a unary constraint, as expected by a deriving clause"
1767
1768 nonStdErr :: Class -> SDoc
1769 nonStdErr cls =
1770 quotes (ppr cls)
1771 <+> text "is not a stock derivable class (Eq, Show, etc.)"
1772
1773 gndNonNewtypeErr :: SDoc
1774 gndNonNewtypeErr =
1775 text "GeneralizedNewtypeDeriving cannot be used on non-newtypes"
1776
1777 derivingNullaryErr :: MsgDoc
1778 derivingNullaryErr = text "Cannot derive instances for nullary classes"
1779
1780 derivingKindErr :: TyCon -> Class -> [Type] -> Kind -> Bool -> MsgDoc
1781 derivingKindErr tc cls cls_tys cls_kind enough_args
1782 = sep [ hang (text "Cannot derive well-kinded instance of form"
1783 <+> quotes (pprClassPred cls cls_tys
1784 <+> parens (ppr tc <+> text "...")))
1785 2 gen1_suggestion
1786 , nest 2 (text "Class" <+> quotes (ppr cls)
1787 <+> text "expects an argument of kind"
1788 <+> quotes (pprKind cls_kind))
1789 ]
1790 where
1791 gen1_suggestion | cls `hasKey` gen1ClassKey && enough_args
1792 = text "(Perhaps you intended to use PolyKinds)"
1793 | otherwise = Outputable.empty
1794
1795 derivingEtaErr :: Class -> [Type] -> Type -> MsgDoc
1796 derivingEtaErr cls cls_tys inst_ty
1797 = sep [text "Cannot eta-reduce to an instance of form",
1798 nest 2 (text "instance (...) =>"
1799 <+> pprClassPred cls (cls_tys ++ [inst_ty]))]
1800
1801 derivingThingErr :: Bool -> Class -> [Type] -> Type -> Maybe DerivStrategy
1802 -> MsgDoc -> MsgDoc
1803 derivingThingErr newtype_deriving clas tys ty deriv_strat why
1804 = derivingThingErr' newtype_deriving clas tys ty (isJust deriv_strat)
1805 (maybe empty ppr deriv_strat) why
1806
1807 derivingThingErrMechanism :: Class -> [Type] -> Type
1808 -> Bool -- True if an explicit deriving strategy
1809 -- keyword was provided
1810 -> DerivSpecMechanism
1811 -> MsgDoc -> MsgDoc
1812 derivingThingErrMechanism clas tys ty strat_used mechanism why
1813 = derivingThingErr' (isDerivSpecNewtype mechanism) clas tys ty strat_used
1814 (ppr mechanism) why
1815
1816 derivingThingErr' :: Bool -> Class -> [Type] -> Type -> Bool -> MsgDoc
1817 -> MsgDoc -> MsgDoc
1818 derivingThingErr' newtype_deriving clas tys ty strat_used strat_msg why
1819 = sep [(hang (text "Can't make a derived instance of")
1820 2 (quotes (ppr pred) <+> via_mechanism)
1821 $$ nest 2 extra) <> colon,
1822 nest 2 why]
1823 where
1824 extra | not strat_used, newtype_deriving
1825 = text "(even with cunning GeneralizedNewtypeDeriving)"
1826 | otherwise = empty
1827 pred = mkClassPred clas (tys ++ [ty])
1828 via_mechanism | strat_used
1829 = text "with the" <+> strat_msg <+> text "strategy"
1830 | otherwise
1831 = empty
1832
1833 derivingHiddenErr :: TyCon -> SDoc
1834 derivingHiddenErr tc
1835 = hang (text "The data constructors of" <+> quotes (ppr tc) <+> ptext (sLit "are not all in scope"))
1836 2 (text "so you cannot derive an instance for it")
1837
1838 standaloneCtxt :: LHsSigType Name -> SDoc
1839 standaloneCtxt ty = hang (text "In the stand-alone deriving instance for")
1840 2 (quotes (ppr ty))
1841
1842 unboxedTyConErr :: String -> MsgDoc
1843 unboxedTyConErr thing =
1844 text "The last argument of the instance cannot be an unboxed" <+> text thing