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