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