ghc/compiler/typecheck/TcEnv.lhs

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