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