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