ghc/compiler/typecheck/TcEnv.lhs

   1 \begin{code}
   2 module TcEnv(
   3         TyThing(..), TcTyThing(..), TcId,
   4
   5         -- Instance environment, and InstInfo type
   6         InstInfo(..), pprInstInfo, pprInstInfoDetails,
   7         simpleInstInfoTy, simpleInstInfoTyCon,
   8         InstBindings(..),
   9
  10         -- Global environment
  11         tcExtendGlobalEnv,
  12         tcExtendGlobalValEnv,
  13         tcLookupLocatedGlobal,  tcLookupGlobal,
  14         tcLookupGlobalId, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
  15         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
  16         tcLookupLocatedClass,
  17
  18         -- Local environment
  19         tcExtendKindEnv,
  20         tcExtendTyVarEnv, tcExtendTyVarEnv2,
  21         tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,
  22         tcLookup, tcLookupLocated, tcLookupLocalIds,
  23         tcLookupId, tcLookupTyVar,
  24         lclEnvElts, getInLocalScope, findGlobals,
  25         wrongThingErr, pprBinders,
  26
  27         tcExtendRecEnv,         -- For knot-tying
  28
  29         -- Rules
  30         tcExtendRules,
  31
  32         -- Global type variables
  33         tcGetGlobalTyVars,
  34
  35         -- Template Haskell stuff
  36         checkWellStaged, spliceOK, bracketOK, tcMetaTy, thLevel,
  37         topIdLvl,
  38
  39         -- New Ids
  40         newLocalName, newDFunName
  41   ) where
  42
  43 #include "HsVersions.h"
  44
  45 import HsSyn            ( LRuleDecl, LHsBinds, LSig, pprLHsBinds )
  46 import TcIface          ( tcImportDecl )
  47 import TcRnTypes        ( pprTcTyThingCategory )
  48 import TcRnMonad
  49 import TcMType          ( zonkTcType, zonkTcTyVarsAndFV )
  50 import TcType           ( Type, TcKind, TcTyVar, TcTyVarSet, TcType,
  51                           tyVarsOfType, tyVarsOfTypes, tcSplitDFunTy, mkGenTyConApp,
  52                           getDFunTyKey, tcTyConAppTyCon, tcGetTyVar, mkTyVarTy,
  53                           tidyOpenType
  54                         )
  55 import qualified Type   ( getTyVar_maybe )
  56 import Id               ( idName, isLocalId )
  57 import Var              ( TyVar, Id, idType, tyVarName )
  58 import VarSet
  59 import VarEnv
  60 import RdrName          ( extendLocalRdrEnv )
  61 import DataCon          ( DataCon )
  62 import TyCon            ( TyCon )
  63 import Class            ( Class )
  64 import Name             ( Name, NamedThing(..), getSrcLoc, mkInternalName, nameIsLocalOrFrom )
  65 import NameEnv
  66 import OccName          ( mkDFunOcc, occNameString )
  67 import HscTypes         ( DFunId, extendTypeEnvList, lookupType,
  68                           TyThing(..), tyThingId, tyThingDataCon,
  69                           ExternalPackageState(..) )
  70
  71 import SrcLoc           ( SrcLoc, Located(..) )
  72 import Outputable
  73 \end{code}
  74
  75
  76 %************************************************************************
  77 %*                                                                      *
  78 %*                      tcLookupGlobal                                  *
  79 %*                                                                      *
  80 %************************************************************************
  81
  82 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
  83 unless you know that the SrcSpan in the monad is already set to the
  84 span of the Name.
  85
  86 \begin{code}
  87 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
  88 -- c.f. IfaceEnvEnv.tcIfaceGlobal
  89 tcLookupLocatedGlobal name
  90   = addLocM tcLookupGlobal name
  91
  92 tcLookupGlobal :: Name -> TcM TyThing
  93 tcLookupGlobal name
  94   = do  { env <- getGblEnv
  95         ; if nameIsLocalOrFrom (tcg_mod env) name
  96
  97           then  -- It's defined in this module
  98               case lookupNameEnv (tcg_type_env env) name of
  99                 Just thing -> return thing
 100                 Nothing    -> notFound  name    -- Panic!
 101
 102           else do               -- It's imported
 103         { (eps,hpt) <- getEpsAndHpt
 104         ; case lookupType hpt (eps_PTE eps) name of
 105             Just thing -> return thing
 106             Nothing    -> tcImportDecl name
 107     }}
 108 \end{code}
 109
 110 \begin{code}
 111 tcLookupGlobalId :: Name -> TcM Id
 112 -- Never used for Haskell-source DataCons, hence no ADataCon case
 113 tcLookupGlobalId name
 114   = tcLookupGlobal name         `thenM` \ thing ->
 115     return (tyThingId thing)
 116
 117 tcLookupDataCon :: Name -> TcM DataCon
 118 tcLookupDataCon con_name
 119   = tcLookupGlobal con_name     `thenM` \ thing ->
 120     return (tyThingDataCon thing)
 121
 122 tcLookupClass :: Name -> TcM Class
 123 tcLookupClass name
 124   = tcLookupGlobal name         `thenM` \ thing ->
 125     case thing of
 126         AClass cls -> return cls
 127         other      -> wrongThingErr "class" (AGlobal thing) name
 128
 129 tcLookupTyCon :: Name -> TcM TyCon
 130 tcLookupTyCon name
 131   = tcLookupGlobal name         `thenM` \ thing ->
 132     case thing of
 133         ATyCon tc -> return tc
 134         other     -> wrongThingErr "type constructor" (AGlobal thing) name
 135
 136 tcLookupLocatedGlobalId :: Located Name -> TcM Id
 137 tcLookupLocatedGlobalId = addLocM tcLookupId
 138
 139 tcLookupLocatedClass :: Located Name -> TcM Class
 140 tcLookupLocatedClass = addLocM tcLookupClass
 141
 142 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
 143 tcLookupLocatedTyCon = addLocM tcLookupTyCon
 144 \end{code}
 145
 146 %************************************************************************
 147 %*                                                                      *
 148                 Extending the global environment
 149 %*                                                                      *
 150 %************************************************************************
 151
 152
 153 \begin{code}
 154 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 155   -- Given a mixture of Ids, TyCons, Classes, all from the
 156   -- module being compiled, extend the global environment
 157 tcExtendGlobalEnv things thing_inside
 158    = do { env <- getGblEnv
 159         ; let ge'  = extendTypeEnvList (tcg_type_env env) things
 160         ; setGblEnv (env {tcg_type_env = ge'}) thing_inside }
 161
 162 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 163   -- Same deal as tcExtendGlobalEnv, but for Ids
 164 tcExtendGlobalValEnv ids thing_inside
 165   = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
 166 \end{code}
 167
 168 \begin{code}
 169 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
 170 -- Extend the global environments for the type/class knot tying game
 171 tcExtendRecEnv gbl_stuff thing_inside
 172  = updGblEnv upd thing_inside
 173  where
 174    upd env = env { tcg_type_env = extend (tcg_type_env env) }
 175    extend env = extendNameEnvList env gbl_stuff
 176 \end{code}
 177
 178
 179 %************************************************************************
 180 %*                                                                      *
 181 \subsection{The local environment}
 182 %*                                                                      *
 183 %************************************************************************
 184
 185 \begin{code}
 186 tcLookupLocated :: Located Name -> TcM TcTyThing
 187 tcLookupLocated = addLocM tcLookup
 188
 189 tcLookup :: Name -> TcM TcTyThing
 190 tcLookup name
 191   = getLclEnv           `thenM` \ local_env ->
 192     case lookupNameEnv (tcl_env local_env) name of
 193         Just thing -> returnM thing
 194         Nothing    -> tcLookupGlobal name `thenM` \ thing ->
 195                       returnM (AGlobal thing)
 196
 197 tcLookupTyVar :: Name -> TcM TcTyVar
 198 tcLookupTyVar name
 199   = tcLookup name       `thenM` \ thing ->
 200     case thing of
 201         ATyVar _ ty -> returnM (tcGetTyVar "tcLookupTyVar" ty)
 202         other       -> pprPanic "tcLookupTyVar" (ppr name)
 203
 204 tcLookupId :: Name -> TcM Id
 205 -- Used when we aren't interested in the binding level
 206 -- Never a DataCon. (Why does that matter? see TcExpr.tcId)
 207 tcLookupId name
 208   = tcLookup name       `thenM` \ thing ->
 209     case thing of
 210         ATcId tc_id _     -> returnM tc_id
 211         AGlobal (AnId id) -> returnM id
 212         other             -> pprPanic "tcLookupId" (ppr name)
 213
 214 tcLookupLocalIds :: [Name] -> TcM [TcId]
 215 -- We expect the variables to all be bound, and all at
 216 -- the same level as the lookup.  Only used in one place...
 217 tcLookupLocalIds ns
 218   = getLclEnv           `thenM` \ env ->
 219     returnM (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
 220   where
 221     lookup lenv lvl name
 222         = case lookupNameEnv lenv name of
 223                 Just (ATcId id lvl1) -> ASSERT( lvl == lvl1 ) id
 224                 other                -> pprPanic "tcLookupLocalIds" (ppr name)
 225
 226 lclEnvElts :: TcLclEnv -> [TcTyThing]
 227 lclEnvElts env = nameEnvElts (tcl_env env)
 228
 229 getInLocalScope :: TcM (Name -> Bool)
 230   -- Ids only
 231 getInLocalScope = getLclEnv     `thenM` \ env ->
 232                   let
 233                         lcl_env = tcl_env env
 234                   in
 235                   return (`elemNameEnv` lcl_env)
 236 \end{code}
 237
 238 \begin{code}
 239 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
 240 tcExtendKindEnv things thing_inside
 241   = updLclEnv upd thing_inside
 242   where
 243     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
 244     extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
 245
 246 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 247 tcExtendTyVarEnv tvs thing_inside
 248   = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
 249
 250 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
 251 tcExtendTyVarEnv2 binds thing_inside
 252   = getLclEnv      `thenM` \ env@(TcLclEnv {tcl_env = le,
 253                                             tcl_tyvars = gtvs,
 254                                             tcl_rdr = rdr_env}) ->
 255     let
 256         rdr_env'   = extendLocalRdrEnv rdr_env (map fst binds)
 257         new_tv_set = tyVarsOfTypes (map snd binds)
 258         le'        = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
 259     in
 260         -- It's important to add the in-scope tyvars to the global tyvar set
 261         -- as well.  Consider
 262         --      f (_::r) = let g y = y::r in ...
 263         -- Here, g mustn't be generalised.  This is also important during
 264         -- class and instance decls, when we mustn't generalise the class tyvars
 265         -- when typechecking the methods.
 266     tc_extend_gtvs gtvs new_tv_set              `thenM` \ gtvs' ->
 267     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
 268 \end{code}
 269
 270
 271 \begin{code}
 272 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
 273 -- Invariant: the TcIds are fully zonked. Reasons:
 274 --      (a) The kinds of the forall'd type variables are defaulted
 275 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
 276 --      (b) There are no via-Indirect occurrences of the bound variables
 277 --          in the types, because instantiation does not look through such things
 278 --      (c) The call to tyVarsOfTypes is ok without looking through refs
 279 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
 280
 281 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
 282 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
 283
 284 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 285 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
 286 tcExtendIdEnv2 names_w_ids thing_inside
 287   = getLclEnv           `thenM` \ env ->
 288     let
 289         extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
 290         th_lvl              = thLevel    (tcl_th_ctxt   env)
 291         extra_env           = [(name, ATcId id th_lvl) | (name,id) <- names_w_ids]
 292         le'                 = extendNameEnvList (tcl_env env) extra_env
 293         rdr_env'            = extendLocalRdrEnv (tcl_rdr env) (map fst names_w_ids)
 294     in
 295     tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars `thenM` \ gtvs' ->
 296     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
 297 \end{code}
 298
 299
 300 \begin{code}
 301 -----------------------
 302 -- findGlobals looks at the value environment and finds values
 303 -- whose types mention the offending type variable.  It has to be
 304 -- careful to zonk the Id's type first, so it has to be in the monad.
 305 -- We must be careful to pass it a zonked type variable, too.
 306
 307 findGlobals :: TcTyVarSet
 308             -> TidyEnv
 309             -> TcM (TidyEnv, [SDoc])
 310
 311 findGlobals tvs tidy_env
 312   = getLclEnv           `thenM` \ lcl_env ->
 313     go tidy_env [] (lclEnvElts lcl_env)
 314   where
 315     go tidy_env acc [] = returnM (tidy_env, acc)
 316     go tidy_env acc (thing : things)
 317       = find_thing ignore_it tidy_env thing     `thenM` \ (tidy_env1, maybe_doc) ->
 318         case maybe_doc of
 319           Just d  -> go tidy_env1 (d:acc) things
 320           Nothing -> go tidy_env1 acc     things
 321
 322     ignore_it ty = not (tvs `intersectsVarSet` tyVarsOfType ty)
 323
 324 -----------------------
 325 find_thing ignore_it tidy_env (ATcId id _)
 326   = zonkTcType  (idType id)     `thenM` \ id_ty ->
 327     if ignore_it id_ty then
 328         returnM (tidy_env, Nothing)
 329     else let
 330         (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
 331         msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
 332                    nest 2 (parens (ptext SLIT("bound at") <+>
 333                                    ppr (getSrcLoc id)))]
 334     in
 335     returnM (tidy_env', Just msg)
 336
 337 find_thing ignore_it tidy_env (ATyVar tv ty)
 338   = zonkTcType ty               `thenM` \ tv_ty ->
 339     if ignore_it tv_ty then
 340         returnM (tidy_env, Nothing)
 341     else let
 342         -- The name tv is scoped, so we don't need to tidy it
 343         (tidy_env1, tidy_ty) = tidyOpenType  tidy_env tv_ty
 344         msg = sep [ptext SLIT("Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
 345
 346         eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
 347                    getOccName tv == getOccName tv' = empty
 348                  | otherwise = equals <+> ppr tidy_ty
 349                 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
 350         bound_at = parens $ ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
 351     in
 352     returnM (tidy_env1, Just msg)
 353 \end{code}
 354
 355
 356 %************************************************************************
 357 %*                                                                      *
 358 \subsection{The global tyvars}
 359 %*                                                                      *
 360 %************************************************************************
 361
 362 \begin{code}
 363 tc_extend_gtvs gtvs extra_global_tvs
 364   = readMutVar gtvs             `thenM` \ global_tvs ->
 365     newMutVar (global_tvs `unionVarSet` extra_global_tvs)
 366 \end{code}
 367
 368 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 369 To improve subsequent calls to the same function it writes the zonked set back into
 370 the environment.
 371
 372 \begin{code}
 373 tcGetGlobalTyVars :: TcM TcTyVarSet
 374 tcGetGlobalTyVars
 375   = getLclEnv                                   `thenM` \ (TcLclEnv {tcl_tyvars = gtv_var}) ->
 376     readMutVar gtv_var                          `thenM` \ gbl_tvs ->
 377     zonkTcTyVarsAndFV (varSetElems gbl_tvs)     `thenM` \ gbl_tvs' ->
 378     writeMutVar gtv_var gbl_tvs'                `thenM_`
 379     returnM gbl_tvs'
 380 \end{code}
 381
 382
 383 %************************************************************************
 384 %*                                                                      *
 385 \subsection{Rules}
 386 %*                                                                      *
 387 %************************************************************************
 388
 389 \begin{code}
 390 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
 391         -- Just pop the new rules into the EPS and envt resp
 392         -- All the rules come from an interface file, not soruce
 393         -- Nevertheless, some may be for this module, if we read
 394         -- its interface instead of its source code
 395 tcExtendRules lcl_rules thing_inside
 396  = do { env <- getGblEnv
 397       ; let
 398           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
 399       ; setGblEnv env' thing_inside }
 400 \end{code}
 401
 402
 403 %************************************************************************
 404 %*                                                                      *
 405                 Meta level
 406 %*                                                                      *
 407 %************************************************************************
 408
 409 \begin{code}
 410 instance Outputable ThStage where
 411    ppr Comp          = text "Comp"
 412    ppr (Brack l _ _) = text "Brack" <+> int l
 413    ppr (Splice l)    = text "Splice" <+> int l
 414
 415
 416 thLevel :: ThStage -> ThLevel
 417 thLevel Comp          = topLevel
 418 thLevel (Splice l)    = l
 419 thLevel (Brack l _ _) = l
 420
 421
 422 checkWellStaged :: SDoc         -- What the stage check is for
 423                 -> ThLevel      -- Binding level
 424                 -> ThStage      -- Use stage
 425                 -> TcM ()       -- Fail if badly staged, adding an error
 426 checkWellStaged pp_thing bind_lvl use_stage
 427   | bind_lvl <= use_lvl         -- OK!
 428   = returnM ()
 429
 430   | bind_lvl == topLevel        -- GHC restriction on top level splices
 431   = failWithTc $
 432     sep [ptext SLIT("GHC stage restriction:") <+>  pp_thing,
 433          nest 2 (ptext SLIT("is used in a top-level splice, and must be imported, not defined locally"))]
 434
 435   | otherwise                   -- Badly staged
 436   = failWithTc $
 437     ptext SLIT("Stage error:") <+> pp_thing <+>
 438         hsep   [ptext SLIT("is bound at stage") <+> ppr bind_lvl,
 439                 ptext SLIT("but used at stage") <+> ppr use_lvl]
 440   where
 441     use_lvl = thLevel use_stage
 442
 443
 444 topIdLvl :: Id -> ThLevel
 445 -- Globals may either be imported, or may be from an earlier "chunk"
 446 -- (separated by declaration splices) of this module.  The former
 447 --  *can* be used inside a top-level splice, but the latter cannot.
 448 -- Hence we give the former impLevel, but the latter topLevel
 449 -- E.g. this is bad:
 450 --      x = [| foo |]
 451 --      $( f x )
 452 -- By the time we are prcessing the $(f x), the binding for "x"
 453 -- will be in the global env, not the local one.
 454 topIdLvl id | isLocalId id = topLevel
 455             | otherwise    = impLevel
 456
 457 -- Indicates the legal transitions on bracket( [| |] ).
 458 bracketOK :: ThStage -> Maybe ThLevel
 459 bracketOK (Brack _ _ _) = Nothing       -- Bracket illegal inside a bracket
 460 bracketOK stage         = Just (thLevel stage + 1)
 461
 462 -- Indicates the legal transitions on splice($).
 463 spliceOK :: ThStage -> Maybe ThLevel
 464 spliceOK (Splice _) = Nothing   -- Splice illegal inside splice
 465 spliceOK stage      = Just (thLevel stage - 1)
 466
 467 tcMetaTy :: Name -> TcM Type
 468 -- Given the name of a Template Haskell data type,
 469 -- return the type
 470 -- E.g. given the name "Expr" return the type "Expr"
 471 tcMetaTy tc_name
 472   = tcLookupTyCon tc_name       `thenM` \ t ->
 473     returnM (mkGenTyConApp t [])
 474         -- Use mkGenTyConApp because it might be a synonym
 475 \end{code}
 476
 477
 478 %************************************************************************
 479 %*                                                                      *
 480 \subsection{Making new Ids}
 481 %*                                                                      *
 482 %************************************************************************
 483
 484 Constructing new Ids
 485
 486 \begin{code}
 487 newLocalName :: Name -> TcM Name
 488 newLocalName name       -- Make a clone
 489   = newUnique           `thenM` \ uniq ->
 490     returnM (mkInternalName uniq (getOccName name) (getSrcLoc name))
 491 \end{code}
 492
 493 Make a name for the dict fun for an instance decl.  It's a *local*
 494 name for the moment.  The CoreTidy pass will externalise it.  Even in
 495 --make and ghci stuff, we rebuild the instance environment each time,
 496 so the dfun id is internal to begin with, and external when compiling
 497 other modules
 498
 499 \begin{code}
 500 newDFunName :: Class -> [Type] -> SrcLoc -> TcM Name
 501 newDFunName clas (ty:_) loc
 502   = do  { uniq <- newUnique
 503         ; return (mkInternalName uniq (mkDFunOcc dfun_string) loc) }
 504   where
 505         -- Any string that is somewhat unique will do
 506     dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
 507
 508 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 509 \end{code}
 510
 511
 512 %************************************************************************
 513 %*                                                                      *
 514 \subsection{The InstInfo type}
 515 %*                                                                      *
 516 %************************************************************************
 517
 518 The InstInfo type summarises the information in an instance declaration
 519
 520     instance c => k (t tvs) where b
 521
 522 It is used just for *local* instance decls (not ones from interface files).
 523 But local instance decls includes
 524         - derived ones
 525         - generic ones
 526 as well as explicit user written ones.
 527
 528 \begin{code}
 529 data InstInfo
 530   = InstInfo {
 531       iDFunId :: DFunId,                -- The dfun id.  Its forall'd type variables
 532       iBinds  :: InstBindings           -- scope over the stuff in InstBindings!
 533     }
 534
 535 data InstBindings
 536   = VanillaInst                 -- The normal case
 537         (LHsBinds Name)         -- Bindings
 538         [LSig Name]             -- User pragmas recorded for generating
 539                                 -- specialised instances
 540
 541   | NewTypeDerived              -- Used for deriving instances of newtypes, where the
 542         [Type]                  -- witness dictionary is identical to the argument
 543                                 -- dictionary.  Hence no bindings, no pragmas
 544         -- The [Type] are the representation types
 545         -- See notes in TcDeriv
 546
 547 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
 548
 549 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
 550   where
 551     details (VanillaInst b _)  = pprLHsBinds b
 552     details (NewTypeDerived _) = text "Derived from the representation type"
 553
 554 simpleInstInfoTy :: InstInfo -> Type
 555 simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
 556                           (_, _, _, [ty]) -> ty
 557
 558 simpleInstInfoTyCon :: InstInfo -> TyCon
 559   -- Gets the type constructor for a simple instance declaration,
 560   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 561 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 562 \end{code}
 563
 564
 565 %************************************************************************
 566 %*                                                                      *
 567 \subsection{Errors}
 568 %*                                                                      *
 569 %************************************************************************
 570
 571 \begin{code}
 572 pprBinders :: [Name] -> SDoc
 573 -- Used in error messages
 574 -- Use quotes for a single one; they look a bit "busy" for several
 575 pprBinders [bndr] = quotes (ppr bndr)
 576 pprBinders bndrs  = pprWithCommas ppr bndrs
 577
 578 notFound name
 579   = failWithTc (ptext SLIT("GHC internal error:") <+> quotes (ppr name) <+>
 580                 ptext SLIT("is not in scope"))
 581
 582 wrongThingErr expected thing name
 583   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
 584                 ptext SLIT("used as a") <+> text expected)
 585 \end{code}