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
  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           ( ModuleName )
  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              -> ModuleName                      -- module name for deriving
 140              -> FixityEnv
 141              -> RnNameSupply                    -- for renaming derivings
 142              -> TcM s (Bag InstInfo,
 143                        RenamedHsBinds)
 144
 145 tcInstDecls1 unf_env decls mod_name fixs rn_name_supply
 146   =     -- Do the ordinary instance declarations
 147     mapNF_Tc (tcInstDecl1 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_name 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 :: ValueEnv -> RenamedInstDecl -> NF_TcM s (Bag InstInfo)
 165
 166 tcInstDecl1 unf_env (InstDecl poly_ty binds uprags 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         -- Check for respectable instance type, and context
 182         -- but only do this for non-imported instance decls.
 183         -- Imported ones should have been checked already, and may indeed
 184         -- contain something illegal in normal Haskell, notably
 185         --      instance CCallable [Char]
 186     (if isLocallyDefined dfun_name then
 187         scrutiniseInstanceHead clas inst_tys    `thenNF_Tc_`
 188         mapNF_Tc scrutiniseInstanceConstraint constr
 189      else
 190         returnNF_Tc []
 191      )                                          `thenNF_Tc_`
 192
 193         -- Make the dfun id
 194     let
 195         dfun_id = mkDictFunId dfun_name clas tyvars inst_tys constr
 196
 197         -- Add info from interface file
 198         final_dfun_id = tcAddImportedIdInfo unf_env dfun_id
 199     in
 200     returnTc (unitBag (InstInfo clas tyvars inst_tys constr
 201                                 final_dfun_id
 202                                 binds src_loc uprags))
 203 \end{code}
 204
 205
 206 %************************************************************************
 207 %*                                                                      *
 208 \subsection{Type-checking instance declarations, pass 2}
 209 %*                                                                      *
 210 %************************************************************************
 211
 212 \begin{code}
 213 tcInstDecls2 :: Bag InstInfo
 214              -> NF_TcM s (LIE, TcMonoBinds)
 215
 216 tcInstDecls2 inst_decls
 217   = foldBag combine tcInstDecl2 (returnNF_Tc (emptyLIE, EmptyMonoBinds)) inst_decls
 218   where
 219     combine tc1 tc2 = tc1       `thenNF_Tc` \ (lie1, binds1) ->
 220                       tc2       `thenNF_Tc` \ (lie2, binds2) ->
 221                       returnNF_Tc (lie1 `plusLIE` lie2,
 222                                    binds1 `AndMonoBinds` binds2)
 223 \end{code}
 224
 225
 226 ======= New documentation starts here (Sept 92)  ==============
 227
 228 The main purpose of @tcInstDecl2@ is to return a @HsBinds@ which defines
 229 the dictionary function for this instance declaration.  For example
 230 \begin{verbatim}
 231         instance Foo a => Foo [a] where
 232                 op1 x = ...
 233                 op2 y = ...
 234 \end{verbatim}
 235 might generate something like
 236 \begin{verbatim}
 237         dfun.Foo.List dFoo_a = let op1 x = ...
 238                                    op2 y = ...
 239                                in
 240                                    Dict [op1, op2]
 241 \end{verbatim}
 242
 243 HOWEVER, if the instance decl has no context, then it returns a
 244 bigger @HsBinds@ with declarations for each method.  For example
 245 \begin{verbatim}
 246         instance Foo [a] where
 247                 op1 x = ...
 248                 op2 y = ...
 249 \end{verbatim}
 250 might produce
 251 \begin{verbatim}
 252         dfun.Foo.List a = Dict [Foo.op1.List a, Foo.op2.List a]
 253         const.Foo.op1.List a x = ...
 254         const.Foo.op2.List a y = ...
 255 \end{verbatim}
 256 This group may be mutually recursive, because (for example) there may
 257 be no method supplied for op2 in which case we'll get
 258 \begin{verbatim}
 259         const.Foo.op2.List a = default.Foo.op2 (dfun.Foo.List a)
 260 \end{verbatim}
 261 that is, the default method applied to the dictionary at this type.
 262
 263 What we actually produce in either case is:
 264
 265         AbsBinds [a] [dfun_theta_dicts]
 266                  [(dfun.Foo.List, d)] ++ (maybe) [(const.Foo.op1.List, op1), ...]
 267                  { d = (sd1,sd2, ..., op1, op2, ...)
 268                    op1 = ...
 269                    op2 = ...
 270                  }
 271
 272 The "maybe" says that we only ask AbsBinds to make global constant methods
 273 if the dfun_theta is empty.
 274
 275
 276 For an instance declaration, say,
 277
 278         instance (C1 a, C2 b) => C (T a b) where
 279                 ...
 280
 281 where the {\em immediate} superclasses of C are D1, D2, we build a dictionary
 282 function whose type is
 283
 284         (C1 a, C2 b, D1 (T a b), D2 (T a b)) => C (T a b)
 285
 286 Notice that we pass it the superclass dictionaries at the instance type; this
 287 is the ``Mark Jones optimisation''.  The stuff before the "=>" here
 288 is the @dfun_theta@ below.
 289
 290 First comes the easy case of a non-local instance decl.
 291
 292 \begin{code}
 293 tcInstDecl2 :: InstInfo -> NF_TcM s (LIE, TcMonoBinds)
 294
 295 tcInstDecl2 (InstInfo clas inst_tyvars inst_tys
 296                       inst_decl_theta
 297                       dfun_id monobinds
 298                       locn uprags)
 299   | not (isLocallyDefined dfun_id)
 300   = returnNF_Tc (emptyLIE, EmptyMonoBinds)
 301
 302 {-
 303   -- I deleted this "optimisation" because when importing these
 304   -- instance decls the renamer would look for the dfun bindings and they weren't there.
 305   -- This would be fixable, but it seems simpler just to produce a tiny void binding instead,
 306   -- even though it's never used.
 307
 308         -- This case deals with CCallable etc, which don't need any bindings
 309   | isNoDictClass clas
 310   = returnNF_Tc (emptyLIE, EmptyBinds)
 311 -}
 312
 313   | otherwise
 314   =      -- Prime error recovery
 315     recoverNF_Tc (returnNF_Tc (emptyLIE, EmptyMonoBinds))  $
 316     tcAddSrcLoc locn                                       $
 317
 318         -- Instantiate the instance decl with tc-style type variables
 319     tcInstId dfun_id            `thenNF_Tc` \ (inst_tyvars', dfun_theta', dict_ty') ->
 320     let
 321         (clas, inst_tys')       = expectJust "tcInstDecl2" (splitDictTy_maybe dict_ty')
 322
 323         origin                  = InstanceDeclOrigin
 324
 325         (class_tyvars, sc_theta, _, op_items) = classBigSig clas
 326
 327         dm_ids = [dm_id | (_, dm_id, _) <- op_items]
 328
 329         -- Instantiate the theta found in the original instance decl
 330         inst_decl_theta' = substClasses (mkTopTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars'))
 331                                         inst_decl_theta
 332
 333          -- Instantiate the super-class context with inst_tys
 334         sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys') sc_theta
 335     in
 336          -- Create dictionary Ids from the specified instance contexts.
 337     newClassDicts origin sc_theta'      `thenNF_Tc` \ (sc_dicts,        sc_dict_ids) ->
 338     newDicts origin dfun_theta'         `thenNF_Tc` \ (dfun_arg_dicts,  dfun_arg_dicts_ids)  ->
 339     newClassDicts origin inst_decl_theta' `thenNF_Tc` \ (inst_decl_dicts, _) ->
 340     newClassDicts origin [(clas,inst_tys')] `thenNF_Tc` \ (this_dict,       [this_dict_id]) ->
 341
 342          -- Check that all the method bindings come from this class
 343     checkFromThisClass clas op_items monobinds          `thenNF_Tc_`
 344
 345     tcExtendTyVarEnvForMeths inst_tyvars inst_tyvars' (
 346         tcExtendGlobalValEnv dm_ids (
 347                 -- Default-method Ids may be mentioned in synthesised RHSs
 348
 349         mapAndUnzip3Tc (tcMethodBind clas origin inst_tyvars' inst_tys'
 350                                      (classesToPreds inst_decl_theta')
 351                                      monobinds uprags True)
 352                        op_items
 353     ))                  `thenTc` \ (method_binds_s, insts_needed_s, meth_lies_w_ids) ->
 354
 355         -- Deal with SPECIALISE instance pragmas by making them
 356         -- look like SPECIALISE pragmas for the dfun
 357     let
 358         dfun_prags = [SpecSig (idName dfun_id) ty loc | SpecInstSig ty loc <- uprags]
 359     in
 360     tcExtendGlobalValEnv [dfun_id] (
 361         tcSpecSigs dfun_prags
 362     )                                   `thenTc` \ (prag_binds, prag_lie) ->
 363
 364         -- Check the overloading constraints of the methods and superclasses
 365
 366         -- tcMethodBind has checked that the class_tyvars havn't
 367         -- been unified with each other or another type, but we must
 368         -- still zonk them before passing them to tcSimplifyAndCheck
 369     zonkTcSigTyVars inst_tyvars'        `thenNF_Tc` \ zonked_inst_tyvars ->
 370     let
 371         inst_tyvars_set = mkVarSet zonked_inst_tyvars
 372
 373         (meth_lies, meth_ids) = unzip meth_lies_w_ids
 374
 375                  -- These insts are in scope; quite a few, eh?
 376         avail_insts = this_dict                 `plusLIE`
 377                       dfun_arg_dicts            `plusLIE`
 378                       sc_dicts                  `plusLIE`
 379                       unionManyBags meth_lies
 380
 381         methods_lie = plusLIEs insts_needed_s
 382     in
 383
 384         -- Ditto method bindings
 385     tcAddErrCtxt methodCtxt (
 386       tcSimplifyAndCheck
 387                  (ptext SLIT("instance declaration context"))
 388                  inst_tyvars_set                        -- Local tyvars
 389                  avail_insts
 390                  methods_lie
 391     )                                            `thenTc` \ (const_lie1, lie_binds1) ->
 392
 393         -- Check that we *could* construct the superclass dictionaries,
 394         -- even though we are *actually* going to pass the superclass dicts in;
 395         -- the check ensures that the caller will never have
 396         --a problem building them.
 397     tcAddErrCtxt superClassCtxt (
 398       tcSimplifyAndCheck
 399                  (ptext SLIT("instance declaration context"))
 400                  inst_tyvars_set                -- Local tyvars
 401                  inst_decl_dicts                -- The instance dictionaries available
 402                  sc_dicts                       -- The superclass dicationaries reqd
 403     )                                   `thenTc` \ _ ->
 404                                                 -- Ignore the result; we're only doing
 405                                                 -- this to make sure it can be done.
 406
 407         -- Now do the simplification again, this time to get the
 408         -- bindings; this time we use an enhanced "avails"
 409         -- Ignore errors because they come from the *previous* tcSimplify
 410     discardErrsTc (
 411         tcSimplifyAndCheck
 412                  (ptext SLIT("instance declaration context"))
 413                  inst_tyvars_set
 414                  dfun_arg_dicts         -- NB! Don't include this_dict here, else the sc_dicts
 415                                         -- get bound by just selecting from this_dict!!
 416                  sc_dicts
 417     )                                            `thenTc` \ (const_lie2, lie_binds2) ->
 418
 419
 420         -- Create the result bindings
 421     let
 422         dict_constr   = classDataCon clas
 423         scs_and_meths = sc_dict_ids ++ meth_ids
 424
 425         dict_rhs
 426           | null scs_and_meths
 427           =     -- Blatant special case for CCallable, CReturnable
 428                 -- If the dictionary is empty then we should never
 429                 -- select anything from it, so we make its RHS just
 430                 -- emit an error message.  This in turn means that we don't
 431                 -- mention the constructor, which doesn't exist for CCallable, CReturnable
 432                 -- Hardly beautiful, but only three extra lines.
 433             HsApp (TyApp (HsVar eRROR_ID) [(unUsgTy . idType) this_dict_id])
 434                   (HsLitOut (HsString msg) stringTy)
 435
 436           | otherwise   -- The common case
 437           = mkHsConApp dict_constr inst_tys' (map HsVar (sc_dict_ids ++ meth_ids))
 438                 -- We don't produce a binding for the dict_constr; instead we
 439                 -- rely on the simplifier to unfold this saturated application
 440                 -- We do this rather than generate an HsCon directly, because
 441                 -- it means that the special cases (e.g. dictionary with only one
 442                 -- member) are dealt with by the common MkId.mkDataConWrapId code rather
 443                 -- than needing to be repeated here.
 444
 445           where
 446             msg = _PK_ ("Compiler error: bad dictionary " ++ showSDoc (ppr clas))
 447
 448         dict_bind    = VarMonoBind this_dict_id dict_rhs
 449         method_binds = andMonoBindList method_binds_s
 450
 451         main_bind
 452           = AbsBinds
 453                  zonked_inst_tyvars
 454                  dfun_arg_dicts_ids
 455                  [(inst_tyvars', dfun_id, this_dict_id)]
 456                  emptyNameSet           -- No inlines (yet)
 457                  (lie_binds1    `AndMonoBinds`
 458                   lie_binds2    `AndMonoBinds`
 459                   method_binds  `AndMonoBinds`
 460                   dict_bind)
 461     in
 462     returnTc (const_lie1 `plusLIE` const_lie2 `plusLIE` prag_lie,
 463               main_bind `AndMonoBinds` prag_binds)
 464 \end{code}
 465
 466
 467 %************************************************************************
 468 %*                                                                      *
 469 \subsection{Checking for a decent instance type}
 470 %*                                                                      *
 471 %************************************************************************
 472
 473 @scrutiniseInstanceHead@ checks the type {\em and} its syntactic constraints:
 474 it must normally look like: @instance Foo (Tycon a b c ...) ...@
 475
 476 The exceptions to this syntactic checking: (1)~if the @GlasgowExts@
 477 flag is on, or (2)~the instance is imported (they must have been
 478 compiled elsewhere). In these cases, we let them go through anyway.
 479
 480 We can also have instances for functions: @instance Foo (a -> b) ...@.
 481
 482 \begin{code}
 483 scrutiniseInstanceConstraint (clas, tys)
 484   |  all isTyVarTy tys
 485   || opt_AllowUndecidableInstances = returnNF_Tc ()
 486   | otherwise                      = addErrTc (instConstraintErr clas tys)
 487
 488 scrutiniseInstanceHead clas inst_taus
 489   |     -- CCALL CHECK
 490         -- A user declaration of a CCallable/CReturnable instance
 491         -- must be for a "boxed primitive" type.
 492     (clas `hasKey` cCallableClassKey   && not (ccallable_type   first_inst_tau)) ||
 493     (clas `hasKey` cReturnableClassKey && not (creturnable_type first_inst_tau))
 494   = addErrTc (nonBoxedPrimCCallErr clas first_inst_tau)
 495
 496         -- DERIVING CHECK
 497         -- It is obviously illegal to have an explicit instance
 498         -- for something that we are also planning to `derive'
 499   | maybeToBool alg_tycon_app_maybe && clas `elem` (tyConDerivings alg_tycon)
 500   = addErrTc (derivingWhenInstanceExistsErr clas first_inst_tau)
 501            -- Kind check will have ensured inst_taus is of length 1
 502
 503         -- Allow anything for AllowUndecidableInstances
 504   | opt_AllowUndecidableInstances
 505   = returnNF_Tc ()
 506
 507         -- If GlasgowExts then check at least one isn't a type variable
 508   | opt_GlasgowExts
 509   = if all isTyVarTy inst_taus then
 510         addErrTc (instTypeErr clas inst_taus (text "There must be at least one non-type-variable in the instance head"))
 511     else
 512         returnNF_Tc ()
 513
 514         -- WITH HASKELL 1.4, MUST HAVE C (T a b c)
 515   |  not (length inst_taus == 1 &&
 516           maybeToBool maybe_tycon_app &&        -- Yes, there's a type constuctor
 517           not (isSynTyCon tycon) &&             -- ...but not a synonym
 518           all isTyVarTy arg_tys &&              -- Applied to type variables
 519           length (varSetElems (tyVarsOfTypes arg_tys)) == length arg_tys
 520                  -- This last condition checks that all the type variables are distinct
 521      )
 522   = addErrTc (instTypeErr clas inst_taus
 523                         (text "the instance type must be of form (T a b c)" $$
 524                          text "where T is not a synonym, and a,b,c are distinct type variables")
 525     )
 526
 527   | otherwise
 528   = returnNF_Tc ()
 529
 530   where
 531     (first_inst_tau : _)       = inst_taus
 532
 533         -- Stuff for algebraic or -> type
 534     maybe_tycon_app       = splitTyConApp_maybe first_inst_tau
 535     Just (tycon, arg_tys) = maybe_tycon_app
 536
 537         -- Stuff for an *algebraic* data type
 538     alg_tycon_app_maybe    = splitAlgTyConApp_maybe first_inst_tau
 539                                 -- The "Alg" part looks through synonyms
 540     Just (alg_tycon, _, _) = alg_tycon_app_maybe
 541
 542 ccallable_type   ty = isFFIArgumentTy False {- Not safe call -} ty
 543 creturnable_type ty = isFFIResultTy ty
 544 \end{code}
 545
 546 \begin{code}
 547 instConstraintErr clas tys
 548   = hang (ptext SLIT("Illegal constraint") <+>
 549           quotes (pprConstraint clas tys) <+>
 550           ptext SLIT("in instance context"))
 551          4 (ptext SLIT("(Instance contexts must constrain only type variables)"))
 552
 553 instTypeErr clas tys msg
 554   = sep [ptext SLIT("Illegal instance declaration for") <+> quotes (pprConstraint clas tys),
 555          nest 4 (parens msg)
 556     ]
 557
 558 derivingWhenInstanceExistsErr clas tycon
 559   = hang (hsep [ptext SLIT("Deriving class"),
 560                        quotes (ppr clas),
 561                        ptext SLIT("type"), quotes (ppr tycon)])
 562          4 (ptext SLIT("when an explicit instance exists"))
 563
 564 nonBoxedPrimCCallErr clas inst_ty
 565   = hang (ptext SLIT("Unacceptable instance type for ccall-ish class"))
 566          4 (hsep [ ptext SLIT("class"), ppr clas, ptext SLIT("type"),
 567                         ppr inst_ty])
 568
 569 methodCtxt     = ptext SLIT("When checking the methods of an instance declaration")
 570 superClassCtxt = ptext SLIT("When checking the superclasses of an instance declaration")
 571 \end{code}