Typos in comments only [ci skip]
[ghc.git] / compiler / typecheck / TcDerivUtils.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 Error-checking and other utilities for @deriving@ clauses or declarations.
7 -}
8
9 {-# LANGUAGE ImplicitParams #-}
10
11 module TcDerivUtils (
12 DerivSpec(..), pprDerivSpec,
13 DerivSpecMechanism(..), isDerivSpecStock,
14 isDerivSpecNewtype, isDerivSpecAnyClass,
15 DerivContext, DerivStatus(..),
16 PredOrigin(..), ThetaOrigin, mkPredOrigin,
17 mkThetaOrigin, substPredOrigin, substThetaOrigin,
18 checkSideConditions, hasStockDeriving,
19 canDeriveAnyClass,
20 std_class_via_coercible, non_coercible_class,
21 newDerivClsInst, extendLocalInstEnv
22 ) where
23
24 import Bag
25 import BasicTypes
26 import Class
27 import DataCon
28 import DynFlags
29 import ErrUtils
30 import HscTypes (lookupFixity, mi_fix)
31 import HsSyn
32 import Inst
33 import InstEnv
34 import LoadIface (loadInterfaceForName)
35 import Module (getModule)
36 import Name
37 import Outputable
38 import PrelNames
39 import RdrName
40 import SrcLoc
41 import TcGenDeriv
42 import TcGenFunctor
43 import TcGenGenerics
44 import TcRnMonad
45 import TcType
46 import THNames (liftClassKey)
47 import TyCon
48 import Type
49 import Util
50 import VarSet
51
52 import qualified GHC.LanguageExtensions as LangExt
53 import ListSetOps (assocMaybe)
54
55 data DerivSpec theta = DS { ds_loc :: SrcSpan
56 , ds_name :: Name -- DFun name
57 , ds_tvs :: [TyVar]
58 , ds_theta :: theta
59 , ds_cls :: Class
60 , ds_tys :: [Type]
61 , ds_tc :: TyCon
62 , ds_overlap :: Maybe OverlapMode
63 , ds_mechanism :: DerivSpecMechanism }
64 -- This spec implies a dfun declaration of the form
65 -- df :: forall tvs. theta => C tys
66 -- The Name is the name for the DFun we'll build
67 -- The tyvars bind all the variables in the theta
68 -- For type families, the tycon in
69 -- in ds_tys is the *family* tycon
70 -- in ds_tc is the *representation* type
71 -- For non-family tycons, both are the same
72
73 -- the theta is either the given and final theta, in standalone deriving,
74 -- or the not-yet-simplified list of constraints together with their origin
75
76 -- ds_mechanism specifies the means by which GHC derives the instance.
77 -- See Note [Deriving strategies] in TcDeriv
78
79 {-
80 Example:
81
82 newtype instance T [a] = MkT (Tree a) deriving( C s )
83 ==>
84 axiom T [a] = :RTList a
85 axiom :RTList a = Tree a
86
87 DS { ds_tvs = [a,s], ds_cls = C, ds_tys = [s, T [a]]
88 , ds_tc = :RTList, ds_mechanism = DerivSpecNewtype (Tree a) }
89 -}
90
91 pprDerivSpec :: Outputable theta => DerivSpec theta -> SDoc
92 pprDerivSpec (DS { ds_loc = l, ds_name = n, ds_tvs = tvs, ds_cls = c,
93 ds_tys = tys, ds_theta = rhs, ds_mechanism = mech })
94 = hang (text "DerivSpec")
95 2 (vcat [ text "ds_loc =" <+> ppr l
96 , text "ds_name =" <+> ppr n
97 , text "ds_tvs =" <+> ppr tvs
98 , text "ds_cls =" <+> ppr c
99 , text "ds_tys =" <+> ppr tys
100 , text "ds_theta =" <+> ppr rhs
101 , text "ds_mechanism =" <+> ppr mech ])
102
103 instance Outputable theta => Outputable (DerivSpec theta) where
104 ppr = pprDerivSpec
105
106 -- What action to take in order to derive a class instance.
107 -- See Note [Deriving strategies] in TcDeriv
108 -- NB: DerivSpecMechanism is purely local to this module
109 data DerivSpecMechanism
110 = DerivSpecStock -- "Standard" classes
111 (SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds RdrName, BagDerivStuff))
112
113 | DerivSpecNewtype -- -XGeneralizedNewtypeDeriving
114 Type -- ^ The newtype rep type
115
116 | DerivSpecAnyClass -- -XDeriveAnyClass
117
118 isDerivSpecStock, isDerivSpecNewtype, isDerivSpecAnyClass
119 :: DerivSpecMechanism -> Bool
120 isDerivSpecStock (DerivSpecStock{}) = True
121 isDerivSpecStock _ = False
122
123 isDerivSpecNewtype (DerivSpecNewtype{}) = True
124 isDerivSpecNewtype _ = False
125
126 isDerivSpecAnyClass (DerivSpecAnyClass{}) = True
127 isDerivSpecAnyClass _ = False
128
129 -- A DerivSpecMechanism can be losslessly converted to a DerivStrategy.
130 mechanismToStrategy :: DerivSpecMechanism -> DerivStrategy
131 mechanismToStrategy (DerivSpecStock{}) = StockStrategy
132 mechanismToStrategy (DerivSpecNewtype{}) = NewtypeStrategy
133 mechanismToStrategy (DerivSpecAnyClass{}) = AnyclassStrategy
134
135 instance Outputable DerivSpecMechanism where
136 ppr = ppr . mechanismToStrategy
137
138 type DerivContext = Maybe ThetaType
139 -- Nothing <=> Vanilla deriving; infer the context of the instance decl
140 -- Just theta <=> Standalone deriving: context supplied by programmer
141
142 data DerivStatus = CanDerive -- Stock class, can derive
143 | DerivableClassError SDoc -- Stock class, but can't do it
144 | DerivableViaInstance -- See Note [Deriving any class]
145 | NonDerivableClass SDoc -- Non-stock class
146
147 -- A stock class is one either defined in the Haskell report or for which GHC
148 -- otherwise knows how to generate code for (possibly requiring the use of a
149 -- language extension), such as Eq, Ord, Ix, Data, Generic, etc.
150
151 -- | A 'PredType' annotated with the origin of the constraint 'CtOrigin',
152 -- and whether or the constraint deals in types or kinds.
153 data PredOrigin = PredOrigin PredType CtOrigin TypeOrKind
154 type ThetaOrigin = [PredOrigin]
155
156 instance Outputable PredOrigin where
157 ppr (PredOrigin ty _ _) = ppr ty -- The origin is not so interesting when debugging
158
159 mkPredOrigin :: CtOrigin -> TypeOrKind -> PredType -> PredOrigin
160 mkPredOrigin origin t_or_k pred = PredOrigin pred origin t_or_k
161
162 mkThetaOrigin :: CtOrigin -> TypeOrKind -> ThetaType -> ThetaOrigin
163 mkThetaOrigin origin t_or_k = map (mkPredOrigin origin t_or_k)
164
165 substPredOrigin :: HasCallStack => TCvSubst -> PredOrigin -> PredOrigin
166 substPredOrigin subst (PredOrigin pred origin t_or_k)
167 = PredOrigin (substTy subst pred) origin t_or_k
168
169 substThetaOrigin :: HasCallStack => TCvSubst -> ThetaOrigin -> ThetaOrigin
170 substThetaOrigin subst = map (substPredOrigin subst)
171
172 {-
173 ************************************************************************
174 * *
175 Class deriving diagnostics
176 * *
177 ************************************************************************
178
179 Only certain blessed classes can be used in a deriving clause (without the
180 assistance of GeneralizedNewtypeDeriving or DeriveAnyClass). These classes
181 are listed below in the definition of hasStockDeriving. The sideConditions
182 function determines the criteria that needs to be met in order for a particular
183 class to be able to be derived successfully.
184
185 A class might be able to be used in a deriving clause if -XDeriveAnyClass
186 is willing to support it. The canDeriveAnyClass function checks if this is the
187 case.
188 -}
189
190 hasStockDeriving :: Class
191 -> Maybe (SrcSpan
192 -> TyCon
193 -> [Type]
194 -> TcM (LHsBinds RdrName, BagDerivStuff))
195 hasStockDeriving clas
196 = assocMaybe gen_list (getUnique clas)
197 where
198 gen_list :: [(Unique, SrcSpan
199 -> TyCon
200 -> [Type]
201 -> TcM (LHsBinds RdrName, BagDerivStuff))]
202 gen_list = [ (eqClassKey, simple gen_Eq_binds)
203 , (ordClassKey, simple gen_Ord_binds)
204 , (enumClassKey, simple gen_Enum_binds)
205 , (boundedClassKey, simple gen_Bounded_binds)
206 , (ixClassKey, simple gen_Ix_binds)
207 , (showClassKey, with_fix_env gen_Show_binds)
208 , (readClassKey, with_fix_env gen_Read_binds)
209 , (dataClassKey, simpleM gen_Data_binds)
210 , (functorClassKey, simple gen_Functor_binds)
211 , (foldableClassKey, simple gen_Foldable_binds)
212 , (traversableClassKey, simple gen_Traversable_binds)
213 , (liftClassKey, simple gen_Lift_binds)
214 , (genClassKey, generic (gen_Generic_binds Gen0))
215 , (gen1ClassKey, generic (gen_Generic_binds Gen1)) ]
216
217 simple gen_fn loc tc _
218 = return (gen_fn loc tc)
219
220 simpleM gen_fn loc tc _
221 = gen_fn loc tc
222
223 with_fix_env gen_fn loc tc _
224 = do { fix_env <- getDataConFixityFun tc
225 ; return (gen_fn fix_env loc tc) }
226
227 generic gen_fn _ tc inst_tys
228 = do { (binds, faminst) <- gen_fn tc inst_tys
229 ; return (binds, unitBag (DerivFamInst faminst)) }
230
231 getDataConFixityFun :: TyCon -> TcM (Name -> Fixity)
232 -- If the TyCon is locally defined, we want the local fixity env;
233 -- but if it is imported (which happens for standalone deriving)
234 -- we need to get the fixity env from the interface file
235 -- c.f. RnEnv.lookupFixity, and Trac #9830
236 getDataConFixityFun tc
237 = do { this_mod <- getModule
238 ; if nameIsLocalOrFrom this_mod name
239 then do { fix_env <- getFixityEnv
240 ; return (lookupFixity fix_env) }
241 else do { iface <- loadInterfaceForName doc name
242 -- Should already be loaded!
243 ; return (mi_fix iface . nameOccName) } }
244 where
245 name = tyConName tc
246 doc = text "Data con fixities for" <+> ppr name
247
248 ------------------------------------------------------------------
249 -- Check side conditions that dis-allow derivability for particular classes
250 -- This is *apart* from the newtype-deriving mechanism
251 --
252 -- Here we get the representation tycon in case of family instances as it has
253 -- the data constructors - but we need to be careful to fall back to the
254 -- family tycon (with indexes) in error messages.
255
256 checkSideConditions :: DynFlags -> DerivContext -> Class -> [TcType]
257 -> TyCon -- tycon
258 -> DerivStatus
259 checkSideConditions dflags mtheta cls cls_tys rep_tc
260 | Just cond <- sideConditions mtheta cls
261 = case (cond dflags rep_tc) of
262 NotValid err -> DerivableClassError err -- Class-specific error
263 IsValid | null (filterOutInvisibleTypes (classTyCon cls) cls_tys)
264 -> CanDerive
265 -- All stock derivable classes are unary in the sense that
266 -- there should be not types in cls_tys (i.e., no type args
267 -- other than last). Note that cls_types can contain
268 -- invisible types as well (e.g., for Generic1, which is
269 -- poly-kinded), so make sure those are not counted.
270 | otherwise -> DerivableClassError (classArgsErr cls cls_tys)
271 -- e.g. deriving( Eq s )
272
273 | Just err <- canDeriveAnyClass dflags rep_tc cls
274 = NonDerivableClass err -- DeriveAnyClass does not work
275
276 | otherwise
277 = DerivableViaInstance -- DeriveAnyClass should work
278
279 classArgsErr :: Class -> [Type] -> SDoc
280 classArgsErr cls cls_tys = quotes (ppr (mkClassPred cls cls_tys)) <+> text "is not a class"
281
282 -- Side conditions (whether the datatype must have at least one constructor,
283 -- required language extensions, etc.) for using GHC's stock deriving
284 -- mechanism on certain classes (as opposed to classes that require
285 -- GeneralizedNewtypeDeriving or DeriveAnyClass). Returns Nothing for a
286 -- class for which stock deriving isn't possible.
287 sideConditions :: DerivContext -> Class -> Maybe Condition
288 sideConditions mtheta cls
289 | cls_key == eqClassKey = Just (cond_std `andCond` cond_args cls)
290 | cls_key == ordClassKey = Just (cond_std `andCond` cond_args cls)
291 | cls_key == showClassKey = Just (cond_std `andCond` cond_args cls)
292 | cls_key == readClassKey = Just (cond_std `andCond` cond_args cls)
293 | cls_key == enumClassKey = Just (cond_std `andCond` cond_isEnumeration)
294 | cls_key == ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
295 | cls_key == boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
296 | cls_key == dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond`
297 cond_std `andCond`
298 cond_args cls)
299 | cls_key == functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond`
300 cond_vanilla `andCond`
301 cond_functorOK True False)
302 | cls_key == foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond`
303 cond_vanilla `andCond`
304 cond_functorOK False True)
305 -- Functor/Fold/Trav works ok
306 -- for rank-n types
307 | cls_key == traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond`
308 cond_vanilla `andCond`
309 cond_functorOK False False)
310 | cls_key == genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
311 cond_vanilla `andCond`
312 cond_RepresentableOk)
313 | cls_key == gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
314 cond_vanilla `andCond`
315 cond_Representable1Ok)
316 | cls_key == liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond`
317 cond_vanilla `andCond`
318 cond_args cls)
319 | otherwise = Nothing
320 where
321 cls_key = getUnique cls
322 cond_std = cond_stdOK mtheta False -- Vanilla data constructors, at least one,
323 -- and monotype arguments
324 cond_vanilla = cond_stdOK mtheta True -- Vanilla data constructors but
325 -- allow no data cons or polytype arguments
326
327 canDeriveAnyClass :: DynFlags -> TyCon -> Class -> Maybe SDoc
328 -- Nothing: we can (try to) derive it via an empty instance declaration
329 -- Just s: we can't, reason s
330 -- Precondition: the class is not one of the standard ones
331 canDeriveAnyClass dflags _tycon clas
332 | not (xopt LangExt.DeriveAnyClass dflags)
333 = Just (text "Try enabling DeriveAnyClass")
334 | not (any (target_kind `tcEqKind`) [ liftedTypeKind, typeToTypeKind ])
335 = Just (text "The last argument of class" <+> quotes (ppr clas)
336 <+> text "does not have kind * or (* -> *)")
337 | otherwise
338 = Nothing -- OK!
339 where
340 -- We are making an instance (C t1 .. tn (T s1 .. sm))
341 -- and we can only do so if the kind of C's last argument
342 -- is * or (* -> *). Because only then can we make a reasonable
343 -- guess at the instance context
344 target_kind = tyVarKind (last (classTyVars clas))
345
346 typeToTypeKind :: Kind
347 typeToTypeKind = liftedTypeKind `mkFunTy` liftedTypeKind
348
349 type Condition = DynFlags -> TyCon -> Validity
350 -- TyCon is the *representation* tycon if the data type is an indexed one
351 -- Nothing => OK
352
353 orCond :: Condition -> Condition -> Condition
354 orCond c1 c2 dflags tc
355 = case (c1 dflags tc, c2 dflags tc) of
356 (IsValid, _) -> IsValid -- c1 succeeds
357 (_, IsValid) -> IsValid -- c21 succeeds
358 (NotValid x, NotValid y) -> NotValid (x $$ text " or" $$ y)
359 -- Both fail
360
361 andCond :: Condition -> Condition -> Condition
362 andCond c1 c2 dflags tc = c1 dflags tc `andValid` c2 dflags tc
363
364 cond_stdOK :: DerivContext -- Says whether this is standalone deriving or not;
365 -- if standalone, we just say "yes, go for it"
366 -> Bool -- True <=> permissive: allow higher rank
367 -- args and no data constructors
368 -> Condition
369 cond_stdOK (Just _) _ _ _
370 = IsValid -- Don't check these conservative conditions for
371 -- standalone deriving; just generate the code
372 -- and let the typechecker handle the result
373 cond_stdOK Nothing permissive _ rep_tc
374 | null data_cons
375 , not permissive = NotValid (no_cons_why rep_tc $$ suggestion)
376 | not (null con_whys) = NotValid (vcat con_whys $$ suggestion)
377 | otherwise = IsValid
378 where
379 suggestion = text "Possible fix: use a standalone deriving declaration instead"
380 data_cons = tyConDataCons rep_tc
381 con_whys = getInvalids (map check_con data_cons)
382
383 check_con :: DataCon -> Validity
384 check_con con
385 | not (null eq_spec)
386 = bad "is a GADT"
387 | not (null ex_tvs)
388 = bad "has existential type variables in its type"
389 | not (null theta)
390 = bad "has constraints in its type"
391 | not (permissive || all isTauTy (dataConOrigArgTys con))
392 = bad "has a higher-rank type"
393 | otherwise
394 = IsValid
395 where
396 (_, ex_tvs, eq_spec, theta, _, _) = dataConFullSig con
397 bad msg = NotValid (badCon con (text msg))
398
399 no_cons_why :: TyCon -> SDoc
400 no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+>
401 text "must have at least one data constructor"
402
403 cond_RepresentableOk :: Condition
404 cond_RepresentableOk _ tc = canDoGenerics tc
405
406 cond_Representable1Ok :: Condition
407 cond_Representable1Ok _ tc = canDoGenerics1 tc
408
409 cond_enumOrProduct :: Class -> Condition
410 cond_enumOrProduct cls = cond_isEnumeration `orCond`
411 (cond_isProduct `andCond` cond_args cls)
412
413 cond_args :: Class -> Condition
414 -- For some classes (eg Eq, Ord) we allow unlifted arg types
415 -- by generating specialised code. For others (eg Data) we don't.
416 cond_args cls _ tc
417 = case bad_args of
418 [] -> IsValid
419 (ty:_) -> NotValid (hang (text "Don't know how to derive" <+> quotes (ppr cls))
420 2 (text "for type" <+> quotes (ppr ty)))
421 where
422 bad_args = [ arg_ty | con <- tyConDataCons tc
423 , arg_ty <- dataConOrigArgTys con
424 , isUnliftedType arg_ty
425 , not (ok_ty arg_ty) ]
426
427 cls_key = classKey cls
428 ok_ty arg_ty
429 | cls_key == eqClassKey = check_in arg_ty ordOpTbl
430 | cls_key == ordClassKey = check_in arg_ty ordOpTbl
431 | cls_key == showClassKey = check_in arg_ty boxConTbl
432 | cls_key == liftClassKey = check_in arg_ty litConTbl
433 | otherwise = False -- Read, Ix etc
434
435 check_in :: Type -> [(Type,a)] -> Bool
436 check_in arg_ty tbl = any (eqType arg_ty . fst) tbl
437
438
439 cond_isEnumeration :: Condition
440 cond_isEnumeration _ rep_tc
441 | isEnumerationTyCon rep_tc = IsValid
442 | otherwise = NotValid why
443 where
444 why = sep [ quotes (pprSourceTyCon rep_tc) <+>
445 text "must be an enumeration type"
446 , text "(an enumeration consists of one or more nullary, non-GADT constructors)" ]
447 -- See Note [Enumeration types] in TyCon
448
449 cond_isProduct :: Condition
450 cond_isProduct _ rep_tc
451 | isProductTyCon rep_tc = IsValid
452 | otherwise = NotValid why
453 where
454 why = quotes (pprSourceTyCon rep_tc) <+>
455 text "must have precisely one constructor"
456
457 cond_functorOK :: Bool -> Bool -> Condition
458 -- OK for Functor/Foldable/Traversable class
459 -- Currently: (a) at least one argument
460 -- (b) don't use argument contravariantly
461 -- (c) don't use argument in the wrong place, e.g. data T a = T (X a a)
462 -- (d) optionally: don't use function types
463 -- (e) no "stupid context" on data type
464 cond_functorOK allowFunctions allowExQuantifiedLastTyVar _ rep_tc
465 | null tc_tvs
466 = NotValid (text "Data type" <+> quotes (ppr rep_tc)
467 <+> text "must have some type parameters")
468
469 | not (null bad_stupid_theta)
470 = NotValid (text "Data type" <+> quotes (ppr rep_tc)
471 <+> text "must not have a class context:" <+> pprTheta bad_stupid_theta)
472
473 | otherwise
474 = allValid (map check_con data_cons)
475 where
476 tc_tvs = tyConTyVars rep_tc
477 Just (_, last_tv) = snocView tc_tvs
478 bad_stupid_theta = filter is_bad (tyConStupidTheta rep_tc)
479 is_bad pred = last_tv `elemVarSet` tyCoVarsOfType pred
480
481 data_cons = tyConDataCons rep_tc
482 check_con con = allValid (check_universal con : foldDataConArgs (ft_check con) con)
483
484 check_universal :: DataCon -> Validity
485 check_universal con
486 | allowExQuantifiedLastTyVar
487 = IsValid -- See Note [DeriveFoldable with ExistentialQuantification]
488 -- in TcGenFunctor
489 | Just tv <- getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con)))
490 , tv `elem` dataConUnivTyVars con
491 , not (tv `elemVarSet` tyCoVarsOfTypes (dataConTheta con))
492 = IsValid -- See Note [Check that the type variable is truly universal]
493 | otherwise
494 = NotValid (badCon con existential)
495
496 ft_check :: DataCon -> FFoldType Validity
497 ft_check con = FT { ft_triv = IsValid, ft_var = IsValid
498 , ft_co_var = NotValid (badCon con covariant)
499 , ft_fun = \x y -> if allowFunctions then x `andValid` y
500 else NotValid (badCon con functions)
501 , ft_tup = \_ xs -> allValid xs
502 , ft_ty_app = \_ x -> x
503 , ft_bad_app = NotValid (badCon con wrong_arg)
504 , ft_forall = \_ x -> x }
505
506 existential = text "must be truly polymorphic in the last argument of the data type"
507 covariant = text "must not use the type variable in a function argument"
508 functions = text "must not contain function types"
509 wrong_arg = text "must use the type variable only as the last argument of a data type"
510
511 checkFlag :: LangExt.Extension -> Condition
512 checkFlag flag dflags _
513 | xopt flag dflags = IsValid
514 | otherwise = NotValid why
515 where
516 why = text "You need " <> text flag_str
517 <+> text "to derive an instance for this class"
518 flag_str = case [ flagSpecName f | f <- xFlags , flagSpecFlag f == flag ] of
519 [s] -> s
520 other -> pprPanic "checkFlag" (ppr other)
521
522 std_class_via_coercible :: Class -> Bool
523 -- These standard classes can be derived for a newtype
524 -- using the coercible trick *even if no -XGeneralizedNewtypeDeriving
525 -- because giving so gives the same results as generating the boilerplate
526 std_class_via_coercible clas
527 = classKey clas `elem` [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]
528 -- Not Read/Show because they respect the type
529 -- Not Enum, because newtypes are never in Enum
530
531
532 non_coercible_class :: Class -> Bool
533 -- *Never* derive Read, Show, Typeable, Data, Generic, Generic1, Lift
534 -- by Coercible, even with -XGeneralizedNewtypeDeriving
535 -- Also, avoid Traversable, as the Coercible-derived instance and the "normal"-derived
536 -- instance behave differently if there's a non-lawful Applicative out there.
537 -- Besides, with roles, Coercible-deriving Traversable is ill-roled.
538 non_coercible_class cls
539 = classKey cls `elem` ([ readClassKey, showClassKey, dataClassKey
540 , genClassKey, gen1ClassKey, typeableClassKey
541 , traversableClassKey, liftClassKey ])
542
543 badCon :: DataCon -> SDoc -> SDoc
544 badCon con msg = text "Constructor" <+> quotes (ppr con) <+> msg
545
546 ------------------------------------------------------------------
547
548 newDerivClsInst :: ThetaType -> DerivSpec theta -> TcM ClsInst
549 newDerivClsInst theta (DS { ds_name = dfun_name, ds_overlap = overlap_mode
550 , ds_tvs = tvs, ds_cls = clas, ds_tys = tys })
551 = newClsInst overlap_mode dfun_name tvs theta clas tys
552
553 extendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
554 -- Add new locally-defined instances; don't bother to check
555 -- for functional dependency errors -- that'll happen in TcInstDcls
556 extendLocalInstEnv dfuns thing_inside
557 = do { env <- getGblEnv
558 ; let inst_env' = extendInstEnvList (tcg_inst_env env) dfuns
559 env' = env { tcg_inst_env = inst_env' }
560 ; setGblEnv env' thing_inside }
561
562 {-
563 Note [Deriving any class]
564 ~~~~~~~~~~~~~~~~~~~~~~~~~
565 Classic uses of a deriving clause, or a standalone-deriving declaration, are
566 for:
567 * a stock class like Eq or Show, for which GHC knows how to generate
568 the instance code
569 * a newtype, via the mechanism enabled by GeneralizedNewtypeDeriving
570
571 The DeriveAnyClass extension adds a third way to derive instances, based on
572 empty instance declarations.
573
574 The canonical use case is in combination with GHC.Generics and default method
575 signatures. These allow us to have instance declarations being empty, but still
576 useful, e.g.
577
578 data T a = ...blah..blah... deriving( Generic )
579 instance C a => C (T a) -- No 'where' clause
580
581 where C is some "random" user-defined class.
582
583 This boilerplate code can be replaced by the more compact
584
585 data T a = ...blah..blah... deriving( Generic, C )
586
587 if DeriveAnyClass is enabled.
588
589 This is not restricted to Generics; any class can be derived, simply giving
590 rise to an empty instance.
591
592 Unfortunately, it is not clear how to determine the context (when using a
593 deriving clause; in standalone deriving, the user provides the context).
594 GHC uses the same heuristic for figuring out the class context that it uses for
595 Eq in the case of *-kinded classes, and for Functor in the case of
596 * -> *-kinded classes. That may not be optimal or even wrong. But in such
597 cases, standalone deriving can still be used.
598
599 Note [Check that the type variable is truly universal]
600 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
601 For Functor and Traversable instances, we must check that the *last argument*
602 of the type constructor is used truly universally quantified. Example
603
604 data T a b where
605 T1 :: a -> b -> T a b -- Fine! Vanilla H-98
606 T2 :: b -> c -> T a b -- Fine! Existential c, but we can still map over 'b'
607 T3 :: b -> T Int b -- Fine! Constraint 'a', but 'b' is still polymorphic
608 T4 :: Ord b => b -> T a b -- No! 'b' is constrained
609 T5 :: b -> T b b -- No! 'b' is constrained
610 T6 :: T a (b,b) -- No! 'b' is constrained
611
612 Notice that only the first of these constructors is vanilla H-98. We only
613 need to take care about the last argument (b in this case). See Trac #8678.
614 Eg. for T1-T3 we can write
615
616 fmap f (T1 a b) = T1 a (f b)
617 fmap f (T2 b c) = T2 (f b) c
618 fmap f (T3 x) = T3 (f x)
619
620 We need not perform these checks for Foldable instances, however, since
621 functions in Foldable can only consume existentially quantified type variables,
622 rather than produce them (as is the case in Functor and Traversable functions.)
623 As a result, T can have a derived Foldable instance:
624
625 foldr f z (T1 a b) = f b z
626 foldr f z (T2 b c) = f b z
627 foldr f z (T3 x) = f x z
628 foldr f z (T4 x) = f x z
629 foldr f z (T5 x) = f x z
630 foldr _ z T6 = z
631
632 See Note [DeriveFoldable with ExistentialQuantification] in TcGenFunctor.
633 -}