2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 Handles @deriving@ clauses on @data@ declarations.
9 module TcDeriv ( tcDeriving ) where
11 #include "HsVersions.h"
19 import TcClassDcl( tcAddDeclCtxt ) -- Small helper
20 import TcGenDeriv -- Deriv stuff
53 %************************************************************************
57 %************************************************************************
61 1. Convert the decls (i.e. data/newtype deriving clauses,
62 plus standalone deriving) to [EarlyDerivSpec]
64 2. Infer the missing contexts for the Left DerivSpecs
66 3. Add the derived bindings, generating InstInfos
69 -- DerivSpec is purely local to this module
70 data DerivSpec = DS { ds_loc :: SrcSpan
71 , ds_orig :: InstOrigin
74 , ds_theta :: ThetaType
78 , ds_newtype :: Bool }
79 -- This spec implies a dfun declaration of the form
80 -- df :: forall tvs. theta => C tys
81 -- The Name is the name for the DFun we'll build
82 -- The tyvars bind all the variables in the theta
83 -- For family indexes, the tycon in
84 -- in ds_tys is the *family* tycon
85 -- in ds_tc is the *representation* tycon
86 -- For non-family tycons, both are the same
88 -- ds_newtype = True <=> Newtype deriving
89 -- False <=> Vanilla deriving
91 type EarlyDerivSpec = Either DerivSpec DerivSpec
92 -- Left ds => the context for the instance should be inferred
93 -- In this case ds_theta is the list of all the
94 -- constraints needed, such as (Eq [a], Eq a)
95 -- The inference process is to reduce this to a
96 -- simpler form (e.g. Eq a)
98 -- Right ds => the exact context for the instance is supplied
99 -- by the programmer; it is ds_theta
101 pprDerivSpec :: DerivSpec -> SDoc
102 pprDerivSpec (DS { ds_loc = l, ds_name = n, ds_tvs = tvs,
103 ds_cls = c, ds_tys = tys, ds_theta = rhs })
104 = parens (hsep [ppr l, ppr n, ppr tvs, ppr c, ppr tys]
105 <+> equals <+> ppr rhs)
109 Inferring missing contexts
110 ~~~~~~~~~~~~~~~~~~~~~~~~~~
113 data T a b = C1 (Foo a) (Bar b)
118 [NOTE: See end of these comments for what to do with
119 data (C a, D b) => T a b = ...
122 We want to come up with an instance declaration of the form
124 instance (Ping a, Pong b, ...) => Eq (T a b) where
127 It is pretty easy, albeit tedious, to fill in the code "...". The
128 trick is to figure out what the context for the instance decl is,
129 namely @Ping@, @Pong@ and friends.
131 Let's call the context reqd for the T instance of class C at types
132 (a,b, ...) C (T a b). Thus:
134 Eq (T a b) = (Ping a, Pong b, ...)
136 Now we can get a (recursive) equation from the @data@ decl:
138 Eq (T a b) = Eq (Foo a) u Eq (Bar b) -- From C1
139 u Eq (T b a) u Eq Int -- From C2
140 u Eq (T a a) -- From C3
142 Foo and Bar may have explicit instances for @Eq@, in which case we can
143 just substitute for them. Alternatively, either or both may have
144 their @Eq@ instances given by @deriving@ clauses, in which case they
145 form part of the system of equations.
147 Now all we need do is simplify and solve the equations, iterating to
148 find the least fixpoint. Notice that the order of the arguments can
149 switch around, as here in the recursive calls to T.
151 Let's suppose Eq (Foo a) = Eq a, and Eq (Bar b) = Ping b.
155 Eq (T a b) = {} -- The empty set
158 Eq (T a b) = Eq (Foo a) u Eq (Bar b) -- From C1
159 u Eq (T b a) u Eq Int -- From C2
160 u Eq (T a a) -- From C3
162 After simplification:
163 = Eq a u Ping b u {} u {} u {}
168 Eq (T a b) = Eq (Foo a) u Eq (Bar b) -- From C1
169 u Eq (T b a) u Eq Int -- From C2
170 u Eq (T a a) -- From C3
172 After simplification:
177 = Eq a u Ping b u Eq b u Ping a
179 The next iteration gives the same result, so this is the fixpoint. We
180 need to make a canonical form of the RHS to ensure convergence. We do
181 this by simplifying the RHS to a form in which
183 - the classes constrain only tyvars
184 - the list is sorted by tyvar (major key) and then class (minor key)
185 - no duplicates, of course
187 So, here are the synonyms for the ``equation'' structures:
190 Note [Data decl contexts]
191 ~~~~~~~~~~~~~~~~~~~~~~~~~
194 data (RealFloat a) => Complex a = !a :+ !a deriving( Read )
196 We will need an instance decl like:
198 instance (Read a, RealFloat a) => Read (Complex a) where
201 The RealFloat in the context is because the read method for Complex is bound
202 to construct a Complex, and doing that requires that the argument type is
205 But this ain't true for Show, Eq, Ord, etc, since they don't construct
206 a Complex; they only take them apart.
208 Our approach: identify the offending classes, and add the data type
209 context to the instance decl. The "offending classes" are
213 FURTHER NOTE ADDED March 2002. In fact, Haskell98 now requires that
214 pattern matching against a constructor from a data type with a context
215 gives rise to the constraints for that context -- or at least the thinned
216 version. So now all classes are "offending".
218 Note [Newtype deriving]
219 ~~~~~~~~~~~~~~~~~~~~~~~
223 newtype T = T Char deriving( C [a] )
225 Notice the free 'a' in the deriving. We have to fill this out to
226 newtype T = T Char deriving( forall a. C [a] )
228 And then translate it to:
229 instance C [a] Char => C [a] T where ...
232 Note [Newtype deriving superclasses]
233 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
234 (See also Trac #1220 for an interesting exchange on newtype
235 deriving and superclasses.)
237 The 'tys' here come from the partial application in the deriving
238 clause. The last arg is the new instance type.
240 We must pass the superclasses; the newtype might be an instance
241 of them in a different way than the representation type
242 E.g. newtype Foo a = Foo a deriving( Show, Num, Eq )
243 Then the Show instance is not done via isomorphism; it shows
245 The Num instance is derived via isomorphism, but the Show superclass
246 dictionary must the Show instance for Foo, *not* the Show dictionary
247 gotten from the Num dictionary. So we must build a whole new dictionary
248 not just use the Num one. The instance we want is something like:
249 instance (Num a, Show (Foo a), Eq (Foo a)) => Num (Foo a) where
252 There may be a coercion needed which we get from the tycon for the newtype
253 when the dict is constructed in TcInstDcls.tcInstDecl2
258 %************************************************************************
260 \subsection[TcDeriv-driver]{Top-level function for \tr{derivings}}
262 %************************************************************************
265 tcDeriving :: [LTyClDecl Name] -- All type constructors
266 -> [LInstDecl Name] -- All instance declarations
267 -> [LDerivDecl Name] -- All stand-alone deriving declarations
268 -> TcM ([InstInfo Name], -- The generated "instance decls"
269 HsValBinds Name) -- Extra generated top-level bindings
271 tcDeriving tycl_decls inst_decls deriv_decls
272 = recoverM (return ([], emptyValBindsOut)) $
273 do { -- Fish the "deriving"-related information out of the TcEnv
274 -- And make the necessary "equations".
275 is_boot <- tcIsHsBoot
276 ; traceTc (text "tcDeriving" <+> ppr is_boot)
277 ; early_specs <- makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls
279 ; overlap_flag <- getOverlapFlag
280 ; let (infer_specs, given_specs) = splitEithers early_specs
281 ; insts1 <- mapM (genInst overlap_flag) given_specs
283 ; final_specs <- extendLocalInstEnv (map (iSpec . fst) insts1) $
284 inferInstanceContexts overlap_flag infer_specs
286 ; insts2 <- mapM (genInst overlap_flag) final_specs
288 -- Generate the generic to/from functions from each type declaration
289 ; gen_binds <- mkGenericBinds is_boot
290 ; (inst_info, rn_binds) <- renameDeriv is_boot gen_binds (insts1 ++ insts2)
293 ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances"
294 (ddump_deriving inst_info rn_binds))
296 ; return (inst_info, rn_binds) }
298 ddump_deriving :: [InstInfo Name] -> HsValBinds Name -> SDoc
299 ddump_deriving inst_infos extra_binds
300 = vcat (map pprInstInfoDetails inst_infos) $$ ppr extra_binds
302 renameDeriv :: Bool -> LHsBinds RdrName
303 -> [(InstInfo RdrName, DerivAuxBinds)]
304 -> TcM ([InstInfo Name], HsValBinds Name)
305 renameDeriv is_boot gen_binds insts
306 | is_boot -- If we are compiling a hs-boot file, don't generate any derived bindings
307 -- The inst-info bindings will all be empty, but it's easier to
308 -- just use rn_inst_info to change the type appropriately
309 = do { rn_inst_infos <- mapM rn_inst_info inst_infos
310 ; return (rn_inst_infos, emptyValBindsOut) }
313 = discardWarnings $ -- Discard warnings about unused bindings etc
314 do { (rn_gen, dus_gen) <- setOptM Opt_ScopedTypeVariables $ -- Type signatures in patterns
315 -- are used in the generic binds
316 rnTopBinds (ValBindsIn gen_binds [])
317 ; keepAliveSetTc (duDefs dus_gen) -- Mark these guys to be kept alive
319 -- Generate and rename any extra not-one-inst-decl-specific binds,
320 -- notably "con2tag" and/or "tag2con" functions.
321 -- Bring those names into scope before renaming the instances themselves
322 ; loc <- getSrcSpanM -- Generic loc for shared bindings
323 ; let aux_binds = listToBag $ map (genAuxBind loc) $
324 rm_dups [] $ concat deriv_aux_binds
325 ; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv (ValBindsIn aux_binds [])
326 ; let aux_names = map unLoc (collectHsValBinders rn_aux_lhs)
328 ; bindLocalNames aux_names $
329 do { (rn_aux, _dus) <- rnTopBindsRHS (mkNameSet aux_names) rn_aux_lhs
330 ; rn_inst_infos <- mapM rn_inst_info inst_infos
331 ; return (rn_inst_infos, rn_aux `plusHsValBinds` rn_gen) } }
334 (inst_infos, deriv_aux_binds) = unzip insts
336 -- Remove duplicate requests for auxilliary bindings
338 rm_dups acc (b:bs) | any (isDupAux b) acc = rm_dups acc bs
339 | otherwise = rm_dups (b:acc) bs
342 rn_inst_info (InstInfo { iSpec = inst, iBinds = NewTypeDerived })
343 = return (InstInfo { iSpec = inst, iBinds = NewTypeDerived })
345 rn_inst_info (InstInfo { iSpec = inst, iBinds = VanillaInst binds sigs })
346 = -- Bring the right type variables into
347 -- scope (yuk), and rename the method binds
349 bindLocalNames (map Var.varName tyvars) $
350 do { (rn_binds, _fvs) <- rnMethodBinds clas_nm (\_ -> []) [] binds
351 ; return (InstInfo { iSpec = inst, iBinds = VanillaInst rn_binds [] }) }
353 (tyvars,_,clas,_) = instanceHead inst
354 clas_nm = className clas
356 -----------------------------------------
357 mkGenericBinds :: Bool -> TcM (LHsBinds RdrName)
358 mkGenericBinds is_boot
362 = do { gbl_env <- getGblEnv
363 ; let tcs = typeEnvTyCons (tcg_type_env gbl_env)
364 ; return (unionManyBags [ mkTyConGenericBinds tc |
365 tc <- tcs, tyConHasGenerics tc ]) }
366 -- We are only interested in the data type declarations,
367 -- and then only in the ones whose 'has-generics' flag is on
368 -- The predicate tyConHasGenerics finds both of these
372 %************************************************************************
374 From HsSyn to DerivSpec
376 %************************************************************************
378 @makeDerivSpecs@ fishes around to find the info about needed derived instances.
381 makeDerivSpecs :: Bool
385 -> TcM [EarlyDerivSpec]
387 makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls
388 | is_boot -- No 'deriving' at all in hs-boot files
389 = do { mapM_ add_deriv_err deriv_locs
392 = do { eqns1 <- mapAndRecoverM deriveTyData all_tydata
393 ; eqns2 <- mapAndRecoverM deriveStandalone deriv_decls
394 ; return (eqns1 ++ eqns2) }
396 extractTyDataPreds decls
397 = [(p, d) | d@(L _ (TyData {tcdDerivs = Just preds})) <- decls, p <- preds]
399 all_tydata :: [(LHsType Name, LTyClDecl Name)]
400 -- Derived predicate paired with its data type declaration
401 all_tydata = extractTyDataPreds tycl_decls ++
402 [ pd -- Traverse assoc data families
403 | L _ (InstDecl _ _ _ ats) <- inst_decls
404 , pd <- extractTyDataPreds ats ]
406 deriv_locs = map (getLoc . snd) all_tydata
407 ++ map getLoc deriv_decls
409 add_deriv_err loc = setSrcSpan loc $
410 addErr (hang (ptext (sLit "Deriving not permitted in hs-boot file"))
411 2 (ptext (sLit "Use an instance declaration instead")))
413 ------------------------------------------------------------------
414 deriveStandalone :: LDerivDecl Name -> TcM EarlyDerivSpec
415 -- Standalone deriving declarations
416 -- e.g. deriving instance Show a => Show (T a)
417 -- Rather like tcLocalInstDecl
418 deriveStandalone (L loc (DerivDecl deriv_ty))
420 addErrCtxt (standaloneCtxt deriv_ty) $
421 do { traceTc (text "standalone deriving decl for" <+> ppr deriv_ty)
422 ; (tvs, theta, tau) <- tcHsInstHead deriv_ty
423 ; traceTc (text "standalone deriving;"
424 <+> text "tvs:" <+> ppr tvs
425 <+> text "theta:" <+> ppr theta
426 <+> text "tau:" <+> ppr tau)
427 ; (cls, inst_tys) <- checkValidInstHead tau
428 ; checkValidInstance tvs theta cls inst_tys
429 -- C.f. TcInstDcls.tcLocalInstDecl1
431 ; let cls_tys = take (length inst_tys - 1) inst_tys
432 inst_ty = last inst_tys
433 ; traceTc (text "standalone deriving;"
434 <+> text "class:" <+> ppr cls
435 <+> text "class types:" <+> ppr cls_tys
436 <+> text "type:" <+> ppr inst_ty)
437 ; mkEqnHelp StandAloneDerivOrigin tvs cls cls_tys inst_ty
440 ------------------------------------------------------------------
441 deriveTyData :: (LHsType Name, LTyClDecl Name) -> TcM EarlyDerivSpec
442 deriveTyData (L loc deriv_pred, L _ decl@(TyData { tcdLName = L _ tycon_name,
443 tcdTyVars = tv_names,
444 tcdTyPats = ty_pats }))
445 = setSrcSpan loc $ -- Use the location of the 'deriving' item
447 do { (tvs, tc, tc_args) <- get_lhs ty_pats
448 ; tcExtendTyVarEnv tvs $ -- Deriving preds may (now) mention
449 -- the type variables for the type constructor
451 do { (deriv_tvs, cls, cls_tys) <- tcHsDeriv deriv_pred
452 -- The "deriv_pred" is a LHsType to take account of the fact that for
453 -- newtype deriving we allow deriving (forall a. C [a]).
455 -- Given data T a b c = ... deriving( C d ),
456 -- we want to drop type variables from T so that (C d (T a)) is well-kinded
457 ; let cls_tyvars = classTyVars cls
458 kind = tyVarKind (last cls_tyvars)
459 (arg_kinds, _) = splitKindFunTys kind
460 n_args_to_drop = length arg_kinds
461 n_args_to_keep = tyConArity tc - n_args_to_drop
462 inst_ty = mkTyConApp tc (take n_args_to_keep tc_args)
463 inst_ty_kind = typeKind inst_ty
465 -- Check that the result really is well-kinded
466 ; checkTc (n_args_to_keep >= 0 && (inst_ty_kind `eqKind` kind))
467 (derivingKindErr tc cls cls_tys kind)
469 -- Type families can't be partially applied
470 -- e.g. newtype instance T Int a = ... deriving( Monad )
471 ; checkTc (not (isOpenTyCon tc) || n_args_to_drop == 0)
472 (typeFamilyPapErr tc cls cls_tys inst_ty)
474 ; mkEqnHelp DerivOrigin (tvs++deriv_tvs) cls cls_tys inst_ty Nothing } }
476 -- Tiresomely we must figure out the "lhs", which is awkward for type families
477 -- E.g. data T a b = .. deriving( Eq )
478 -- Here, the lhs is (T a b)
479 -- data instance TF Int b = ... deriving( Eq )
480 -- Here, the lhs is (TF Int b)
481 -- But if we just look up the tycon_name, we get is the *family*
482 -- tycon, but not pattern types -- they are in the *rep* tycon.
483 get_lhs Nothing = do { tc <- tcLookupTyCon tycon_name
484 ; let tvs = tyConTyVars tc
485 ; return (tvs, tc, mkTyVarTys tvs) }
486 get_lhs (Just pats) = do { let hs_app = nlHsTyConApp tycon_name pats
487 ; (tvs, tc_app) <- tcHsQuantifiedType tv_names hs_app
488 ; let (tc, tc_args) = tcSplitTyConApp tc_app
489 ; return (tvs, tc, tc_args) }
492 = panic "derivTyData" -- Caller ensures that only TyData can happen
494 ------------------------------------------------------------------
495 mkEqnHelp :: InstOrigin -> [TyVar] -> Class -> [Type] -> Type
496 -> Maybe ThetaType -- Just => context supplied (standalone deriving)
497 -- Nothing => context inferred (deriving on data decl)
498 -> TcRn EarlyDerivSpec
499 -- Make the EarlyDerivSpec for an instance
500 -- forall tvs. theta => cls (tys ++ [ty])
501 -- where the 'theta' is optional (that's the Maybe part)
502 -- Assumes that this declaration is well-kinded
504 mkEqnHelp orig tvs cls cls_tys tc_app mtheta
505 | Just (tycon, tc_args) <- tcSplitTyConApp_maybe tc_app
506 , isAlgTyCon tycon -- Check for functions, primitive types etc
507 = do { (rep_tc, rep_tc_args) <- tcLookupFamInstExact tycon tc_args
508 -- Be careful to test rep_tc here: in the case of families,
509 -- we want to check the instance tycon, not the family tycon
511 -- For standalone deriving (mtheta /= Nothing),
512 -- check that all the data constructors are in scope.
513 -- No need for this when deriving Typeable, becuase we don't need
514 -- the constructors for that.
515 ; rdr_env <- getGlobalRdrEnv
516 ; let hidden_data_cons = isAbstractTyCon rep_tc || any not_in_scope (tyConDataCons rep_tc)
517 not_in_scope dc = null (lookupGRE_Name rdr_env (dataConName dc))
518 ; checkTc (isNothing mtheta ||
519 not hidden_data_cons ||
520 className cls `elem` typeableClassNames)
521 (derivingHiddenErr tycon)
523 ; mayDeriveDataTypeable <- doptM Opt_DeriveDataTypeable
524 ; newtype_deriving <- doptM Opt_GeneralizedNewtypeDeriving
526 ; if isDataTyCon rep_tc then
527 mkDataTypeEqn orig mayDeriveDataTypeable tvs cls cls_tys
528 tycon tc_args rep_tc rep_tc_args mtheta
530 mkNewTypeEqn orig mayDeriveDataTypeable newtype_deriving
532 tycon tc_args rep_tc rep_tc_args mtheta }
534 = failWithTc (derivingThingErr cls cls_tys tc_app
535 (ptext (sLit "The last argument of the instance must be a data or newtype application")))
538 Note [Looking up family instances for deriving]
539 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
540 tcLookupFamInstExact is an auxiliary lookup wrapper which requires
541 that looked-up family instances exist. If called with a vanilla
542 tycon, the old type application is simply returned.
545 data instance F () = ... deriving Eq
546 data instance F () = ... deriving Eq
547 then tcLookupFamInstExact will be confused by the two matches;
548 but that can't happen because tcInstDecls1 doesn't call tcDeriving
549 if there are any overlaps.
551 There are two other things that might go wrong with the lookup.
552 First, we might see a standalone deriving clause
554 when there is no data instance F () in scope.
556 Note that it's OK to have
557 data instance F [a] = ...
558 deriving Eq (F [(a,b)])
559 where the match is not exact; the same holds for ordinary data types
560 with standalone deriving declrations.
563 tcLookupFamInstExact :: TyCon -> [Type] -> TcM (TyCon, [Type])
564 tcLookupFamInstExact tycon tys
565 | not (isOpenTyCon tycon)
566 = return (tycon, tys)
568 = do { maybeFamInst <- tcLookupFamInst tycon tys
569 ; case maybeFamInst of
570 Nothing -> famInstNotFound tycon tys
571 Just famInst -> return famInst
574 famInstNotFound :: TyCon -> [Type] -> TcM a
575 famInstNotFound tycon tys
576 = failWithTc (ptext (sLit "No family instance for")
577 <+> quotes (pprTypeApp tycon tys))
581 %************************************************************************
585 %************************************************************************
588 mkDataTypeEqn :: InstOrigin -> Bool -> [Var] -> Class -> [Type]
589 -> TyCon -> [Type] -> TyCon -> [Type] -> Maybe ThetaType
590 -> TcRn EarlyDerivSpec -- Return 'Nothing' if error
592 mkDataTypeEqn orig mayDeriveDataTypeable tvs cls cls_tys
593 tycon tc_args rep_tc rep_tc_args mtheta
594 = case checkSideConditions mayDeriveDataTypeable cls cls_tys rep_tc of
595 -- NB: pass the *representation* tycon to checkSideConditions
596 CanDerive -> mk_data_eqn orig tvs cls tycon tc_args rep_tc rep_tc_args mtheta
597 NonDerivableClass -> bale_out (nonStdErr cls)
598 DerivableClassError msg -> bale_out msg
600 bale_out msg = failWithTc (derivingThingErr cls cls_tys (mkTyConApp tycon tc_args) msg)
602 mk_data_eqn, mk_typeable_eqn
603 :: InstOrigin -> [TyVar] -> Class
604 -> TyCon -> [TcType] -> TyCon -> [TcType] -> Maybe ThetaType
605 -> TcM EarlyDerivSpec
606 mk_data_eqn orig tvs cls tycon tc_args rep_tc rep_tc_args mtheta
607 | getName cls `elem` typeableClassNames
608 = mk_typeable_eqn orig tvs cls tycon tc_args rep_tc rep_tc_args mtheta
611 = do { dfun_name <- new_dfun_name cls tycon
613 ; let ordinary_constraints
614 = [ mkClassPred cls [arg_ty]
615 | data_con <- tyConDataCons rep_tc,
616 arg_ty <- ASSERT( isVanillaDataCon data_con )
617 dataConInstOrigArgTys data_con rep_tc_args,
618 not (isUnLiftedType arg_ty) ]
619 -- No constraints for unlifted types
620 -- Where they are legal we generate specilised function calls
622 -- See Note [Superclasses of derived instance]
623 sc_constraints = substTheta (zipOpenTvSubst (classTyVars cls) inst_tys)
625 inst_tys = [mkTyConApp tycon tc_args]
627 stupid_subst = zipTopTvSubst (tyConTyVars rep_tc) rep_tc_args
628 stupid_constraints = substTheta stupid_subst (tyConStupidTheta rep_tc)
629 all_constraints = stupid_constraints ++ sc_constraints ++ ordinary_constraints
631 spec = DS { ds_loc = loc, ds_orig = orig
632 , ds_name = dfun_name, ds_tvs = tvs
633 , ds_cls = cls, ds_tys = inst_tys, ds_tc = rep_tc
634 , ds_theta = mtheta `orElse` all_constraints
635 , ds_newtype = False }
637 ; return (if isJust mtheta then Right spec -- Specified context
638 else Left spec) } -- Infer context
640 mk_typeable_eqn orig tvs cls tycon tc_args rep_tc _rep_tc_args mtheta
641 -- The Typeable class is special in several ways
642 -- data T a b = ... deriving( Typeable )
644 -- instance Typeable2 T where ...
646 -- 1. There are no constraints in the instance
647 -- 2. There are no type variables either
648 -- 3. The actual class we want to generate isn't necessarily
649 -- Typeable; it depends on the arity of the type
650 | isNothing mtheta -- deriving on a data type decl
651 = do { checkTc (cls `hasKey` typeableClassKey)
652 (ptext (sLit "Use deriving( Typeable ) on a data type declaration"))
653 ; real_cls <- tcLookupClass (typeableClassNames !! tyConArity tycon)
654 ; mk_typeable_eqn orig tvs real_cls tycon [] rep_tc [] (Just []) }
656 | otherwise -- standaone deriving
657 = do { checkTc (null tc_args)
658 (ptext (sLit "Derived typeable instance must be of form (Typeable")
659 <> int (tyConArity tycon) <+> ppr tycon <> rparen)
660 ; dfun_name <- new_dfun_name cls tycon
663 DS { ds_loc = loc, ds_orig = orig, ds_name = dfun_name, ds_tvs = []
664 , ds_cls = cls, ds_tys = [mkTyConApp tycon []], ds_tc = rep_tc
665 , ds_theta = mtheta `orElse` [], ds_newtype = False }) }
667 ------------------------------------------------------------------
668 -- Check side conditions that dis-allow derivability for particular classes
669 -- This is *apart* from the newtype-deriving mechanism
671 -- Here we get the representation tycon in case of family instances as it has
672 -- the data constructors - but we need to be careful to fall back to the
673 -- family tycon (with indexes) in error messages.
675 data DerivStatus = CanDerive
677 | DerivableClassError SDoc
679 checkSideConditions :: Bool -> Class -> [TcType] -> TyCon -> DerivStatus
680 checkSideConditions mayDeriveDataTypeable cls cls_tys rep_tc
682 = DerivableClassError ty_args_why -- e.g. deriving( Foo s )
684 = case sideConditions cls of
685 Nothing -> NonDerivableClass
686 Just cond -> case (cond (mayDeriveDataTypeable, rep_tc)) of
688 Just err -> DerivableClassError err
690 ty_args_why = quotes (ppr (mkClassPred cls cls_tys)) <+> ptext (sLit "is not a class")
692 nonStdErr :: Class -> SDoc
693 nonStdErr cls = quotes (ppr cls) <+> ptext (sLit "is not a derivable class")
695 sideConditions :: Class -> Maybe Condition
697 | cls_key == eqClassKey = Just cond_std
698 | cls_key == ordClassKey = Just cond_std
699 | cls_key == showClassKey = Just cond_std
700 | cls_key == readClassKey = Just (cond_std `andCond` cond_noUnliftedArgs)
701 | cls_key == enumClassKey = Just (cond_std `andCond` cond_isEnumeration)
702 | cls_key == ixClassKey = Just (cond_std `andCond` cond_enumOrProduct)
703 | cls_key == boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct)
704 | cls_key == dataClassKey = Just (cond_mayDeriveDataTypeable `andCond` cond_std `andCond` cond_noUnliftedArgs)
705 | getName cls `elem` typeableClassNames = Just (cond_mayDeriveDataTypeable `andCond` cond_typeableOK)
706 | otherwise = Nothing
708 cls_key = getUnique cls
710 type Condition = (Bool, TyCon) -> Maybe SDoc
711 -- Bool is whether or not we are allowed to derive Data and Typeable
712 -- TyCon is the *representation* tycon if the
713 -- data type is an indexed one
716 orCond :: Condition -> Condition -> Condition
719 Nothing -> Nothing -- c1 succeeds
720 Just x -> case c2 tc of -- c1 fails
722 Just y -> Just (x $$ ptext (sLit " and") $$ y)
725 andCond :: Condition -> Condition -> Condition
726 andCond c1 c2 tc = case c1 tc of
727 Nothing -> c2 tc -- c1 succeeds
728 Just x -> Just x -- c1 fails
730 cond_std :: Condition
732 | any (not . isVanillaDataCon) data_cons = Just existential_why
733 | null data_cons = Just no_cons_why
734 | otherwise = Nothing
736 data_cons = tyConDataCons rep_tc
737 no_cons_why = quotes (pprSourceTyCon rep_tc) <+>
738 ptext (sLit "has no data constructors")
739 existential_why = quotes (pprSourceTyCon rep_tc) <+>
740 ptext (sLit "has non-Haskell-98 constructor(s)")
742 cond_enumOrProduct :: Condition
743 cond_enumOrProduct = cond_isEnumeration `orCond`
744 (cond_isProduct `andCond` cond_noUnliftedArgs)
746 cond_noUnliftedArgs :: Condition
747 -- For some classes (eg Eq, Ord) we allow unlifted arg types
748 -- by generating specilaised code. For others (eg Data) we don't.
749 cond_noUnliftedArgs (_, tc)
750 | null bad_cons = Nothing
751 | otherwise = Just why
753 bad_cons = [ con | con <- tyConDataCons tc
754 , any isUnLiftedType (dataConOrigArgTys con) ]
755 why = ptext (sLit "Constructor") <+> quotes (ppr (head bad_cons))
756 <+> ptext (sLit "has arguments of unlifted type")
758 cond_isEnumeration :: Condition
759 cond_isEnumeration (_, rep_tc)
760 | isEnumerationTyCon rep_tc = Nothing
761 | otherwise = Just why
763 why = quotes (pprSourceTyCon rep_tc) <+>
764 ptext (sLit "has non-nullary constructors")
766 cond_isProduct :: Condition
767 cond_isProduct (_, rep_tc)
768 | isProductTyCon rep_tc = Nothing
769 | otherwise = Just why
771 why = quotes (pprSourceTyCon rep_tc) <+>
772 ptext (sLit "has more than one constructor")
774 cond_typeableOK :: Condition
775 -- OK for Typeable class
776 -- Currently: (a) args all of kind *
777 -- (b) 7 or fewer args
778 cond_typeableOK (_, rep_tc)
779 | tyConArity rep_tc > 7 = Just too_many
780 | not (all (isSubArgTypeKind . tyVarKind) (tyConTyVars rep_tc))
782 | isFamInstTyCon rep_tc = Just fam_inst -- no Typable for family insts
783 | otherwise = Nothing
785 too_many = quotes (pprSourceTyCon rep_tc) <+>
786 ptext (sLit "has too many arguments")
787 bad_kind = quotes (pprSourceTyCon rep_tc) <+>
788 ptext (sLit "has arguments of kind other than `*'")
789 fam_inst = quotes (pprSourceTyCon rep_tc) <+>
790 ptext (sLit "is a type family")
792 cond_mayDeriveDataTypeable :: Condition
793 cond_mayDeriveDataTypeable (mayDeriveDataTypeable, _)
794 | mayDeriveDataTypeable = Nothing
795 | otherwise = Just why
797 why = ptext (sLit "You need -XDeriveDataTypeable to derive an instance for this class")
799 std_class_via_iso :: Class -> Bool
800 std_class_via_iso clas -- These standard classes can be derived for a newtype
801 -- using the isomorphism trick *even if no -fglasgow-exts*
802 = classKey clas `elem` [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]
803 -- Not Read/Show because they respect the type
804 -- Not Enum, because newtypes are never in Enum
807 new_dfun_name :: Class -> TyCon -> TcM Name
808 new_dfun_name clas tycon -- Just a simple wrapper
809 = do { loc <- getSrcSpanM -- The location of the instance decl, not of the tycon
810 ; newDFunName clas [mkTyConApp tycon []] loc }
811 -- The type passed to newDFunName is only used to generate
812 -- a suitable string; hence the empty type arg list
815 Note [Superclasses of derived instance]
816 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
817 In general, a derived instance decl needs the superclasses of the derived
818 class too. So if we have
819 data T a = ...deriving( Ord )
820 then the initial context for Ord (T a) should include Eq (T a). Often this is
821 redundant; we'll also generate an Ord constraint for each constructor argument,
822 and that will probably generate enough constraints to make the Eq (T a) constraint
823 be satisfied too. But not always; consider:
829 data T a = MkT (S a) deriving( Ord )
830 instance Num a => Eq (T a)
832 The derived instance for (Ord (T a)) must have a (Num a) constraint!
834 data T a = MkT deriving( Data, Typeable )
835 Here there *is* no argument field, but we must nevertheless generate
836 a context for the Data instances:
837 instance Typable a => Data (T a) where ...
840 %************************************************************************
844 %************************************************************************
847 mkNewTypeEqn :: InstOrigin -> Bool -> Bool -> [Var] -> Class
848 -> [Type] -> TyCon -> [Type] -> TyCon -> [Type]
850 -> TcRn EarlyDerivSpec
851 mkNewTypeEqn orig mayDeriveDataTypeable newtype_deriving tvs
852 cls cls_tys tycon tc_args rep_tycon rep_tc_args mtheta
853 | can_derive_via_isomorphism && (newtype_deriving || std_class_via_iso cls)
854 = do { traceTc (text "newtype deriving:" <+> ppr tycon <+> ppr rep_tys)
855 ; dfun_name <- new_dfun_name cls tycon
857 ; let spec = DS { ds_loc = loc, ds_orig = orig
858 , ds_name = dfun_name, ds_tvs = varSetElems dfun_tvs
859 , ds_cls = cls, ds_tys = inst_tys, ds_tc = rep_tycon
860 , ds_theta = mtheta `orElse` all_preds
861 , ds_newtype = True }
862 ; return (if isJust mtheta then Right spec
866 = case check_conditions of
867 CanDerive -> mk_data_eqn orig tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
868 -- Use the standard H98 method
869 DerivableClassError msg -> bale_out msg -- Error with standard class
870 NonDerivableClass -- Must use newtype deriving
871 | newtype_deriving -> bale_out cant_derive_err -- Too hard, even with newtype deriving
872 | otherwise -> bale_out non_std_err -- Try newtype deriving!
874 check_conditions = checkSideConditions mayDeriveDataTypeable cls cls_tys rep_tycon
875 bale_out msg = failWithTc (derivingThingErr cls cls_tys inst_ty msg)
877 non_std_err = nonStdErr cls $$
878 ptext (sLit "Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension")
880 -- Here is the plan for newtype derivings. We see
881 -- newtype T a1...an = MkT (t ak+1...an) deriving (.., C s1 .. sm, ...)
882 -- where t is a type,
883 -- ak+1...an is a suffix of a1..an, and are all tyars
884 -- ak+1...an do not occur free in t, nor in the s1..sm
885 -- (C s1 ... sm) is a *partial applications* of class C
886 -- with the last parameter missing
887 -- (T a1 .. ak) matches the kind of C's last argument
888 -- (and hence so does t)
889 -- The latter kind-check has been done by deriveTyData already,
890 -- and tc_args are already trimmed
892 -- We generate the instance
893 -- instance forall ({a1..ak} u fvs(s1..sm)).
894 -- C s1 .. sm t => C s1 .. sm (T a1...ak)
895 -- where T a1...ap is the partial application of
896 -- the LHS of the correct kind and p >= k
898 -- NB: the variables below are:
899 -- tc_tvs = [a1, ..., an]
900 -- tyvars_to_keep = [a1, ..., ak]
901 -- rep_ty = t ak .. an
902 -- deriv_tvs = fvs(s1..sm) \ tc_tvs
903 -- tys = [s1, ..., sm]
906 -- Running example: newtype T s a = MkT (ST s a) deriving( Monad )
907 -- We generate the instance
908 -- instance Monad (ST s) => Monad (T s) where
910 nt_eta_arity = length (fst (newTyConEtadRhs rep_tycon))
911 -- For newtype T a b = MkT (S a a b), the TyCon machinery already
912 -- eta-reduces the represenation type, so we know that
914 -- That's convenient here, because we may have to apply
915 -- it to fewer than its original complement of arguments
917 -- Note [Newtype representation]
918 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
919 -- Need newTyConRhs (*not* a recursive representation finder)
920 -- to get the representation type. For example
921 -- newtype B = MkB Int
922 -- newtype A = MkA B deriving( Num )
923 -- We want the Num instance of B, *not* the Num instance of Int,
924 -- when making the Num instance of A!
925 rep_inst_ty = newTyConInstRhs rep_tycon rep_tc_args
926 rep_tys = cls_tys ++ [rep_inst_ty]
927 rep_pred = mkClassPred cls rep_tys
928 -- rep_pred is the representation dictionary, from where
929 -- we are gong to get all the methods for the newtype
933 -- Next we figure out what superclass dictionaries to use
934 -- See Note [Newtype deriving superclasses] above
936 cls_tyvars = classTyVars cls
937 dfun_tvs = tyVarsOfTypes tc_args
938 inst_ty = mkTyConApp tycon tc_args
939 inst_tys = cls_tys ++ [inst_ty]
940 sc_theta = substTheta (zipOpenTvSubst cls_tyvars inst_tys)
943 -- If there are no tyvars, there's no need
944 -- to abstract over the dictionaries we need
945 -- Example: newtype T = MkT Int deriving( C )
946 -- We get the derived instance
949 -- instance C Int => C T
950 all_preds = rep_pred : sc_theta -- NB: rep_pred comes first
952 -------------------------------------------------------------------
953 -- Figuring out whether we can only do this newtype-deriving thing
955 right_arity = length cls_tys + 1 == classArity cls
957 -- Never derive Read,Show,Typeable,Data this way
958 non_iso_class cls = className cls `elem` ([readClassName, showClassName, dataClassName] ++
960 can_derive_via_isomorphism
961 = not (non_iso_class cls)
962 && right_arity -- Well kinded;
963 -- eg not: newtype T ... deriving( ST )
964 -- because ST needs *2* type params
965 && eta_ok -- Eta reduction works
966 && not (isRecursiveTyCon tycon) -- Does not work for recursive tycons:
967 -- newtype A = MkA [A]
969 -- instance Eq [A] => Eq A !!
970 -- Here's a recursive newtype that's actually OK
971 -- newtype S1 = S1 [T1 ()]
972 -- newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad )
973 -- It's currently rejected. Oh well.
974 -- In fact we generate an instance decl that has method of form
975 -- meth @ instTy = meth @ repTy
976 -- (no coerce's). We'd need a coerce if we wanted to handle
977 -- recursive newtypes too
979 -- Check that eta reduction is OK
980 eta_ok = (nt_eta_arity <= length rep_tc_args)
981 -- (a) the newtype can be eta-reduced to match the number
982 -- of type argument actually supplied
983 -- newtype T a b = MkT (S [a] b) deriving( Monad )
984 -- Here the 'b' must be the same in the rep type (S [a] b)
985 -- And the [a] must not mention 'b'. That's all handled
988 && (tyVarsOfTypes cls_tys `subVarSet` dfun_tvs)
989 -- (c) the type class args do not mention any of the dropped type
991 -- newtype T a b = ... deriving( Monad b )
993 cant_derive_err = vcat [ptext (sLit "even with cunning newtype deriving:"),
994 if isRecursiveTyCon tycon then
995 ptext (sLit "the newtype may be recursive")
997 if not right_arity then
998 quotes (ppr (mkClassPred cls cls_tys)) <+> ptext (sLit "does not have arity 1")
1001 ptext (sLit "cannot eta-reduce the representation type enough")
1007 %************************************************************************
1009 \subsection[TcDeriv-fixpoint]{Finding the fixed point of \tr{deriving} equations}
1011 %************************************************************************
1013 A ``solution'' (to one of the equations) is a list of (k,TyVarTy tv)
1014 terms, which is the final correct RHS for the corresponding original
1018 Each (k,TyVarTy tv) in a solution constrains only a type
1022 The (k,TyVarTy tv) pairs in a solution are canonically
1023 ordered by sorting on type varible, tv, (major key) and then class, k,
1028 inferInstanceContexts :: OverlapFlag -> [DerivSpec] -> TcM [DerivSpec]
1030 inferInstanceContexts _ [] = return []
1032 inferInstanceContexts oflag infer_specs
1033 = do { traceTc (text "inferInstanceContexts" <+> vcat (map pprDerivSpec infer_specs))
1034 ; iterate_deriv 1 initial_solutions }
1036 ------------------------------------------------------------------
1037 -- The initial solutions for the equations claim that each
1038 -- instance has an empty context; this solution is certainly
1039 -- in canonical form.
1040 initial_solutions :: [ThetaType]
1041 initial_solutions = [ [] | _ <- infer_specs ]
1043 ------------------------------------------------------------------
1044 -- iterate_deriv calculates the next batch of solutions,
1045 -- compares it with the current one; finishes if they are the
1046 -- same, otherwise recurses with the new solutions.
1047 -- It fails if any iteration fails
1048 iterate_deriv :: Int -> [ThetaType] -> TcM [DerivSpec]
1049 iterate_deriv n current_solns
1050 | n > 20 -- Looks as if we are in an infinite loop
1051 -- This can happen if we have -XUndecidableInstances
1052 -- (See TcSimplify.tcSimplifyDeriv.)
1053 = pprPanic "solveDerivEqns: probable loop"
1054 (vcat (map pprDerivSpec infer_specs) $$ ppr current_solns)
1056 = do { -- Extend the inst info from the explicit instance decls
1057 -- with the current set of solutions, and simplify each RHS
1058 let inst_specs = zipWithEqual "add_solns" (mkInstance2 oflag)
1059 current_solns infer_specs
1060 ; new_solns <- checkNoErrs $
1061 extendLocalInstEnv inst_specs $
1062 mapM gen_soln infer_specs
1064 ; if (current_solns == new_solns) then
1065 return [ spec { ds_theta = soln }
1066 | (spec, soln) <- zip infer_specs current_solns ]
1068 iterate_deriv (n+1) new_solns }
1070 ------------------------------------------------------------------
1071 gen_soln :: DerivSpec -> TcM [PredType]
1072 gen_soln (DS { ds_loc = loc, ds_orig = orig, ds_tvs = tyvars
1073 , ds_cls = clas, ds_tys = inst_tys, ds_theta = deriv_rhs })
1075 addErrCtxt (derivInstCtxt clas inst_tys) $
1076 do { theta <- tcSimplifyDeriv orig tyvars deriv_rhs
1077 -- checkValidInstance tyvars theta clas inst_tys
1078 -- Not necessary; see Note [Exotic derived instance contexts]
1081 -- Check for a bizarre corner case, when the derived instance decl should
1082 -- have form instance C a b => D (T a) where ...
1083 -- Note that 'b' isn't a parameter of T. This gives rise to all sorts
1084 -- of problems; in particular, it's hard to compare solutions for
1085 -- equality when finding the fixpoint. So I just rule it out for now.
1086 ; let tv_set = mkVarSet tyvars
1087 weird_preds = [pred | pred <- theta, not (tyVarsOfPred pred `subVarSet` tv_set)]
1088 ; mapM_ (addErrTc . badDerivedPred) weird_preds
1090 -- Claim: the result instance declaration is guaranteed valid
1091 -- Hence no need to call:
1092 -- checkValidInstance tyvars theta clas inst_tys
1093 ; return (sortLe (<=) theta) } -- Canonicalise before returning the solution
1095 ------------------------------------------------------------------
1096 mkInstance1 :: OverlapFlag -> DerivSpec -> Instance
1097 mkInstance1 overlap_flag spec = mkInstance2 overlap_flag (ds_theta spec) spec
1099 mkInstance2 :: OverlapFlag -> ThetaType -> DerivSpec -> Instance
1100 mkInstance2 overlap_flag theta
1101 (DS { ds_name = dfun_name
1102 , ds_tvs = tyvars, ds_cls = clas, ds_tys = tys })
1103 = mkLocalInstance dfun overlap_flag
1105 dfun = mkDictFunId dfun_name tyvars theta clas tys
1108 extendLocalInstEnv :: [Instance] -> TcM a -> TcM a
1109 -- Add new locally-defined instances; don't bother to check
1110 -- for functional dependency errors -- that'll happen in TcInstDcls
1111 extendLocalInstEnv dfuns thing_inside
1112 = do { env <- getGblEnv
1113 ; let inst_env' = extendInstEnvList (tcg_inst_env env) dfuns
1114 env' = env { tcg_inst_env = inst_env' }
1115 ; setGblEnv env' thing_inside }
1119 %************************************************************************
1121 \subsection[TcDeriv-normal-binds]{Bindings for the various classes}
1123 %************************************************************************
1125 After all the trouble to figure out the required context for the
1126 derived instance declarations, all that's left is to chug along to
1127 produce them. They will then be shoved into @tcInstDecls2@, which
1128 will do all its usual business.
1130 There are lots of possibilities for code to generate. Here are
1131 various general remarks.
1136 We want derived instances of @Eq@ and @Ord@ (both v common) to be
1137 ``you-couldn't-do-better-by-hand'' efficient.
1140 Deriving @Show@---also pretty common--- should also be reasonable good code.
1143 Deriving for the other classes isn't that common or that big a deal.
1150 Deriving @Ord@ is done mostly with the 1.3 @compare@ method.
1153 Deriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.
1156 We {\em normally} generate code only for the non-defaulted methods;
1157 there are some exceptions for @Eq@ and (especially) @Ord@...
1160 Sometimes we use a @_con2tag_<tycon>@ function, which returns a data
1161 constructor's numeric (@Int#@) tag. These are generated by
1162 @gen_tag_n_con_binds@, and the heuristic for deciding if one of
1163 these is around is given by @hasCon2TagFun@.
1165 The examples under the different sections below will make this
1169 Much less often (really just for deriving @Ix@), we use a
1170 @_tag2con_<tycon>@ function. See the examples.
1173 We use the renamer!!! Reason: we're supposed to be
1174 producing @LHsBinds Name@ for the methods, but that means
1175 producing correctly-uniquified code on the fly. This is entirely
1176 possible (the @TcM@ monad has a @UniqueSupply@), but it is painful.
1177 So, instead, we produce @MonoBinds RdrName@ then heave 'em through
1178 the renamer. What a great hack!
1182 -- Generate the InstInfo for the required instance paired with the
1183 -- *representation* tycon for that instance,
1184 -- plus any auxiliary bindings required
1186 -- Representation tycons differ from the tycon in the instance signature in
1187 -- case of instances for indexed families.
1189 genInst :: OverlapFlag -> DerivSpec -> TcM (InstInfo RdrName, DerivAuxBinds)
1192 = return (InstInfo { iSpec = mkInstance1 oflag spec
1193 , iBinds = NewTypeDerived }, [])
1196 = do { let loc = getSrcSpan (ds_name spec)
1197 inst = mkInstance1 oflag spec
1199 rep_tycon = ds_tc spec
1201 -- In case of a family instance, we need to use the representation
1202 -- tycon (after all, it has the data constructors)
1203 ; fix_env <- getFixityEnv
1204 ; let (meth_binds, aux_binds) = genDerivBinds loc fix_env clas rep_tycon
1206 -- Build the InstInfo
1207 ; return (InstInfo { iSpec = inst,
1208 iBinds = VanillaInst meth_binds [] },
1212 genDerivBinds :: SrcSpan -> FixityEnv -> Class -> TyCon -> (LHsBinds RdrName, DerivAuxBinds)
1213 genDerivBinds loc fix_env clas tycon
1214 | className clas `elem` typeableClassNames
1215 = (gen_Typeable_binds loc tycon, [])
1218 = case assocMaybe gen_list (getUnique clas) of
1219 Just gen_fn -> gen_fn loc tycon
1220 Nothing -> pprPanic "genDerivBinds: bad derived class" (ppr clas)
1222 gen_list :: [(Unique, SrcSpan -> TyCon -> (LHsBinds RdrName, DerivAuxBinds))]
1223 gen_list = [(eqClassKey, gen_Eq_binds)
1224 ,(ordClassKey, gen_Ord_binds)
1225 ,(enumClassKey, gen_Enum_binds)
1226 ,(boundedClassKey, gen_Bounded_binds)
1227 ,(ixClassKey, gen_Ix_binds)
1228 ,(showClassKey, gen_Show_binds fix_env)
1229 ,(readClassKey, gen_Read_binds fix_env)
1230 ,(dataClassKey, gen_Data_binds)
1235 %************************************************************************
1237 \subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
1239 %************************************************************************
1242 derivingKindErr :: TyCon -> Class -> [Type] -> Kind -> Message
1243 derivingKindErr tc cls cls_tys cls_kind
1244 = hang (ptext (sLit "Cannot derive well-kinded instance of form")
1245 <+> quotes (pprClassPred cls cls_tys <+> parens (ppr tc <+> ptext (sLit "..."))))
1246 2 (ptext (sLit "Class") <+> quotes (ppr cls)
1247 <+> ptext (sLit "expects an argument of kind") <+> quotes (pprKind cls_kind))
1249 typeFamilyPapErr :: TyCon -> Class -> [Type] -> Type -> Message
1250 typeFamilyPapErr tc cls cls_tys inst_ty
1251 = hang (ptext (sLit "Derived instance") <+> quotes (pprClassPred cls (cls_tys ++ [inst_ty])))
1252 2 (ptext (sLit "requires illegal partial application of data type family") <+> ppr tc)
1254 derivingThingErr :: Class -> [Type] -> Type -> Message -> Message
1255 derivingThingErr clas tys ty why
1256 = sep [hsep [ptext (sLit "Can't make a derived instance of"),
1258 nest 2 (parens why)]
1260 pred = mkClassPred clas (tys ++ [ty])
1262 derivingHiddenErr :: TyCon -> SDoc
1263 derivingHiddenErr tc
1264 = hang (ptext (sLit "The data constructors of") <+> quotes (ppr tc) <+> ptext (sLit "are not all in scope"))
1265 2 (ptext (sLit "so you cannot derive an instance for it"))
1267 standaloneCtxt :: LHsType Name -> SDoc
1268 standaloneCtxt ty = hang (ptext (sLit "In the stand-alone deriving instance for"))
1271 derivInstCtxt :: Class -> [Type] -> Message
1272 derivInstCtxt clas inst_tys
1273 = ptext (sLit "When deriving the instance for") <+> parens (pprClassPred clas inst_tys)
1275 badDerivedPred :: PredType -> Message
1277 = vcat [ptext (sLit "Can't derive instances where the instance context mentions"),
1278 ptext (sLit "type variables that are not data type parameters"),
1279 nest 2 (ptext (sLit "Offending constraint:") <+> ppr pred)]