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