ghc/compiler/typecheck/TcInstDcls.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[TcInstDecls]{Typechecking instance declarations}
   5
   6 \begin{code}
   7 module TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn            ( HsDecl(..), InstDecl(..),
  12                           HsBinds(..), MonoBinds(..),
  13                           HsExpr(..), InPat(..), HsLit(..), Sig(..),
  14                           andMonoBindList
  15                         )
  16 import RnHsSyn          ( RenamedHsBinds, RenamedInstDecl, RenamedHsDecl )
  17 import TcHsSyn          ( TcMonoBinds, mkHsConApp )
  18
  19 import TcBinds          ( tcSpecSigs )
  20 import TcClassDcl       ( tcMethodBind, checkFromThisClass )
  21 import TcMonad
  22 import RnMonad          ( RnNameSupply, FixityEnv )
  23 import Inst             ( Inst, InstOrigin(..),
  24                           newDicts, newClassDicts,
  25                           LIE, emptyLIE, plusLIE, plusLIEs )
  26 import TcDeriv          ( tcDeriving )
  27 import TcEnv            ( ValueEnv, tcExtendGlobalValEnv, tcExtendTyVarEnvForMeths,
  28                           tcAddImportedIdInfo, tcInstId, newDFunName
  29                         )
  30 import TcInstUtil       ( InstInfo(..), classDataCon )
  31 import TcMonoType       ( tcHsSigType )
  32 import TcSimplify       ( tcSimplifyAndCheck )
  33 import TcType           ( TcTyVar, zonkTcSigTyVars )
  34
  35 import Bag              ( emptyBag, unitBag, unionBags, unionManyBags,
  36                           foldBag, Bag
  37                         )
  38 import CmdLineOpts      ( opt_GlasgowExts, opt_AllowUndecidableInstances )
  39 import Class            ( classBigSig, Class )
  40 import Var              ( idName, idType, Id, TyVar )
  41 import Maybes           ( maybeToBool, catMaybes, expectJust )
  42 import MkId             ( mkDictFunId )
  43 import Module           ( Module )
  44 import Name             ( isLocallyDefined, NamedThing(..)      )
  45 import NameSet          ( emptyNameSet )
  46 import PrelInfo         ( eRROR_ID )
  47 import PprType          ( pprConstraint )
  48 import TyCon            ( isSynTyCon, tyConDerivings )
  49 import Type             ( Type, isUnLiftedType, mkTyVarTys,
  50                           splitSigmaTy, isTyVarTy,
  51                           splitTyConApp_maybe, splitDictTy_maybe,
  52                           getClassTys_maybe, splitAlgTyConApp_maybe,
  53                           classesToPreds, classesOfPreds,
  54                           unUsgTy, tyVarsOfTypes
  55                         )
  56 import Subst            ( mkTopTyVarSubst, substClasses )
  57 import VarSet           ( mkVarSet, varSetElems )
  58 import TysWiredIn       ( stringTy, isFFIArgumentTy, isFFIResultTy )
  59 import Unique           ( Unique, cCallableClassKey, cReturnableClassKey, hasKey, Uniquable(..) )
  60 import Outputable
  61 \end{code}
  62
  63 Typechecking instance declarations is done in two passes. The first
  64 pass, made by @tcInstDecls1@, collects information to be used in the
  65 second pass.
  66
  67 This pre-processed info includes the as-yet-unprocessed bindings
  68 inside the instance declaration.  These are type-checked in the second
  69 pass, when the class-instance envs and GVE contain all the info from
  70 all the instance and value decls.  Indeed that's the reason we need
  71 two passes over the instance decls.
  72
  73
  74 Here is the overall algorithm.
  75 Assume that we have an instance declaration
  76
  77     instance c => k (t tvs) where b
  78
  79 \begin{enumerate}
  80 \item
  81 $LIE_c$ is the LIE for the context of class $c$
  82 \item
  83 $betas_bar$ is the free variables in the class method type, excluding the
  84    class variable
  85 \item
  86 $LIE_cop$ is the LIE constraining a particular class method
  87 \item
  88 $tau_cop$ is the tau type of a class method
  89 \item
  90 $LIE_i$ is the LIE for the context of instance $i$
  91 \item
  92 $X$ is the instance constructor tycon
  93 \item
  94 $gammas_bar$ is the set of type variables of the instance
  95 \item
  96 $LIE_iop$ is the LIE for a particular class method instance
  97 \item
  98 $tau_iop$ is the tau type for this instance of a class method
  99 \item
 100 $alpha$ is the class variable
 101 \item
 102 $LIE_cop' = LIE_cop [X gammas_bar / alpha, fresh betas_bar]$
 103 \item
 104 $tau_cop' = tau_cop [X gammas_bar / alpha, fresh betas_bar]$
 105 \end{enumerate}
 106
 107 ToDo: Update the list above with names actually in the code.
 108
 109 \begin{enumerate}
 110 \item
 111 First, make the LIEs for the class and instance contexts, which means
 112 instantiate $thetaC [X inst_tyvars / alpha ]$, yielding LIElistC' and LIEC',
 113 and make LIElistI and LIEI.
 114 \item
 115 Then process each method in turn.
 116 \item
 117 order the instance methods according to the ordering of the class methods
 118 \item
 119 express LIEC' in terms of LIEI, yielding $dbinds_super$ or an error
 120 \item
 121 Create final dictionary function from bindings generated already
 122 \begin{pseudocode}
 123 df = lambda inst_tyvars
 124        lambda LIEI
 125          let Bop1
 126              Bop2
 127              ...
 128              Bopn
 129          and dbinds_super
 130               in <op1,op2,...,opn,sd1,...,sdm>
 131 \end{pseudocode}
 132 Here, Bop1 \ldots Bopn bind the methods op1 \ldots opn,
 133 and $dbinds_super$ bind the superclass dictionaries sd1 \ldots sdm.
 134 \end{enumerate}
 135
 136 \begin{code}
 137 tcInstDecls1 :: ValueEnv                -- Contains IdInfo for dfun ids
 138              -> [RenamedHsDecl]
 139              -> Module                  -- Module for deriving
 140              -> FixityEnv               -- For derivings
 141              -> RnNameSupply            -- For renaming derivings
 142              -> TcM s (Bag InstInfo,
 143                        RenamedHsBinds)
 144
 145 tcInstDecls1 unf_env decls mod fixs rn_name_supply
 146   =     -- Do the ordinary instance declarations
 147     mapNF_Tc (tcInstDecl1 mod unf_env)
 148              [inst_decl | InstD inst_decl <- decls]     `thenNF_Tc` \ inst_info_bags ->
 149     let
 150         decl_inst_info = unionManyBags inst_info_bags
 151     in
 152         -- Handle "derived" instances; note that we only do derivings
 153         -- for things in this module; we ignore deriving decls from
 154         -- interfaces!
 155     tcDeriving mod fixs rn_name_supply decl_inst_info
 156                         `thenTc` \ (deriv_inst_info, deriv_binds) ->
 157
 158     let
 159         full_inst_info = deriv_inst_info `unionBags` decl_inst_info
 160     in
 161     returnTc (full_inst_info, deriv_binds)
 162
 163
 164 tcInstDecl1 :: Module -> ValueEnv -> RenamedInstDecl -> NF_TcM s (Bag InstInfo)
 165
 166 tcInstDecl1 mod unf_env (InstDecl poly_ty binds uprags maybe_dfun_name src_loc)
 167   =     -- Prime error recovery, set source location
 168     recoverNF_Tc (returnNF_Tc emptyBag) $
 169     tcAddSrcLoc src_loc                 $
 170
 171         -- Type-check all the stuff before the "where"
 172     tcHsSigType poly_ty                 `thenTc` \ poly_ty' ->
 173     let
 174         (tyvars, theta, dict_ty) = splitSigmaTy poly_ty'
 175         constr                   = classesOfPreds theta
 176         (clas, inst_tys)         = case splitDictTy_maybe dict_ty of
 177                                      Just ct -> ct
 178                                      Nothing -> pprPanic "tcInstDecl1" (ppr poly_ty)
 179     in
 180
 181     (case maybe_dfun_name of
 182         Nothing ->      -- A source-file instance declaration
 183
 184                 -- Check for respectable instance type, and context
 185                 -- but only do this for non-imported instance decls.
 186                 -- Imported ones should have been checked already, and may indeed
 187                 -- contain something illegal in normal Haskell, notably
 188                 --      instance CCallable [Char]
 189             scrutiniseInstanceHead clas inst_tys                `thenNF_Tc_`
 190             mapNF_Tc scrutiniseInstanceConstraint constr        `thenNF_Tc_`
 191
 192                 -- Make the dfun id and return it
 193             newDFunName mod clas inst_tys src_loc               `thenNF_Tc` \ dfun_name ->
 194             returnNF_Tc (mkDictFunId dfun_name clas tyvars inst_tys constr)
 195
 196         Just dfun_name ->       -- An interface-file instance declaration
 197                 -- Make the dfun id and add info from interface file
 198             let
 199                 dfun_id = mkDictFunId dfun_name clas tyvars inst_tys constr
 200             in
 201             returnNF_Tc (tcAddImportedIdInfo unf_env dfun_id)
 202     )                                           `thenNF_Tc` \ dfun_id ->
 203
 204     returnTc (unitBag (InstInfo clas tyvars inst_tys constr dfun_id binds src_loc uprags))
 205 \end{code}
 206
 207
 208 %************************************************************************
 209 %*                                                                      *
 210 \subsection{Type-checking instance declarations, pass 2}
 211 %*                                                                      *
 212 %************************************************************************
 213
 214 \begin{code}
 215 tcInstDecls2 :: Bag InstInfo
 216              -> NF_TcM s (LIE, TcMonoBinds)
 217
 218 tcInstDecls2 inst_decls
 219   = foldBag combine tcInstDecl2 (returnNF_Tc (emptyLIE, EmptyMonoBinds)) inst_decls
 220   where
 221     combine tc1 tc2 = tc1       `thenNF_Tc` \ (lie1, binds1) ->
 222                       tc2       `thenNF_Tc` \ (lie2, binds2) ->
 223                       returnNF_Tc (lie1 `plusLIE` lie2,
 224                                    binds1 `AndMonoBinds` binds2)
 225 \end{code}
 226
 227
 228 ======= New documentation starts here (Sept 92)  ==============
 229
 230 The main purpose of @tcInstDecl2@ is to return a @HsBinds@ which defines
 231 the dictionary function for this instance declaration.  For example
 232 \begin{verbatim}
 233         instance Foo a => Foo [a] where
 234                 op1 x = ...
 235                 op2 y = ...
 236 \end{verbatim}
 237 might generate something like
 238 \begin{verbatim}
 239         dfun.Foo.List dFoo_a = let op1 x = ...
 240                                    op2 y = ...
 241                                in
 242                                    Dict [op1, op2]
 243 \end{verbatim}
 244
 245 HOWEVER, if the instance decl has no context, then it returns a
 246 bigger @HsBinds@ with declarations for each method.  For example
 247 \begin{verbatim}
 248         instance Foo [a] where
 249                 op1 x = ...
 250                 op2 y = ...
 251 \end{verbatim}
 252 might produce
 253 \begin{verbatim}
 254         dfun.Foo.List a = Dict [Foo.op1.List a, Foo.op2.List a]
 255         const.Foo.op1.List a x = ...
 256         const.Foo.op2.List a y = ...
 257 \end{verbatim}
 258 This group may be mutually recursive, because (for example) there may
 259 be no method supplied for op2 in which case we'll get
 260 \begin{verbatim}
 261         const.Foo.op2.List a = default.Foo.op2 (dfun.Foo.List a)
 262 \end{verbatim}
 263 that is, the default method applied to the dictionary at this type.
 264
 265 What we actually produce in either case is:
 266
 267         AbsBinds [a] [dfun_theta_dicts]
 268                  [(dfun.Foo.List, d)] ++ (maybe) [(const.Foo.op1.List, op1), ...]
 269                  { d = (sd1,sd2, ..., op1, op2, ...)
 270                    op1 = ...
 271                    op2 = ...
 272                  }
 273
 274 The "maybe" says that we only ask AbsBinds to make global constant methods
 275 if the dfun_theta is empty.
 276
 277
 278 For an instance declaration, say,
 279
 280         instance (C1 a, C2 b) => C (T a b) where
 281                 ...
 282
 283 where the {\em immediate} superclasses of C are D1, D2, we build a dictionary
 284 function whose type is
 285
 286         (C1 a, C2 b, D1 (T a b), D2 (T a b)) => C (T a b)
 287
 288 Notice that we pass it the superclass dictionaries at the instance type; this
 289 is the ``Mark Jones optimisation''.  The stuff before the "=>" here
 290 is the @dfun_theta@ below.
 291
 292 First comes the easy case of a non-local instance decl.
 293
 294 \begin{code}
 295 tcInstDecl2 :: InstInfo -> NF_TcM s (LIE, TcMonoBinds)
 296
 297 tcInstDecl2 (InstInfo clas inst_tyvars inst_tys
 298                       inst_decl_theta
 299                       dfun_id monobinds
 300                       locn uprags)
 301   | not (isLocallyDefined dfun_id)
 302   = returnNF_Tc (emptyLIE, EmptyMonoBinds)
 303
 304   | otherwise
 305   =      -- Prime error recovery
 306     recoverNF_Tc (returnNF_Tc (emptyLIE, EmptyMonoBinds))  $
 307     tcAddSrcLoc locn                                       $
 308
 309          -- Check that all the method bindings come from this class
 310     checkFromThisClass clas monobinds                   `thenNF_Tc_`
 311
 312         -- Instantiate the instance decl with tc-style type variables
 313     tcInstId dfun_id            `thenNF_Tc` \ (inst_tyvars', dfun_theta', dict_ty') ->
 314     let
 315         (clas, inst_tys')       = expectJust "tcInstDecl2" (splitDictTy_maybe dict_ty')
 316
 317         origin                  = InstanceDeclOrigin
 318
 319         (class_tyvars, sc_theta, _, op_items) = classBigSig clas
 320
 321         dm_ids = [dm_id | (_, dm_id, _) <- op_items]
 322
 323         -- Instantiate the theta found in the original instance decl
 324         inst_decl_theta' = substClasses (mkTopTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars'))
 325                                         inst_decl_theta
 326
 327          -- Instantiate the super-class context with inst_tys
 328         sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys') sc_theta
 329     in
 330          -- Create dictionary Ids from the specified instance contexts.
 331     newClassDicts origin sc_theta'      `thenNF_Tc` \ (sc_dicts,        sc_dict_ids) ->
 332     newDicts origin dfun_theta'         `thenNF_Tc` \ (dfun_arg_dicts,  dfun_arg_dicts_ids)  ->
 333     newClassDicts origin inst_decl_theta' `thenNF_Tc` \ (inst_decl_dicts, _) ->
 334     newClassDicts origin [(clas,inst_tys')] `thenNF_Tc` \ (this_dict,       [this_dict_id]) ->
 335
 336     tcExtendTyVarEnvForMeths inst_tyvars inst_tyvars' (
 337         tcExtendGlobalValEnv dm_ids (
 338                 -- Default-method Ids may be mentioned in synthesised RHSs
 339
 340         mapAndUnzip3Tc (tcMethodBind clas origin inst_tyvars' inst_tys'
 341                                      (classesToPreds inst_decl_theta')
 342                                      monobinds uprags True)
 343                        op_items
 344     ))                  `thenTc` \ (method_binds_s, insts_needed_s, meth_lies_w_ids) ->
 345
 346         -- Deal with SPECIALISE instance pragmas by making them
 347         -- look like SPECIALISE pragmas for the dfun
 348     let
 349         dfun_prags = [SpecSig (idName dfun_id) ty loc | SpecInstSig ty loc <- uprags]
 350     in
 351     tcExtendGlobalValEnv [dfun_id] (
 352         tcSpecSigs dfun_prags
 353     )                                   `thenTc` \ (prag_binds, prag_lie) ->
 354
 355         -- Check the overloading constraints of the methods and superclasses
 356
 357         -- tcMethodBind has checked that the class_tyvars havn't
 358         -- been unified with each other or another type, but we must
 359         -- still zonk them before passing them to tcSimplifyAndCheck
 360     zonkTcSigTyVars inst_tyvars'        `thenNF_Tc` \ zonked_inst_tyvars ->
 361     let
 362         inst_tyvars_set = mkVarSet zonked_inst_tyvars
 363
 364         (meth_lies, meth_ids) = unzip meth_lies_w_ids
 365
 366                  -- These insts are in scope; quite a few, eh?
 367         avail_insts = this_dict                 `plusLIE`
 368                       dfun_arg_dicts            `plusLIE`
 369                       sc_dicts                  `plusLIE`
 370                       unionManyBags meth_lies
 371
 372         methods_lie = plusLIEs insts_needed_s
 373     in
 374
 375         -- Ditto method bindings
 376     tcAddErrCtxt methodCtxt (
 377       tcSimplifyAndCheck
 378                  (ptext SLIT("instance declaration context"))
 379                  inst_tyvars_set                        -- Local tyvars
 380                  avail_insts
 381                  methods_lie
 382     )                                            `thenTc` \ (const_lie1, lie_binds1) ->
 383
 384         -- Check that we *could* construct the superclass dictionaries,
 385         -- even though we are *actually* going to pass the superclass dicts in;
 386         -- the check ensures that the caller will never have
 387         --a problem building them.
 388     tcAddErrCtxt superClassCtxt (
 389       tcSimplifyAndCheck
 390                  (ptext SLIT("instance declaration context"))
 391                  inst_tyvars_set                -- Local tyvars
 392                  inst_decl_dicts                -- The instance dictionaries available
 393                  sc_dicts                       -- The superclass dicationaries reqd
 394     )                                   `thenTc` \ _ ->
 395                                                 -- Ignore the result; we're only doing
 396                                                 -- this to make sure it can be done.
 397
 398         -- Now do the simplification again, this time to get the
 399         -- bindings; this time we use an enhanced "avails"
 400         -- Ignore errors because they come from the *previous* tcSimplify
 401     discardErrsTc (
 402         tcSimplifyAndCheck
 403                  (ptext SLIT("instance declaration context"))
 404                  inst_tyvars_set
 405                  dfun_arg_dicts         -- NB! Don't include this_dict here, else the sc_dicts
 406                                         -- get bound by just selecting from this_dict!!
 407                  sc_dicts
 408     )                                            `thenTc` \ (const_lie2, lie_binds2) ->
 409
 410
 411         -- Create the result bindings
 412     let
 413         dict_constr   = classDataCon clas
 414         scs_and_meths = sc_dict_ids ++ meth_ids
 415
 416         dict_rhs
 417           | null scs_and_meths
 418           =     -- Blatant special case for CCallable, CReturnable
 419                 -- If the dictionary is empty then we should never
 420                 -- select anything from it, so we make its RHS just
 421                 -- emit an error message.  This in turn means that we don't
 422                 -- mention the constructor, which doesn't exist for CCallable, CReturnable
 423                 -- Hardly beautiful, but only three extra lines.
 424             HsApp (TyApp (HsVar eRROR_ID) [(unUsgTy . idType) this_dict_id])
 425                   (HsLitOut (HsString msg) stringTy)
 426
 427           | otherwise   -- The common case
 428           = mkHsConApp dict_constr inst_tys' (map HsVar (sc_dict_ids ++ meth_ids))
 429                 -- We don't produce a binding for the dict_constr; instead we
 430                 -- rely on the simplifier to unfold this saturated application
 431                 -- We do this rather than generate an HsCon directly, because
 432                 -- it means that the special cases (e.g. dictionary with only one
 433                 -- member) are dealt with by the common MkId.mkDataConWrapId code rather
 434                 -- than needing to be repeated here.
 435
 436           where
 437             msg = _PK_ ("Compiler error: bad dictionary " ++ showSDoc (ppr clas))
 438
 439         dict_bind    = VarMonoBind this_dict_id dict_rhs
 440         method_binds = andMonoBindList method_binds_s
 441
 442         main_bind
 443           = AbsBinds
 444                  zonked_inst_tyvars
 445                  dfun_arg_dicts_ids
 446                  [(inst_tyvars', dfun_id, this_dict_id)]
 447                  emptyNameSet           -- No inlines (yet)
 448                  (lie_binds1    `AndMonoBinds`
 449                   lie_binds2    `AndMonoBinds`
 450                   method_binds  `AndMonoBinds`
 451                   dict_bind)
 452     in
 453     returnTc (const_lie1 `plusLIE` const_lie2 `plusLIE` prag_lie,
 454               main_bind `AndMonoBinds` prag_binds)
 455 \end{code}
 456
 457
 458 %************************************************************************
 459 %*                                                                      *
 460 \subsection{Checking for a decent instance type}
 461 %*                                                                      *
 462 %************************************************************************
 463
 464 @scrutiniseInstanceHead@ checks the type {\em and} its syntactic constraints:
 465 it must normally look like: @instance Foo (Tycon a b c ...) ...@
 466
 467 The exceptions to this syntactic checking: (1)~if the @GlasgowExts@
 468 flag is on, or (2)~the instance is imported (they must have been
 469 compiled elsewhere). In these cases, we let them go through anyway.
 470
 471 We can also have instances for functions: @instance Foo (a -> b) ...@.
 472
 473 \begin{code}
 474 scrutiniseInstanceConstraint (clas, tys)
 475   |  all isTyVarTy tys
 476   || opt_AllowUndecidableInstances = returnNF_Tc ()
 477   | otherwise                      = addErrTc (instConstraintErr clas tys)
 478
 479 scrutiniseInstanceHead clas inst_taus
 480   |     -- CCALL CHECK
 481         -- A user declaration of a CCallable/CReturnable instance
 482         -- must be for a "boxed primitive" type.
 483     (clas `hasKey` cCallableClassKey   && not (ccallable_type   first_inst_tau)) ||
 484     (clas `hasKey` cReturnableClassKey && not (creturnable_type first_inst_tau))
 485   = addErrTc (nonBoxedPrimCCallErr clas first_inst_tau)
 486
 487         -- DERIVING CHECK
 488         -- It is obviously illegal to have an explicit instance
 489         -- for something that we are also planning to `derive'
 490   | maybeToBool alg_tycon_app_maybe && clas `elem` (tyConDerivings alg_tycon)
 491   = addErrTc (derivingWhenInstanceExistsErr clas first_inst_tau)
 492            -- Kind check will have ensured inst_taus is of length 1
 493
 494         -- Allow anything for AllowUndecidableInstances
 495   | opt_AllowUndecidableInstances
 496   = returnNF_Tc ()
 497
 498         -- If GlasgowExts then check at least one isn't a type variable
 499   | opt_GlasgowExts
 500   = if all isTyVarTy inst_taus then
 501         addErrTc (instTypeErr clas inst_taus (text "There must be at least one non-type-variable in the instance head"))
 502     else
 503         returnNF_Tc ()
 504
 505         -- WITH HASKELL 1.4, MUST HAVE C (T a b c)
 506   |  not (length inst_taus == 1 &&
 507           maybeToBool maybe_tycon_app &&        -- Yes, there's a type constuctor
 508           not (isSynTyCon tycon) &&             -- ...but not a synonym
 509           all isTyVarTy arg_tys &&              -- Applied to type variables
 510           length (varSetElems (tyVarsOfTypes arg_tys)) == length arg_tys
 511                  -- This last condition checks that all the type variables are distinct
 512      )
 513   = addErrTc (instTypeErr clas inst_taus
 514                         (text "the instance type must be of form (T a b c)" $$
 515                          text "where T is not a synonym, and a,b,c are distinct type variables")
 516     )
 517
 518   | otherwise
 519   = returnNF_Tc ()
 520
 521   where
 522     (first_inst_tau : _)       = inst_taus
 523
 524         -- Stuff for algebraic or -> type
 525     maybe_tycon_app       = splitTyConApp_maybe first_inst_tau
 526     Just (tycon, arg_tys) = maybe_tycon_app
 527
 528         -- Stuff for an *algebraic* data type
 529     alg_tycon_app_maybe    = splitAlgTyConApp_maybe first_inst_tau
 530                                 -- The "Alg" part looks through synonyms
 531     Just (alg_tycon, _, _) = alg_tycon_app_maybe
 532
 533 ccallable_type   ty = isFFIArgumentTy False {- Not safe call -} ty
 534 creturnable_type ty = isFFIResultTy ty
 535 \end{code}
 536
 537 \begin{code}
 538 instConstraintErr clas tys
 539   = hang (ptext SLIT("Illegal constraint") <+>
 540           quotes (pprConstraint clas tys) <+>
 541           ptext SLIT("in instance context"))
 542          4 (ptext SLIT("(Instance contexts must constrain only type variables)"))
 543
 544 instTypeErr clas tys msg
 545   = sep [ptext SLIT("Illegal instance declaration for") <+> quotes (pprConstraint clas tys),
 546          nest 4 (parens msg)
 547     ]
 548
 549 derivingWhenInstanceExistsErr clas tycon
 550   = hang (hsep [ptext SLIT("Deriving class"),
 551                        quotes (ppr clas),
 552                        ptext SLIT("type"), quotes (ppr tycon)])
 553          4 (ptext SLIT("when an explicit instance exists"))
 554
 555 nonBoxedPrimCCallErr clas inst_ty
 556   = hang (ptext SLIT("Unacceptable instance type for ccall-ish class"))
 557          4 (hsep [ ptext SLIT("class"), ppr clas, ptext SLIT("type"),
 558                         ppr inst_ty])
 559
 560 methodCtxt     = ptext SLIT("When checking the methods of an instance declaration")
 561 superClassCtxt = ptext SLIT("When checking the superclasses of an instance declaration")
 562 \end{code}