ghc/compiler/typecheck/TcEnv.lhs

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