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, 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 -- Internal names can happen in GHCi
 119
 120                 Just mod | mod == tcg_mod env   -- Names from this module
 121                          -> notFound name -- 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 may be ambiguous (as we know that overlapping instances have
 175 -- identical right-hand sides under overlapping substitutions - see
 176 -- 'FamInstEnv.lookupFamInstEnvConflicts').  However, the type arguments used
 177 -- for matching must be equal to or be more specific than those of the family
 178 -- instance declaration.  We pick one of the matches in case of ambiguity; as
 179 -- the right-hand sides are identical under the match substitution, the choice
 180 -- does not matter.
 181 --
 182 -- Return the instance tycon and its type instance.  For example, if we have
 183 --
 184 --  tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
 185 --
 186 -- then we have a coercion (ie, type instance of family instance coercion)
 187 --
 188 --  :Co:R42T Int :: T [Int] ~ :R42T Int
 189 --
 190 -- which implies that :R42T was declared as 'data instance T [a]'.
 191 --
 192 tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
 193 tcLookupFamInst tycon tys
 194   | not (isOpenTyCon tycon)
 195   = return Nothing
 196   | otherwise
 197   = do { env <- getGblEnv
 198        ; eps <- getEps
 199        ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
 200        ; case lookupFamInstEnv instEnv tycon tys of
 201            []                      -> return Nothing
 202            ((fam_inst, rep_tys):_)
 203              -> return $ Just (famInstTyCon fam_inst, rep_tys)
 204        }
 205 \end{code}
 206
 207 \begin{code}
 208 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
 209     lookupThing = tcLookupGlobal
 210 \end{code}
 211
 212 %************************************************************************
 213 %*                                                                      *
 214                 Extending the global environment
 215 %*                                                                      *
 216 %************************************************************************
 217
 218
 219 \begin{code}
 220 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
 221 -- Use this to update the global type env
 222 -- It updates both  * the normal tcg_type_env field
 223 --                  * the tcg_type_env_var field seen by interface files
 224 setGlobalTypeEnv tcg_env new_type_env
 225   = do  {     -- Sync the type-envt variable seen by interface files
 226            writeMutVar (tcg_type_env_var tcg_env) new_type_env
 227          ; return (tcg_env { tcg_type_env = new_type_env }) }
 228
 229 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 230   -- Given a mixture of Ids, TyCons, Classes, all from the
 231   -- module being compiled, extend the global environment
 232 tcExtendGlobalEnv things thing_inside
 233    = do { tcg_env <- getGblEnv
 234         ; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things
 235         ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 236         ; setGblEnv tcg_env' thing_inside }
 237
 238 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 239   -- Same deal as tcExtendGlobalEnv, but for Ids
 240 tcExtendGlobalValEnv ids thing_inside
 241   = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
 242
 243 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
 244 -- Extend the global environments for the type/class knot tying game
 245 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
 246 tcExtendRecEnv gbl_stuff thing_inside
 247  = do  { tcg_env <- getGblEnv
 248        ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
 249        ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 250        ; setGblEnv tcg_env' thing_inside }
 251 \end{code}
 252
 253
 254 %************************************************************************
 255 %*                                                                      *
 256 \subsection{The local environment}
 257 %*                                                                      *
 258 %************************************************************************
 259
 260 \begin{code}
 261 tcLookupLocated :: Located Name -> TcM TcTyThing
 262 tcLookupLocated = addLocM tcLookup
 263
 264 tcLookup :: Name -> TcM TcTyThing
 265 tcLookup name = do
 266     local_env <- getLclEnv
 267     case lookupNameEnv (tcl_env local_env) name of
 268         Just thing -> return thing
 269         Nothing    -> AGlobal <$> tcLookupGlobal name
 270
 271 tcLookupTyVar :: Name -> TcM TcTyVar
 272 tcLookupTyVar name = do
 273     thing <- tcLookup name
 274     case thing of
 275         ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
 276         _           -> pprPanic "tcLookupTyVar" (ppr name)
 277
 278 tcLookupId :: Name -> TcM Id
 279 -- Used when we aren't interested in the binding level, nor refinement.
 280 -- The "no refinement" part means that we return the un-refined Id regardless
 281 --
 282 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
 283 tcLookupId name = do
 284     thing <- tcLookup name
 285     case thing of
 286         ATcId { tct_id = id} -> return id
 287         AGlobal (AnId id)    -> return id
 288         _                    -> pprPanic "tcLookupId" (ppr name)
 289
 290 tcLookupLocalIds :: [Name] -> TcM [TcId]
 291 -- We expect the variables to all be bound, and all at
 292 -- the same level as the lookup.  Only used in one place...
 293 tcLookupLocalIds ns = do
 294     env <- getLclEnv
 295     return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
 296   where
 297     lookup lenv lvl name
 298         = case lookupNameEnv lenv name of
 299                 Just (ATcId { tct_id = id, tct_level = lvl1 })
 300                         -> ASSERT( lvl == lvl1 ) id
 301                 _ -> pprPanic "tcLookupLocalIds" (ppr name)
 302
 303 lclEnvElts :: TcLclEnv -> [TcTyThing]
 304 lclEnvElts env = nameEnvElts (tcl_env env)
 305
 306 getInLocalScope :: TcM (Name -> Bool)
 307   -- Ids only
 308 getInLocalScope = do
 309     env <- getLclEnv
 310     let lcl_env = tcl_env env
 311     return (`elemNameEnv` lcl_env)
 312 \end{code}
 313
 314 \begin{code}
 315 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
 316 tcExtendKindEnv things thing_inside
 317   = updLclEnv upd thing_inside
 318   where
 319     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
 320     extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
 321
 322 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> ([LHsTyVarBndr Name] -> TcM r) -> TcM r
 323 tcExtendKindEnvTvs bndrs thing_inside
 324   = tcExtendKindEnv (map (hsTyVarNameKind . unLoc) bndrs)
 325                     (thing_inside bndrs)
 326
 327 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 328 tcExtendTyVarEnv tvs thing_inside
 329   = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
 330
 331 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
 332 tcExtendTyVarEnv2 binds thing_inside = do
 333     env@(TcLclEnv {tcl_env = le,
 334                    tcl_tyvars = gtvs,
 335                    tcl_rdr = rdr_env}) <- getLclEnv
 336     let
 337         rdr_env'   = extendLocalRdrEnvList rdr_env (map fst binds)
 338         new_tv_set = tcTyVarsOfTypes (map snd binds)
 339         le'        = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
 340
 341         -- It's important to add the in-scope tyvars to the global tyvar set
 342         -- as well.  Consider
 343         --      f (_::r) = let g y = y::r in ...
 344         -- Here, g mustn't be generalised.  This is also important during
 345         -- class and instance decls, when we mustn't generalise the class tyvars
 346         -- when typechecking the methods.
 347     gtvs' <- tc_extend_gtvs gtvs new_tv_set
 348     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
 349
 350 getScopedTyVarBinds :: TcM [(Name, TcType)]
 351 getScopedTyVarBinds
 352   = do  { lcl_env <- getLclEnv
 353         ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
 354 \end{code}
 355
 356
 357 \begin{code}
 358 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
 359 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
 360
 361 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
 362 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
 363
 364 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 365 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
 366 tcExtendIdEnv2 names_w_ids thing_inside
 367   = do  { env <- getLclEnv
 368         ; tc_extend_local_id_env env (thLevel (tcl_th_ctxt env)) names_w_ids thing_inside }
 369
 370 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
 371 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
 372 -- Note especially that we bind them at TH level 'impLevel'.  That's because it's
 373 -- OK to use a variable bound earlier in the interaction in a splice, becuase
 374 -- GHCi has already compiled it to bytecode
 375 tcExtendGhciEnv ids thing_inside
 376   = do  { env <- getLclEnv
 377         ; tc_extend_local_id_env env impLevel [(idName id, id) | id <- ids] thing_inside }
 378
 379 tc_extend_local_id_env          -- This is the guy who does the work
 380         :: TcLclEnv
 381         -> ThLevel
 382         -> [(Name,TcId)]
 383         -> TcM a -> TcM a
 384 -- Invariant: the TcIds are fully zonked. Reasons:
 385 --      (a) The kinds of the forall'd type variables are defaulted
 386 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
 387 --      (b) There are no via-Indirect occurrences of the bound variables
 388 --          in the types, because instantiation does not look through such things
 389 --      (c) The call to tyVarsOfTypes is ok without looking through refs
 390
 391 tc_extend_local_id_env env th_lvl names_w_ids thing_inside
 392   = do  { traceTc (text "env2")
 393         ; traceTc (text "env3" <+> ppr extra_env)
 394         ; gtvs' <- tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars
 395         ; let env' = env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}
 396         ; setLclEnv env' thing_inside }
 397   where
 398     extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
 399     extra_env       = [ (name, ATcId { tct_id = id,
 400                                        tct_level = th_lvl,
 401                                        tct_type = id_ty,
 402                                        tct_co = case isRefineableTy id_ty of
 403                                                   (True,_) -> Unrefineable
 404                                                   (_,True) -> Rigid idHsWrapper
 405                                                   _        -> Wobbly})
 406                       | (name,id) <- names_w_ids, let id_ty = idType id]
 407     le'             = extendNameEnvList (tcl_env env) extra_env
 408     rdr_env'        = extendLocalRdrEnvList (tcl_rdr env) [name | (name,_) <- names_w_ids]
 409 \end{code}
 410
 411
 412 \begin{code}
 413 -----------------------
 414 -- findGlobals looks at the value environment and finds values
 415 -- whose types mention the offending type variable.  It has to be
 416 -- careful to zonk the Id's type first, so it has to be in the monad.
 417 -- We must be careful to pass it a zonked type variable, too.
 418
 419 findGlobals :: TcTyVarSet
 420             -> TidyEnv
 421             -> TcM (TidyEnv, [SDoc])
 422
 423 findGlobals tvs tidy_env = do
 424     lcl_env <- getLclEnv
 425     go tidy_env [] (lclEnvElts lcl_env)
 426   where
 427     go tidy_env acc [] = return (tidy_env, acc)
 428     go tidy_env acc (thing : things) = do
 429         (tidy_env1, maybe_doc) <- find_thing ignore_it tidy_env thing
 430         case maybe_doc of
 431           Just d  -> go tidy_env1 (d:acc) things
 432           Nothing -> go tidy_env1 acc     things
 433
 434     ignore_it ty = tvs `disjointVarSet` tyVarsOfType ty
 435
 436 -----------------------
 437 find_thing :: (TcType -> Bool) -> TidyEnv -> TcTyThing
 438            -> TcM (TidyEnv, Maybe SDoc)
 439 find_thing ignore_it tidy_env (ATcId { tct_id = id }) = do
 440     id_ty <- zonkTcType  (idType id)
 441     if ignore_it id_ty then
 442         return (tidy_env, Nothing)
 443      else let
 444         (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
 445         msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
 446                    nest 2 (parens (ptext (sLit "bound at") <+>
 447                                    ppr (getSrcLoc id)))]
 448      in
 449       return (tidy_env', Just msg)
 450
 451 find_thing ignore_it tidy_env (ATyVar tv ty) = do
 452     tv_ty <- zonkTcType ty
 453     if ignore_it tv_ty then
 454         return (tidy_env, Nothing)
 455      else let
 456         -- The name tv is scoped, so we don't need to tidy it
 457         (tidy_env1, tidy_ty) = tidyOpenType  tidy_env tv_ty
 458         msg = sep [ptext (sLit "Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
 459
 460         eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
 461                    getOccName tv == getOccName tv' = empty
 462                  | otherwise = equals <+> ppr tidy_ty
 463                 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
 464         bound_at = parens $ ptext (sLit "bound at:") <+> ppr (getSrcLoc tv)
 465      in
 466        return (tidy_env1, Just msg)
 467
 468 find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
 469 \end{code}
 470
 471 %************************************************************************
 472 %*                                                                      *
 473 \subsection{The global tyvars}
 474 %*                                                                      *
 475 %************************************************************************
 476
 477 \begin{code}
 478 tc_extend_gtvs :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
 479 tc_extend_gtvs gtvs extra_global_tvs = do
 480     global_tvs <- readMutVar gtvs
 481     newMutVar (global_tvs `unionVarSet` extra_global_tvs)
 482 \end{code}
 483
 484 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 485 To improve subsequent calls to the same function it writes the zonked set back into
 486 the environment.
 487
 488 \begin{code}
 489 tcGetGlobalTyVars :: TcM TcTyVarSet
 490 tcGetGlobalTyVars = do
 491     (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv
 492     gbl_tvs  <- readMutVar gtv_var
 493     gbl_tvs' <- zonkTcTyVarsAndFV (varSetElems gbl_tvs)
 494     writeMutVar gtv_var gbl_tvs'
 495     return gbl_tvs'
 496 \end{code}
 497
 498
 499 %************************************************************************
 500 %*                                                                      *
 501 \subsection{Rules}
 502 %*                                                                      *
 503 %************************************************************************
 504
 505 \begin{code}
 506 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
 507         -- Just pop the new rules into the EPS and envt resp
 508         -- All the rules come from an interface file, not soruce
 509         -- Nevertheless, some may be for this module, if we read
 510         -- its interface instead of its source code
 511 tcExtendRules lcl_rules thing_inside
 512  = do { env <- getGblEnv
 513       ; let
 514           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
 515       ; setGblEnv env' thing_inside }
 516 \end{code}
 517
 518
 519 %************************************************************************
 520 %*                                                                      *
 521                 Meta level
 522 %*                                                                      *
 523 %************************************************************************
 524
 525 \begin{code}
 526 checkWellStaged :: SDoc         -- What the stage check is for
 527                 -> ThLevel      -- Binding level (increases inside brackets)
 528                 -> ThLevel      -- Use stage
 529                 -> TcM ()       -- Fail if badly staged, adding an error
 530 checkWellStaged pp_thing bind_lvl use_lvl
 531   | use_lvl >= bind_lvl         -- OK! Used later than bound
 532   = return ()                   -- E.g.  \x -> [| $(f x) |]
 533
 534   | bind_lvl == outerLevel      -- GHC restriction on top level splices
 535   = failWithTc $
 536     sep [ptext (sLit "GHC stage restriction:") <+>  pp_thing,
 537          nest 2 (vcat [ ptext (sLit "is used in a top-level splice or annotation,")
 538                       , ptext (sLit "and must be imported, not defined locally")])]
 539
 540   | otherwise                   -- Badly staged
 541   = failWithTc $                -- E.g.  \x -> $(f x)
 542     ptext (sLit "Stage error:") <+> pp_thing <+>
 543         hsep   [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
 544                 ptext (sLit "but used at stage") <+> ppr use_lvl]
 545
 546 topIdLvl :: Id -> ThLevel
 547 -- Globals may either be imported, or may be from an earlier "chunk"
 548 -- (separated by declaration splices) of this module.  The former
 549 --  *can* be used inside a top-level splice, but the latter cannot.
 550 -- Hence we give the former impLevel, but the latter topLevel
 551 -- E.g. this is bad:
 552 --      x = [| foo |]
 553 --      $( f x )
 554 -- By the time we are prcessing the $(f x), the binding for "x"
 555 -- will be in the global env, not the local one.
 556 topIdLvl id | isLocalId id = outerLevel
 557             | otherwise    = impLevel
 558
 559 tcMetaTy :: Name -> TcM Type
 560 -- Given the name of a Template Haskell data type,
 561 -- return the type
 562 -- E.g. given the name "Expr" return the type "Expr"
 563 tcMetaTy tc_name = do
 564     t <- tcLookupTyCon tc_name
 565     return (mkTyConApp t [])
 566
 567 thRnBrack :: ThStage
 568 -- Used *only* to indicate that we are inside a TH bracket during renaming
 569 -- Tested by TcEnv.isBrackStage
 570 -- See Note [Top-level Names in Template Haskell decl quotes]
 571 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
 572
 573 isBrackStage :: ThStage -> Bool
 574 isBrackStage (Brack {}) = True
 575 isBrackStage _other     = False
 576
 577 thTopLevelId :: Id -> Bool
 578 -- See Note [What is a top-level Id?] in TcSplice
 579 thTopLevelId id = isGlobalId id || isExternalName (idName id)
 580 \end{code}
 581
 582
 583 %************************************************************************
 584 %*                                                                      *
 585 \subsection{The InstInfo type}
 586 %*                                                                      *
 587 %************************************************************************
 588
 589 The InstInfo type summarises the information in an instance declaration
 590
 591     instance c => k (t tvs) where b
 592
 593 It is used just for *local* instance decls (not ones from interface files).
 594 But local instance decls includes
 595         - derived ones
 596         - generic ones
 597 as well as explicit user written ones.
 598
 599 \begin{code}
 600 data InstInfo a
 601   = InstInfo {
 602       iSpec  :: Instance,               -- Includes the dfun id.  Its forall'd type
 603       iBinds :: InstBindings a          -- variables scope over the stuff in InstBindings!
 604     }
 605
 606 iDFunId :: InstInfo a -> DFunId
 607 iDFunId info = instanceDFunId (iSpec info)
 608
 609 data InstBindings a
 610   = VanillaInst                 -- The normal case
 611         (LHsBinds a)            -- Bindings for the instance methods
 612         [LSig a]                -- User pragmas recorded for generating
 613                                 -- specialised instances
 614         Bool                    -- True <=> This code came from a standalone deriving clause
 615
 616   | NewTypeDerived      -- Used for deriving instances of newtypes, where the
 617                         -- witness dictionary is identical to the argument
 618                         -- dictionary.  Hence no bindings, no pragmas.
 619
 620         CoercionI       -- The coercion maps from newtype to the representation type
 621                         -- (mentioning type variables bound by the forall'd iSpec variables)
 622                         -- E.g.   newtype instance N [a] = N1 (Tree a)
 623                         --        co : N [a] ~ Tree a
 624
 625         TyCon           -- The TyCon is the newtype N.  If it's indexed, then it's the
 626                         -- representation TyCon, so that tyConDataCons returns [N1],
 627                         -- the "data constructor".
 628                         -- See Note [Newtype deriving and unused constructors]
 629                         -- in TcDeriv
 630
 631 pprInstInfo :: InstInfo a -> SDoc
 632 pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
 633
 634 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
 635 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
 636   where
 637     details (VanillaInst b _ _) = pprLHsBinds b
 638     details (NewTypeDerived {}) = text "Derived from the representation type"
 639
 640 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
 641 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
 642                            (_, _, cls, [ty]) -> (cls, ty)
 643                            _ -> panic "simpleInstInfoClsTy"
 644
 645 simpleInstInfoTy :: InstInfo a -> Type
 646 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
 647
 648 simpleInstInfoTyCon :: InstInfo a -> TyCon
 649   -- Gets the type constructor for a simple instance declaration,
 650   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 651 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 652 \end{code}
 653
 654 Make a name for the dict fun for an instance decl.  It's an *external*
 655 name, like otber top-level names, and hence must be made with newGlobalBinder.
 656
 657 \begin{code}
 658 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
 659 newDFunName clas tys loc
 660   = do  { is_boot <- tcIsHsBoot
 661         ; mod     <- getModule
 662         ; let info_string = occNameString (getOccName clas) ++
 663                             concatMap (occNameString.getDFunTyKey) tys
 664         ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
 665         ; newGlobalBinder mod dfun_occ loc }
 666 \end{code}
 667
 668 Make a name for the representation tycon of a family instance.  It's an
 669 *external* name, like otber top-level names, and hence must be made with
 670 newGlobalBinder.
 671
 672 \begin{code}
 673 newFamInstTyConName :: Name -> [Type] -> SrcSpan -> TcM Name
 674 newFamInstTyConName tc_name tys loc
 675   = do  { mod   <- getModule
 676         ; let info_string = occNameString (getOccName tc_name) ++
 677                             concatMap (occNameString.getDFunTyKey) tys
 678         ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
 679         ; newGlobalBinder mod occ loc }
 680 \end{code}
 681
 682 Stable names used for foreign exports and annotations.
 683 For stable names, the name must be unique (see #1533).  If the
 684 same thing has several stable Ids based on it, the
 685 top-level bindings generated must not have the same name.
 686 Hence we create an External name (doesn't change), and we
 687 append a Unique to the string right here.
 688
 689 \begin{code}
 690 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 691 mkStableIdFromString str sig_ty loc occ_wrapper = do
 692     uniq <- newUnique
 693     mod <- getModule
 694     let uniq_str = showSDoc (pprUnique uniq) :: String
 695         occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
 696         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
 697         id  = mkExportedLocalId gnm sig_ty :: Id
 698     return id
 699
 700 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 701 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
 702 \end{code}
 703
 704 %************************************************************************
 705 %*                                                                      *
 706 \subsection{Errors}
 707 %*                                                                      *
 708 %************************************************************************
 709
 710 \begin{code}
 711 pprBinders :: [Name] -> SDoc
 712 -- Used in error messages
 713 -- Use quotes for a single one; they look a bit "busy" for several
 714 pprBinders [bndr] = quotes (ppr bndr)
 715 pprBinders bndrs  = pprWithCommas ppr bndrs
 716
 717 notFound :: Name -> TcM TyThing
 718 notFound name
 719   = do { (gbl,lcl) <- getEnvs
 720        ; failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
 721                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
 722                      ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env gbl),
 723                      ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl)]
 724                     ) }
 725
 726 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
 727 wrongThingErr expected thing name
 728   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
 729                 ptext (sLit "used as a") <+> text expected)
 730 \end{code}