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