compiler/typecheck/TcEnv.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 %
   4
   5 \begin{code}
   6 module TcEnv(
   7         TyThing(..), TcTyThing(..), TcId,
   8
   9         -- Instance environment, and InstInfo type
  10         InstInfo(..), iDFunId, pprInstInfo, pprInstInfoDetails,
  11         simpleInstInfoClsTy, simpleInstInfoTy, simpleInstInfoTyCon,
  12         InstBindings(..),
  13
  14         -- Global environment
  15         tcExtendGlobalEnv, setGlobalTypeEnv,
  16         tcExtendGlobalValEnv,
  17         tcLookupLocatedGlobal,  tcLookupGlobal,
  18         tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
  19         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
  20         tcLookupLocatedClass, tcLookupFamInst,
  21
  22         -- Local environment
  23         tcExtendKindEnv, tcExtendKindEnvTvs,
  24         tcExtendTyVarEnv, tcExtendTyVarEnv2,
  25         tcExtendGhciEnv,
  26         tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,
  27         tcLookup, tcLookupLocated, tcLookupLocalIds,
  28         tcLookupId, tcLookupTyVar, getScopedTyVarBinds,
  29         lclEnvElts, getInLocalScope, findGlobals,
  30         wrongThingErr, pprBinders,
  31
  32         tcExtendRecEnv,         -- For knot-tying
  33
  34         -- Rules
  35         tcExtendRules,
  36
  37         -- Global type variables
  38         tcGetGlobalTyVars,
  39
  40         -- Template Haskell stuff
  41         checkWellStaged, spliceOK, bracketOK, tcMetaTy, thLevel,
  42         topIdLvl, thTopLevelId, thRnBrack, isBrackStage,
  43
  44         -- New Ids
  45         newLocalName, newDFunName, newFamInstTyConName,
  46         mkStableIdFromString, mkStableIdFromName
  47   ) where
  48
  49 #include "HsVersions.h"
  50
  51 import HsSyn
  52 import TcIface
  53 import IfaceEnv
  54 import TcRnMonad
  55 import TcMType
  56 import TcType
  57 -- import TcSuspension
  58 import qualified Type
  59 import Id
  60 import Coercion
  61 import Var
  62 import VarSet
  63 import VarEnv
  64 import RdrName
  65 import InstEnv
  66 import FamInstEnv
  67 import DataCon
  68 import TyCon
  69 import TypeRep
  70 import Class
  71 import Name
  72 import NameEnv
  73 import HscTypes
  74 import SrcLoc
  75 import Outputable
  76 import Unique
  77 import FastString
  78 \end{code}
  79
  80
  81 %************************************************************************
  82 %*                                                                      *
  83 %*                      tcLookupGlobal                                  *
  84 %*                                                                      *
  85 %************************************************************************
  86
  87 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
  88 unless you know that the SrcSpan in the monad is already set to the
  89 span of the Name.
  90
  91 \begin{code}
  92 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
  93 -- c.f. IfaceEnvEnv.tcIfaceGlobal
  94 tcLookupLocatedGlobal name
  95   = addLocM tcLookupGlobal name
  96
  97 tcLookupGlobal :: Name -> TcM TyThing
  98 -- The Name is almost always an ExternalName, but not always
  99 -- In GHCi, we may make command-line bindings (ghci> let x = True)
 100 -- that bind a GlobalId, but with an InternalName
 101 tcLookupGlobal name
 102   = do  { env <- getGblEnv
 103
 104                 -- Try local envt
 105         ; case lookupNameEnv (tcg_type_env env) name of {
 106                 Just thing -> return thing ;
 107                 Nothing    -> do
 108
 109                 -- Try global envt
 110         { hsc_env <- getTopEnv
 111         ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
 112         ; case mb_thing of  {
 113             Just thing -> return thing ;
 114             Nothing    -> do
 115
 116                 -- Should it have been in the local envt?
 117         { case nameModule_maybe name of
 118                 Nothing -> notFound name env -- Internal names can happen in GHCi
 119
 120                 Just mod | mod == tcg_mod env   -- Names from this module
 121                          -> notFound name env -- should be in tcg_type_env
 122                          | otherwise
 123                          -> tcImportDecl name   -- Go find it in an interface
 124         }}}}}
 125
 126 tcLookupField :: Name -> TcM Id         -- Returns the selector Id
 127 tcLookupField name
 128   = tcLookupId name     -- Note [Record field lookup]
 129
 130 {- Note [Record field lookup]
 131    ~~~~~~~~~~~~~~~~~~~~~~~~~~
 132 You might think we should have tcLookupGlobal here, since record fields
 133 are always top level.  But consider
 134         f = e { f = True }
 135 Then the renamer (which does not keep track of what is a record selector
 136 and what is not) will rename the definition thus
 137         f_7 = e { f_7 = True }
 138 Now the type checker will find f_7 in the *local* type environment, not
 139 the global (imported) one. It's wrong, of course, but we want to report a tidy
 140 error, not in TcEnv.notFound.  -}
 141
 142 tcLookupDataCon :: Name -> TcM DataCon
 143 tcLookupDataCon name = do
 144     thing <- tcLookupGlobal name
 145     case thing of
 146         ADataCon con -> return con
 147         _            -> wrongThingErr "data constructor" (AGlobal thing) name
 148
 149 tcLookupClass :: Name -> TcM Class
 150 tcLookupClass name = do
 151     thing <- tcLookupGlobal name
 152     case thing of
 153         AClass cls -> return cls
 154         _          -> wrongThingErr "class" (AGlobal thing) name
 155
 156 tcLookupTyCon :: Name -> TcM TyCon
 157 tcLookupTyCon name = do
 158     thing <- tcLookupGlobal name
 159     case thing of
 160         ATyCon tc -> return tc
 161         _         -> wrongThingErr "type constructor" (AGlobal thing) name
 162
 163 tcLookupLocatedGlobalId :: Located Name -> TcM Id
 164 tcLookupLocatedGlobalId = addLocM tcLookupId
 165
 166 tcLookupLocatedClass :: Located Name -> TcM Class
 167 tcLookupLocatedClass = addLocM tcLookupClass
 168
 169 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
 170 tcLookupLocatedTyCon = addLocM tcLookupTyCon
 171
 172 -- Look up the instance tycon of a family instance.
 173 --
 174 -- The match must be unique - ie, match exactly one instance - but the
 175 -- type arguments used for matching may be more specific than those of
 176 -- the family instance declaration.
 177 --
 178 -- Return the instance tycon and its type instance.  For example, if we have
 179 --
 180 --  tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
 181 --
 182 -- then we have a coercion (ie, type instance of family instance coercion)
 183 --
 184 --  :Co:R42T Int :: T [Int] ~ :R42T Int
 185 --
 186 -- which implies that :R42T was declared as 'data instance T [a]'.
 187 --
 188 tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
 189 tcLookupFamInst tycon tys
 190   | not (isOpenTyCon tycon)
 191   = return Nothing
 192   | otherwise
 193   = do { env <- getGblEnv
 194        ; eps <- getEps
 195        ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
 196        ; case lookupFamInstEnv instEnv tycon tys of
 197            [(fam_inst, rep_tys)] -> return $ Just (famInstTyCon fam_inst,
 198                                                    rep_tys)
 199            _                     -> return Nothing
 200        }
 201 \end{code}
 202
 203 \begin{code}
 204 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
 205     lookupThing = tcLookupGlobal
 206 \end{code}
 207
 208 %************************************************************************
 209 %*                                                                      *
 210                 Extending the global environment
 211 %*                                                                      *
 212 %************************************************************************
 213
 214
 215 \begin{code}
 216 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
 217 -- Use this to update the global type env
 218 -- It updates both  * the normal tcg_type_env field
 219 --                  * the tcg_type_env_var field seen by interface files
 220 setGlobalTypeEnv tcg_env new_type_env
 221   = do  {     -- Sync the type-envt variable seen by interface files
 222            writeMutVar (tcg_type_env_var tcg_env) new_type_env
 223          ; return (tcg_env { tcg_type_env = new_type_env }) }
 224
 225 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 226   -- Given a mixture of Ids, TyCons, Classes, all from the
 227   -- module being compiled, extend the global environment
 228 tcExtendGlobalEnv things thing_inside
 229    = do { tcg_env <- getGblEnv
 230         ; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things
 231         ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 232         ; setGblEnv tcg_env' thing_inside }
 233
 234 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 235   -- Same deal as tcExtendGlobalEnv, but for Ids
 236 tcExtendGlobalValEnv ids thing_inside
 237   = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
 238
 239 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
 240 -- Extend the global environments for the type/class knot tying game
 241 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
 242 tcExtendRecEnv gbl_stuff thing_inside
 243  = do  { tcg_env <- getGblEnv
 244        ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
 245        ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 246        ; setGblEnv tcg_env' thing_inside }
 247 \end{code}
 248
 249
 250 %************************************************************************
 251 %*                                                                      *
 252 \subsection{The local environment}
 253 %*                                                                      *
 254 %************************************************************************
 255
 256 \begin{code}
 257 tcLookupLocated :: Located Name -> TcM TcTyThing
 258 tcLookupLocated = addLocM tcLookup
 259
 260 tcLookup :: Name -> TcM TcTyThing
 261 tcLookup name = do
 262     local_env <- getLclEnv
 263     case lookupNameEnv (tcl_env local_env) name of
 264         Just thing -> return thing
 265         Nothing    -> AGlobal <$> tcLookupGlobal name
 266
 267 tcLookupTyVar :: Name -> TcM TcTyVar
 268 tcLookupTyVar name = do
 269     thing <- tcLookup name
 270     case thing of
 271         ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
 272         _           -> pprPanic "tcLookupTyVar" (ppr name)
 273
 274 tcLookupId :: Name -> TcM Id
 275 -- Used when we aren't interested in the binding level, nor refinement.
 276 -- The "no refinement" part means that we return the un-refined Id regardless
 277 --
 278 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
 279 tcLookupId name = do
 280     thing <- tcLookup name
 281     case thing of
 282         ATcId { tct_id = id} -> return id
 283         AGlobal (AnId id)    -> return id
 284         _                    -> pprPanic "tcLookupId" (ppr name)
 285
 286 tcLookupLocalIds :: [Name] -> TcM [TcId]
 287 -- We expect the variables to all be bound, and all at
 288 -- the same level as the lookup.  Only used in one place...
 289 tcLookupLocalIds ns = do
 290     env <- getLclEnv
 291     return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
 292   where
 293     lookup lenv lvl name
 294         = case lookupNameEnv lenv name of
 295                 Just (ATcId { tct_id = id, tct_level = lvl1 })
 296                         -> ASSERT( lvl == lvl1 ) id
 297                 _ -> pprPanic "tcLookupLocalIds" (ppr name)
 298
 299 lclEnvElts :: TcLclEnv -> [TcTyThing]
 300 lclEnvElts env = nameEnvElts (tcl_env env)
 301
 302 getInLocalScope :: TcM (Name -> Bool)
 303   -- Ids only
 304 getInLocalScope = do
 305     env <- getLclEnv
 306     let lcl_env = tcl_env env
 307     return (`elemNameEnv` lcl_env)
 308 \end{code}
 309
 310 \begin{code}
 311 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
 312 tcExtendKindEnv things thing_inside
 313   = updLclEnv upd thing_inside
 314   where
 315     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
 316     extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
 317
 318 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> TcM r -> TcM r
 319 tcExtendKindEnvTvs bndrs thing_inside
 320   = updLclEnv upd thing_inside
 321   where
 322     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
 323     extend env  = extendNameEnvList env pairs
 324     pairs       = [(n, AThing k) | L _ (KindedTyVar n k) <- bndrs]
 325
 326 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 327 tcExtendTyVarEnv tvs thing_inside
 328   = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
 329
 330 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
 331 tcExtendTyVarEnv2 binds thing_inside = do
 332     env@(TcLclEnv {tcl_env = le,
 333                    tcl_tyvars = gtvs,
 334                    tcl_rdr = rdr_env}) <- getLclEnv
 335     let
 336         rdr_env'   = extendLocalRdrEnv rdr_env (map fst binds)
 337         new_tv_set = tcTyVarsOfTypes (map snd binds)
 338         le'        = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
 339
 340         -- It's important to add the in-scope tyvars to the global tyvar set
 341         -- as well.  Consider
 342         --      f (_::r) = let g y = y::r in ...
 343         -- Here, g mustn't be generalised.  This is also important during
 344         -- class and instance decls, when we mustn't generalise the class tyvars
 345         -- when typechecking the methods.
 346     gtvs' <- tc_extend_gtvs gtvs new_tv_set
 347     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
 348
 349 getScopedTyVarBinds :: TcM [(Name, TcType)]
 350 getScopedTyVarBinds
 351   = do  { lcl_env <- getLclEnv
 352         ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
 353 \end{code}
 354
 355
 356 \begin{code}
 357 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
 358 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
 359
 360 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
 361 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
 362
 363 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 364 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
 365 tcExtendIdEnv2 names_w_ids thing_inside
 366   = do  { env <- getLclEnv
 367         ; tc_extend_local_id_env env (thLevel (tcl_th_ctxt env)) names_w_ids thing_inside }
 368
 369 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
 370 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
 371 -- Note especially that we bind them at TH level 'impLevel'.  That's because it's
 372 -- OK to use a variable bound earlier in the interaction in a splice, becuase
 373 -- GHCi has already compiled it to bytecode
 374 tcExtendGhciEnv ids thing_inside
 375   = do  { env <- getLclEnv
 376         ; tc_extend_local_id_env env impLevel [(idName id, id) | id <- ids] thing_inside }
 377
 378 tc_extend_local_id_env          -- This is the guy who does the work
 379         :: TcLclEnv
 380         -> ThLevel
 381         -> [(Name,TcId)]
 382         -> TcM a -> TcM a
 383 -- Invariant: the TcIds are fully zonked. Reasons:
 384 --      (a) The kinds of the forall'd type variables are defaulted
 385 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
 386 --      (b) There are no via-Indirect occurrences of the bound variables
 387 --          in the types, because instantiation does not look through such things
 388 --      (c) The call to tyVarsOfTypes is ok without looking through refs
 389
 390 tc_extend_local_id_env env th_lvl names_w_ids thing_inside
 391   = do  { traceTc (text "env2")
 392         ; traceTc (text "env3" <+> ppr extra_env)
 393         ; gtvs' <- tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars
 394         ; let env' = env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}
 395         ; setLclEnv env' thing_inside }
 396   where
 397     extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
 398     extra_env       = [ (name, ATcId { tct_id = id,
 399                                        tct_level = th_lvl,
 400                                        tct_type = id_ty,
 401                                        tct_co = case isRefineableTy id_ty of
 402                                                   (True,_) -> Unrefineable
 403                                                   (_,True) -> Rigid idHsWrapper
 404                                                   _        -> Wobbly})
 405                       | (name,id) <- names_w_ids, let id_ty = idType id]
 406     le'             = extendNameEnvList (tcl_env env) extra_env
 407     rdr_env'        = extendLocalRdrEnv (tcl_rdr env) [name | (name,_) <- names_w_ids]
 408 \end{code}
 409
 410
 411 \begin{code}
 412 -----------------------
 413 -- findGlobals looks at the value environment and finds values
 414 -- whose types mention the offending type variable.  It has to be
 415 -- careful to zonk the Id's type first, so it has to be in the monad.
 416 -- We must be careful to pass it a zonked type variable, too.
 417
 418 findGlobals :: TcTyVarSet
 419             -> TidyEnv
 420             -> TcM (TidyEnv, [SDoc])
 421
 422 findGlobals tvs tidy_env = do
 423     lcl_env <- getLclEnv
 424     go tidy_env [] (lclEnvElts lcl_env)
 425   where
 426     go tidy_env acc [] = return (tidy_env, acc)
 427     go tidy_env acc (thing : things) = do
 428         (tidy_env1, maybe_doc) <- find_thing ignore_it tidy_env thing
 429         case maybe_doc of
 430           Just d  -> go tidy_env1 (d:acc) things
 431           Nothing -> go tidy_env1 acc     things
 432
 433     ignore_it ty = tvs `disjointVarSet` tyVarsOfType ty
 434
 435 -----------------------
 436 find_thing :: (TcType -> Bool) -> TidyEnv -> TcTyThing
 437            -> TcM (TidyEnv, Maybe SDoc)
 438 find_thing ignore_it tidy_env (ATcId { tct_id = id }) = do
 439     id_ty <- zonkTcType  (idType id)
 440     if ignore_it id_ty then
 441         return (tidy_env, Nothing)
 442      else let
 443         (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
 444         msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
 445                    nest 2 (parens (ptext (sLit "bound at") <+>
 446                                    ppr (getSrcLoc id)))]
 447      in
 448       return (tidy_env', Just msg)
 449
 450 find_thing ignore_it tidy_env (ATyVar tv ty) = do
 451     tv_ty <- zonkTcType ty
 452     if ignore_it tv_ty then
 453         return (tidy_env, Nothing)
 454      else let
 455         -- The name tv is scoped, so we don't need to tidy it
 456         (tidy_env1, tidy_ty) = tidyOpenType  tidy_env tv_ty
 457         msg = sep [ptext (sLit "Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
 458
 459         eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
 460                    getOccName tv == getOccName tv' = empty
 461                  | otherwise = equals <+> ppr tidy_ty
 462                 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
 463         bound_at = parens $ ptext (sLit "bound at:") <+> ppr (getSrcLoc tv)
 464      in
 465        return (tidy_env1, Just msg)
 466
 467 find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
 468 \end{code}
 469
 470 %************************************************************************
 471 %*                                                                      *
 472 \subsection{The global tyvars}
 473 %*                                                                      *
 474 %************************************************************************
 475
 476 \begin{code}
 477 tc_extend_gtvs :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
 478 tc_extend_gtvs gtvs extra_global_tvs = do
 479     global_tvs <- readMutVar gtvs
 480     newMutVar (global_tvs `unionVarSet` extra_global_tvs)
 481 \end{code}
 482
 483 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 484 To improve subsequent calls to the same function it writes the zonked set back into
 485 the environment.
 486
 487 \begin{code}
 488 tcGetGlobalTyVars :: TcM TcTyVarSet
 489 tcGetGlobalTyVars = do
 490     (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv
 491     gbl_tvs  <- readMutVar gtv_var
 492     gbl_tvs' <- zonkTcTyVarsAndFV (varSetElems gbl_tvs)
 493     writeMutVar gtv_var gbl_tvs'
 494     return gbl_tvs'
 495 \end{code}
 496
 497
 498 %************************************************************************
 499 %*                                                                      *
 500 \subsection{Rules}
 501 %*                                                                      *
 502 %************************************************************************
 503
 504 \begin{code}
 505 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
 506         -- Just pop the new rules into the EPS and envt resp
 507         -- All the rules come from an interface file, not soruce
 508         -- Nevertheless, some may be for this module, if we read
 509         -- its interface instead of its source code
 510 tcExtendRules lcl_rules thing_inside
 511  = do { env <- getGblEnv
 512       ; let
 513           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
 514       ; setGblEnv env' thing_inside }
 515 \end{code}
 516
 517
 518 %************************************************************************
 519 %*                                                                      *
 520                 Meta level
 521 %*                                                                      *
 522 %************************************************************************
 523
 524 \begin{code}
 525 instance Outputable ThStage where
 526    ppr (Comp l)      = text "Comp" <+> int l
 527    ppr (Brack l _ _) = text "Brack" <+> int l
 528    ppr (Splice l)    = text "Splice" <+> int l
 529
 530
 531 thLevel :: ThStage -> ThLevel
 532 thLevel (Comp l)      = l
 533 thLevel (Splice l)    = l
 534 thLevel (Brack l _ _) = l
 535
 536
 537 checkWellStaged :: SDoc         -- What the stage check is for
 538                 -> ThLevel      -- Binding level (increases inside brackets)
 539                 -> ThStage      -- Use stage
 540                 -> TcM ()       -- Fail if badly staged, adding an error
 541 checkWellStaged pp_thing bind_lvl use_stage
 542   | use_lvl >= bind_lvl         -- OK! Used later than bound
 543   = return ()                   -- E.g.  \x -> [| $(f x) |]
 544
 545   | bind_lvl == topLevel        -- GHC restriction on top level splices
 546   = failWithTc $
 547     sep [ptext (sLit "GHC stage restriction:") <+>  pp_thing,
 548          nest 2 (ptext (sLit "is used in") <+> use_lvl_doc <> ptext (sLit ", and must be imported, not defined locally"))]
 549
 550   | otherwise                   -- Badly staged
 551   = failWithTc $                -- E.g.  \x -> $(f x)
 552     ptext (sLit "Stage error:") <+> pp_thing <+>
 553         hsep   [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
 554                 ptext (sLit "but used at stage") <+> ppr use_lvl]
 555   where
 556     use_lvl = thLevel use_stage
 557     use_lvl_doc | use_lvl == thLevel topStage    = ptext (sLit "a top-level splice")
 558                 | use_lvl == thLevel topAnnStage = ptext (sLit "an annotation")
 559                 | otherwise                      = panic "checkWellStaged"
 560
 561 topIdLvl :: Id -> ThLevel
 562 -- Globals may either be imported, or may be from an earlier "chunk"
 563 -- (separated by declaration splices) of this module.  The former
 564 --  *can* be used inside a top-level splice, but the latter cannot.
 565 -- Hence we give the former impLevel, but the latter topLevel
 566 -- E.g. this is bad:
 567 --      x = [| foo |]
 568 --      $( f x )
 569 -- By the time we are prcessing the $(f x), the binding for "x"
 570 -- will be in the global env, not the local one.
 571 topIdLvl id | isLocalId id = topLevel
 572             | otherwise    = impLevel
 573
 574 -- Indicates the legal transitions on bracket( [| |] ).
 575 bracketOK :: ThStage -> Maybe ThLevel
 576 bracketOK (Brack _ _ _) = Nothing       -- Bracket illegal inside a bracket
 577 bracketOK stage         = Just (thLevel stage + 1)
 578
 579 -- Indicates the legal transitions on splice($).
 580 spliceOK :: ThStage -> Maybe ThLevel
 581 spliceOK (Splice _) = Nothing   -- Splice illegal inside splice
 582 spliceOK stage      = Just (thLevel stage - 1)
 583
 584 tcMetaTy :: Name -> TcM Type
 585 -- Given the name of a Template Haskell data type,
 586 -- return the type
 587 -- E.g. given the name "Expr" return the type "Expr"
 588 tcMetaTy tc_name = do
 589     t <- tcLookupTyCon tc_name
 590     return (mkTyConApp t [])
 591
 592 thRnBrack :: ThStage
 593 -- Used *only* to indicate that we are inside a TH bracket during renaming
 594 -- Tested by TcEnv.isBrackStage
 595 -- See Note [Top-level Names in Template Haskell decl quotes]
 596 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
 597
 598 isBrackStage :: ThStage -> Bool
 599 isBrackStage (Brack {}) = True
 600 isBrackStage _other     = False
 601
 602 thTopLevelId :: Id -> Bool
 603 -- See Note [What is a top-level Id?] in TcSplice
 604 thTopLevelId id = isGlobalId id || isExternalName (idName id)
 605 \end{code}
 606
 607
 608 %************************************************************************
 609 %*                                                                      *
 610 \subsection{The InstInfo type}
 611 %*                                                                      *
 612 %************************************************************************
 613
 614 The InstInfo type summarises the information in an instance declaration
 615
 616     instance c => k (t tvs) where b
 617
 618 It is used just for *local* instance decls (not ones from interface files).
 619 But local instance decls includes
 620         - derived ones
 621         - generic ones
 622 as well as explicit user written ones.
 623
 624 \begin{code}
 625 data InstInfo a
 626   = InstInfo {
 627       iSpec  :: Instance,               -- Includes the dfun id.  Its forall'd type
 628       iBinds :: InstBindings a          -- variables scope over the stuff in InstBindings!
 629     }
 630
 631 iDFunId :: InstInfo a -> DFunId
 632 iDFunId info = instanceDFunId (iSpec info)
 633
 634 data InstBindings a
 635   = VanillaInst                 -- The normal case
 636         (LHsBinds a)            -- Bindings for the instance methods
 637         [LSig a]                -- User pragmas recorded for generating
 638                                 -- specialised instances
 639
 640   | NewTypeDerived              -- Used for deriving instances of newtypes, where the
 641         CoercionI               -- witness dictionary is identical to the argument
 642                                 -- dictionary.  Hence no bindings, no pragmas.
 643                 -- The coercion maps from newtype to the representation type
 644                 -- (mentioning type variables bound by the forall'd iSpec variables)
 645                 -- E.g.   newtype instance N [a] = N1 (Tree a)
 646                 --        co : N [a] ~ Tree a
 647
 648 pprInstInfo :: InstInfo a -> SDoc
 649 pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
 650
 651 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
 652 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
 653   where
 654     details (VanillaInst b _)  = pprLHsBinds b
 655     details (NewTypeDerived _) = text "Derived from the representation type"
 656
 657 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
 658 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
 659                            (_, _, cls, [ty]) -> (cls, ty)
 660                            _ -> panic "simpleInstInfoClsTy"
 661
 662 simpleInstInfoTy :: InstInfo a -> Type
 663 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
 664
 665 simpleInstInfoTyCon :: InstInfo a -> TyCon
 666   -- Gets the type constructor for a simple instance declaration,
 667   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 668 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 669 \end{code}
 670
 671 Make a name for the dict fun for an instance decl.  It's an *external*
 672 name, like otber top-level names, and hence must be made with newGlobalBinder.
 673
 674 \begin{code}
 675 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
 676 newDFunName clas (ty:_) loc
 677   = do  { index   <- nextDFunIndex
 678         ; is_boot <- tcIsHsBoot
 679         ; mod     <- getModule
 680         ; let info_string = occNameString (getOccName clas) ++
 681                             occNameString (getDFunTyKey ty)
 682               dfun_occ = mkDFunOcc info_string is_boot index
 683
 684         ; newGlobalBinder mod dfun_occ loc }
 685
 686 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 687 \end{code}
 688
 689 Make a name for the representation tycon of a family instance.  It's an
 690 *external* name, like otber top-level names, and hence must be made with
 691 newGlobalBinder.
 692
 693 \begin{code}
 694 newFamInstTyConName :: Name -> SrcSpan -> TcM Name
 695 newFamInstTyConName tc_name loc
 696   = do  { index <- nextDFunIndex
 697         ; mod   <- getModule
 698         ; let occ = nameOccName tc_name
 699         ; newGlobalBinder mod (mkInstTyTcOcc index occ) loc }
 700 \end{code}
 701
 702 Stable names used for foreign exports and annotations.
 703 For stable names, the name must be unique (see #1533).  If the
 704 same thing has several stable Ids based on it, the
 705 top-level bindings generated must not have the same name.
 706 Hence we create an External name (doesn't change), and we
 707 append a Unique to the string right here.
 708
 709 \begin{code}
 710 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 711 mkStableIdFromString str sig_ty loc occ_wrapper = do
 712     uniq <- newUnique
 713     mod <- getModule
 714     let uniq_str = showSDoc (pprUnique uniq) :: String
 715         occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
 716         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
 717         id  = mkExportedLocalId gnm sig_ty :: Id
 718     return id
 719
 720 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 721 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
 722 \end{code}
 723
 724 %************************************************************************
 725 %*                                                                      *
 726 \subsection{Errors}
 727 %*                                                                      *
 728 %************************************************************************
 729
 730 \begin{code}
 731 pprBinders :: [Name] -> SDoc
 732 -- Used in error messages
 733 -- Use quotes for a single one; they look a bit "busy" for several
 734 pprBinders [bndr] = quotes (ppr bndr)
 735 pprBinders bndrs  = pprWithCommas ppr bndrs
 736
 737 notFound :: Name -> TcGblEnv -> TcM TyThing
 738 notFound name env
 739   = failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
 740                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
 741                      ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env env)]
 742                     )
 743
 744 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
 745 wrongThingErr expected thing name
 746   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
 747                 ptext (sLit "used as a") <+> text expected)
 748 \end{code}