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