compiler/typecheck/TcEnv.hs

   1 -- (c) The University of Glasgow 2006
   2 {-# LANGUAGE CPP, FlexibleInstances #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# OPTIONS_GHC -fno-warn-orphans #-}  -- instance MonadThings is necessarily an
   5                                        -- orphan
   6 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
   7                                       -- in module PlaceHolder
   8
   9 module TcEnv(
  10         TyThing(..), TcTyThing(..), TcId,
  11
  12         -- Instance environment, and InstInfo type
  13         InstInfo(..), iDFunId, pprInstInfoDetails,
  14         simpleInstInfoClsTy, simpleInstInfoTy, simpleInstInfoTyCon,
  15         InstBindings(..),
  16
  17         -- Global environment
  18         tcExtendGlobalEnv, tcExtendTyConEnv,
  19         tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
  20         tcExtendGlobalValEnv,
  21         tcLookupLocatedGlobal, tcLookupGlobal,
  22         tcLookupTyCon, tcLookupClass,
  23         tcLookupDataCon, tcLookupPatSyn, tcLookupConLike,
  24         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
  25         tcLookupLocatedClass, tcLookupAxiom,
  26         lookupGlobal,
  27
  28         -- Local environment
  29         tcExtendKindEnv, tcExtendKindEnvList,
  30         tcExtendTyVarEnv, tcExtendTyVarEnv2,
  31         tcExtendLetEnv, tcExtendSigIds, tcExtendRecIds,
  32         tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,
  33         tcExtendBinderStack, tcExtendLocalTypeEnv,
  34         isTypeClosedLetBndr,
  35
  36         tcLookup, tcLookupLocated, tcLookupLocalIds,
  37         tcLookupId, tcLookupIdMaybe, tcLookupTyVar,
  38         tcLookupLcl_maybe,
  39         getInLocalScope,
  40         wrongThingErr, pprBinders,
  41
  42         tcAddDataFamConPlaceholders, tcAddPatSynPlaceholders,
  43         getTypeSigNames,
  44         tcExtendRecEnv,         -- For knot-tying
  45
  46         -- Tidying
  47         tcInitTidyEnv, tcInitOpenTidyEnv,
  48
  49         -- Instances
  50         tcLookupInstance, tcGetInstEnvs,
  51
  52         -- Rules
  53         tcExtendRules,
  54
  55         -- Defaults
  56         tcGetDefaultTys,
  57
  58         -- Global type variables
  59         tcGetGlobalTyCoVars,
  60
  61         -- Template Haskell stuff
  62         checkWellStaged, tcMetaTy, thLevel,
  63         topIdLvl, isBrackStage,
  64
  65         -- New Ids
  66         newDFunName, newDFunName', newFamInstTyConName,
  67         newFamInstAxiomName,
  68         mkStableIdFromString, mkStableIdFromName,
  69         mkWrapperName
  70   ) where
  71
  72 #include "HsVersions.h"
  73
  74 import GhcPrelude
  75
  76 import HsSyn
  77 import IfaceEnv
  78 import TcRnMonad
  79 import TcMType
  80 import TcType
  81 import LoadIface
  82 import PrelNames
  83 import TysWiredIn
  84 import Id
  85 import Var
  86 import VarSet
  87 import RdrName
  88 import InstEnv
  89 import DataCon ( DataCon )
  90 import PatSyn  ( PatSyn )
  91 import ConLike
  92 import TyCon
  93 import Type
  94 import CoAxiom
  95 import Class
  96 import Name
  97 import NameSet
  98 import NameEnv
  99 import VarEnv
 100 import HscTypes
 101 import DynFlags
 102 import SrcLoc
 103 import BasicTypes hiding( SuccessFlag(..) )
 104 import Module
 105 import Outputable
 106 import Encoding
 107 import FastString
 108 import ListSetOps
 109 import Util
 110 import Maybes( MaybeErr(..), orElse )
 111 import qualified GHC.LanguageExtensions as LangExt
 112
 113 import Data.IORef
 114 import Data.List
 115
 116
 117 {- *********************************************************************
 118 *                                                                      *
 119             An IO interface to looking up globals
 120 *                                                                      *
 121 ********************************************************************* -}
 122
 123 lookupGlobal :: HscEnv -> Name -> IO TyThing
 124 -- An IO version, used outside the typechecker
 125 -- It's more complicated than it looks, because it may
 126 -- need to suck in an interface file
 127 lookupGlobal hsc_env name
 128   = initTcForLookup hsc_env (tcLookupGlobal name)
 129     -- This initTcForLookup stuff is massive overkill
 130     -- but that's how it is right now, and at least
 131     -- this function localises it
 132
 133 {-
 134 ************************************************************************
 135 *                                                                      *
 136 *                      tcLookupGlobal                                  *
 137 *                                                                      *
 138 ************************************************************************
 139
 140 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
 141 unless you know that the SrcSpan in the monad is already set to the
 142 span of the Name.
 143 -}
 144
 145
 146 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
 147 -- c.f. IfaceEnvEnv.tcIfaceGlobal
 148 tcLookupLocatedGlobal name
 149   = addLocM tcLookupGlobal name
 150
 151 tcLookupGlobal :: Name -> TcM TyThing
 152 -- The Name is almost always an ExternalName, but not always
 153 -- In GHCi, we may make command-line bindings (ghci> let x = True)
 154 -- that bind a GlobalId, but with an InternalName
 155 tcLookupGlobal name
 156   = do  {    -- Try local envt
 157           env <- getGblEnv
 158         ; case lookupNameEnv (tcg_type_env env) name of {
 159                 Just thing -> return thing ;
 160                 Nothing    ->
 161
 162                 -- Should it have been in the local envt?
 163                 -- (NB: use semantic mod here, since names never use
 164                 -- identity module, see Note [Identity versus semantic module].)
 165           if nameIsLocalOrFrom (tcg_semantic_mod env) name
 166           then notFound name  -- Internal names can happen in GHCi
 167           else
 168
 169            -- Try home package table and external package table
 170     do  { mb_thing <- tcLookupImported_maybe name
 171         ; case mb_thing of
 172             Succeeded thing -> return thing
 173             Failed msg      -> failWithTc msg
 174         }}}
 175
 176 tcLookupDataCon :: Name -> TcM DataCon
 177 tcLookupDataCon name = do
 178     thing <- tcLookupGlobal name
 179     case thing of
 180         AConLike (RealDataCon con) -> return con
 181         _                          -> wrongThingErr "data constructor" (AGlobal thing) name
 182
 183 tcLookupPatSyn :: Name -> TcM PatSyn
 184 tcLookupPatSyn name = do
 185     thing <- tcLookupGlobal name
 186     case thing of
 187         AConLike (PatSynCon ps) -> return ps
 188         _                       -> wrongThingErr "pattern synonym" (AGlobal thing) name
 189
 190 tcLookupConLike :: Name -> TcM ConLike
 191 tcLookupConLike name = do
 192     thing <- tcLookupGlobal name
 193     case thing of
 194         AConLike cl -> return cl
 195         _           -> wrongThingErr "constructor-like thing" (AGlobal thing) name
 196
 197 tcLookupClass :: Name -> TcM Class
 198 tcLookupClass name = do
 199     thing <- tcLookupGlobal name
 200     case thing of
 201         ATyCon tc | Just cls <- tyConClass_maybe tc -> return cls
 202         _                                           -> wrongThingErr "class" (AGlobal thing) name
 203
 204 tcLookupTyCon :: Name -> TcM TyCon
 205 tcLookupTyCon name = do
 206     thing <- tcLookupGlobal name
 207     case thing of
 208         ATyCon tc -> return tc
 209         _         -> wrongThingErr "type constructor" (AGlobal thing) name
 210
 211 tcLookupAxiom :: Name -> TcM (CoAxiom Branched)
 212 tcLookupAxiom name = do
 213     thing <- tcLookupGlobal name
 214     case thing of
 215         ACoAxiom ax -> return ax
 216         _           -> wrongThingErr "axiom" (AGlobal thing) name
 217
 218 tcLookupLocatedGlobalId :: Located Name -> TcM Id
 219 tcLookupLocatedGlobalId = addLocM tcLookupId
 220
 221 tcLookupLocatedClass :: Located Name -> TcM Class
 222 tcLookupLocatedClass = addLocM tcLookupClass
 223
 224 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
 225 tcLookupLocatedTyCon = addLocM tcLookupTyCon
 226
 227 -- Find the instance that exactly matches a type class application.  The class arguments must be precisely
 228 -- the same as in the instance declaration (modulo renaming & casts).
 229 --
 230 tcLookupInstance :: Class -> [Type] -> TcM ClsInst
 231 tcLookupInstance cls tys
 232   = do { instEnv <- tcGetInstEnvs
 233        ; case lookupUniqueInstEnv instEnv cls tys of
 234            Left err             -> failWithTc $ text "Couldn't match instance:" <+> err
 235            Right (inst, tys)
 236              | uniqueTyVars tys -> return inst
 237              | otherwise        -> failWithTc errNotExact
 238        }
 239   where
 240     errNotExact = text "Not an exact match (i.e., some variables get instantiated)"
 241
 242     uniqueTyVars tys = all isTyVarTy tys
 243                     && hasNoDups (map (getTyVar "tcLookupInstance") tys)
 244
 245 tcGetInstEnvs :: TcM InstEnvs
 246 -- Gets both the external-package inst-env
 247 -- and the home-pkg inst env (includes module being compiled)
 248 tcGetInstEnvs = do { eps <- getEps
 249                    ; env <- getGblEnv
 250                    ; return (InstEnvs { ie_global  = eps_inst_env eps
 251                                       , ie_local   = tcg_inst_env env
 252                                       , ie_visible = tcVisibleOrphanMods env }) }
 253
 254 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
 255     lookupThing = tcLookupGlobal
 256
 257 {-
 258 ************************************************************************
 259 *                                                                      *
 260                 Extending the global environment
 261 *                                                                      *
 262 ************************************************************************
 263 -}
 264
 265 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
 266 -- Use this to update the global type env
 267 -- It updates both  * the normal tcg_type_env field
 268 --                  * the tcg_type_env_var field seen by interface files
 269 setGlobalTypeEnv tcg_env new_type_env
 270   = do  {     -- Sync the type-envt variable seen by interface files
 271            writeMutVar (tcg_type_env_var tcg_env) new_type_env
 272          ; return (tcg_env { tcg_type_env = new_type_env }) }
 273
 274
 275 tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r
 276   -- Just extend the global environment with some TyThings
 277   -- Do not extend tcg_tcs etc
 278 tcExtendGlobalEnvImplicit things thing_inside
 279    = do { tcg_env <- getGblEnv
 280         ; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things
 281         ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 282         ; setGblEnv tcg_env' thing_inside }
 283
 284 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 285   -- Given a mixture of Ids, TyCons, Classes, all defined in the
 286   -- module being compiled, extend the global environment
 287 tcExtendGlobalEnv things thing_inside
 288   = do { env <- getGblEnv
 289        ; let env' = env { tcg_tcs = [tc | ATyCon tc <- things] ++ tcg_tcs env,
 290                           tcg_patsyns = [ps | AConLike (PatSynCon ps) <- things] ++ tcg_patsyns env }
 291        ; setGblEnv env' $
 292             tcExtendGlobalEnvImplicit things thing_inside
 293        }
 294
 295 tcExtendTyConEnv :: [TyCon] -> TcM r -> TcM r
 296   -- Given a mixture of Ids, TyCons, Classes, all defined in the
 297   -- module being compiled, extend the global environment
 298 tcExtendTyConEnv tycons thing_inside
 299   = do { env <- getGblEnv
 300        ; let env' = env { tcg_tcs = tycons ++ tcg_tcs env }
 301        ; setGblEnv env' $
 302          tcExtendGlobalEnvImplicit (map ATyCon tycons) thing_inside
 303        }
 304
 305 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 306   -- Same deal as tcExtendGlobalEnv, but for Ids
 307 tcExtendGlobalValEnv ids thing_inside
 308   = tcExtendGlobalEnvImplicit [AnId id | id <- ids] thing_inside
 309
 310 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
 311 -- Extend the global environments for the type/class knot tying game
 312 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
 313 tcExtendRecEnv gbl_stuff thing_inside
 314  = do  { tcg_env <- getGblEnv
 315        ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
 316        ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 317        ; setGblEnv tcg_env' thing_inside }
 318
 319 {-
 320 ************************************************************************
 321 *                                                                      *
 322 \subsection{The local environment}
 323 *                                                                      *
 324 ************************************************************************
 325 -}
 326
 327 tcLookupLocated :: Located Name -> TcM TcTyThing
 328 tcLookupLocated = addLocM tcLookup
 329
 330 tcLookupLcl_maybe :: Name -> TcM (Maybe TcTyThing)
 331 tcLookupLcl_maybe name
 332   = do { local_env <- getLclTypeEnv
 333        ; return (lookupNameEnv local_env name) }
 334
 335 tcLookup :: Name -> TcM TcTyThing
 336 tcLookup name = do
 337     local_env <- getLclTypeEnv
 338     case lookupNameEnv local_env name of
 339         Just thing -> return thing
 340         Nothing    -> AGlobal <$> tcLookupGlobal name
 341
 342 tcLookupTyVar :: Name -> TcM TcTyVar
 343 tcLookupTyVar name
 344   = do { thing <- tcLookup name
 345        ; case thing of
 346            ATyVar _ tv -> return tv
 347            _           -> pprPanic "tcLookupTyVar" (ppr name) }
 348
 349 tcLookupId :: Name -> TcM Id
 350 -- Used when we aren't interested in the binding level, nor refinement.
 351 -- The "no refinement" part means that we return the un-refined Id regardless
 352 --
 353 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
 354 tcLookupId name = do
 355     thing <- tcLookupIdMaybe name
 356     case thing of
 357         Just id -> return id
 358         _       -> pprPanic "tcLookupId" (ppr name)
 359
 360 tcLookupIdMaybe :: Name -> TcM (Maybe Id)
 361 tcLookupIdMaybe name
 362   = do { thing <- tcLookup name
 363        ; case thing of
 364            ATcId { tct_id = id} -> return $ Just id
 365            AGlobal (AnId id)    -> return $ Just id
 366            _                    -> return Nothing }
 367
 368 tcLookupLocalIds :: [Name] -> TcM [TcId]
 369 -- We expect the variables to all be bound, and all at
 370 -- the same level as the lookup.  Only used in one place...
 371 tcLookupLocalIds ns
 372   = do { env <- getLclEnv
 373        ; return (map (lookup (tcl_env env)) ns) }
 374   where
 375     lookup lenv name
 376         = case lookupNameEnv lenv name of
 377                 Just (ATcId { tct_id = id }) ->  id
 378                 _ -> pprPanic "tcLookupLocalIds" (ppr name)
 379
 380 getInLocalScope :: TcM (Name -> Bool)
 381 getInLocalScope = do { lcl_env <- getLclTypeEnv
 382                      ; return (`elemNameEnv` lcl_env) }
 383
 384 tcExtendKindEnvList :: [(Name, TcTyThing)] -> TcM r -> TcM r
 385 -- Used only during kind checking, for TcThings that are
 386 --      ATcTyCon or APromotionErr
 387 -- No need to update the global tyvars, or tcl_th_bndrs, or tcl_rdr
 388 tcExtendKindEnvList things thing_inside
 389   = do { traceTc "txExtendKindEnvList" (ppr things)
 390        ; updLclEnv upd_env thing_inside }
 391   where
 392     upd_env env = env { tcl_env = extendNameEnvList (tcl_env env) things }
 393
 394 tcExtendKindEnv :: NameEnv TcTyThing -> TcM r -> TcM r
 395 -- A variant of tcExtendKindEvnList
 396 tcExtendKindEnv extra_env thing_inside
 397   = do { traceTc "txExtendKindEnv" (ppr extra_env)
 398        ; updLclEnv upd_env thing_inside }
 399   where
 400     upd_env env = env { tcl_env = tcl_env env `plusNameEnv` extra_env }
 401
 402 -----------------------
 403 -- Scoped type and kind variables
 404 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 405 tcExtendTyVarEnv tvs thing_inside
 406   = tcExtendTyVarEnv2 [(tyVarName tv, tv) | tv <- tvs] thing_inside
 407
 408 tcExtendTyVarEnv2 :: [(Name,TcTyVar)] -> TcM r -> TcM r
 409 tcExtendTyVarEnv2 binds thing_inside
 410   -- this should be used only for explicitly mentioned scoped variables.
 411   -- thus, no coercion variables
 412   = do { tc_extend_local_env NotTopLevel
 413                     [(name, ATyVar name tv) | (name, tv) <- binds] $
 414          tcExtendBinderStack tv_binds $
 415          thing_inside }
 416   where
 417     tv_binds :: [TcBinder]
 418     tv_binds = [TcTvBndr name tv | (name,tv) <- binds]
 419
 420 isTypeClosedLetBndr :: Id -> Bool
 421 -- See Note [Bindings with closed types] in TcRnTypes
 422 isTypeClosedLetBndr = noFreeVarsOfType . idType
 423
 424 tcExtendRecIds :: [(Name, TcId)] -> TcM a -> TcM a
 425 -- Used for binding the recurive uses of Ids in a binding
 426 -- both top-level value bindings and and nested let/where-bindings
 427 -- Does not extend the TcBinderStack
 428 tcExtendRecIds pairs thing_inside
 429   = tc_extend_local_env NotTopLevel
 430           [ (name, ATcId { tct_id   = let_id
 431                          , tct_info = NonClosedLet emptyNameSet False })
 432           | (name, let_id) <- pairs ] $
 433     thing_inside
 434
 435 tcExtendSigIds :: TopLevelFlag -> [TcId] -> TcM a -> TcM a
 436 -- Used for binding the Ids that have a complete user type signature
 437 -- Does not extend the TcBinderStack
 438 tcExtendSigIds top_lvl sig_ids thing_inside
 439   = tc_extend_local_env top_lvl
 440           [ (idName id, ATcId { tct_id   = id
 441                               , tct_info = info })
 442           | id <- sig_ids
 443           , let closed = isTypeClosedLetBndr id
 444                 info   = NonClosedLet emptyNameSet closed ]
 445      thing_inside
 446
 447
 448 tcExtendLetEnv :: TopLevelFlag -> TcSigFun -> IsGroupClosed
 449                   -> [TcId] -> TcM a -> TcM a
 450 -- Used for both top-level value bindings and and nested let/where-bindings
 451 -- Adds to the TcBinderStack too
 452 tcExtendLetEnv top_lvl sig_fn (IsGroupClosed fvs fv_type_closed)
 453                ids thing_inside
 454   = tcExtendBinderStack [TcIdBndr id top_lvl | id <- ids] $
 455     tc_extend_local_env top_lvl
 456           [ (idName id, ATcId { tct_id   = id
 457                               , tct_info = mk_tct_info id })
 458           | id <- ids ]
 459     thing_inside
 460   where
 461     mk_tct_info id
 462       | type_closed && isEmptyNameSet rhs_fvs = ClosedLet
 463       | otherwise                             = NonClosedLet rhs_fvs type_closed
 464       where
 465         name        = idName id
 466         rhs_fvs     = lookupNameEnv fvs name `orElse` emptyNameSet
 467         type_closed = isTypeClosedLetBndr id &&
 468                       (fv_type_closed || hasCompleteSig sig_fn name)
 469
 470 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
 471 -- For lambda-bound and case-bound Ids
 472 -- Extends the the TcBinderStack as well
 473 tcExtendIdEnv ids thing_inside
 474   = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
 475
 476 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
 477 -- Exactly like tcExtendIdEnv2, but for a single (name,id) pair
 478 tcExtendIdEnv1 name id thing_inside
 479   = tcExtendIdEnv2 [(name,id)] thing_inside
 480
 481 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 482 tcExtendIdEnv2 names_w_ids thing_inside
 483   = tcExtendBinderStack [ TcIdBndr mono_id NotTopLevel
 484                         | (_,mono_id) <- names_w_ids ] $
 485     tc_extend_local_env NotTopLevel
 486             [ (name, ATcId { tct_id = id
 487                            , tct_info    = NotLetBound })
 488             | (name,id) <- names_w_ids]
 489     thing_inside
 490
 491 tc_extend_local_env :: TopLevelFlag -> [(Name, TcTyThing)] -> TcM a -> TcM a
 492 tc_extend_local_env top_lvl extra_env thing_inside
 493 -- Precondition: the argument list extra_env has TcTyThings
 494 --               that ATcId or ATyVar, but nothing else
 495 --
 496 -- Invariant: the ATcIds are fully zonked. Reasons:
 497 --      (a) The kinds of the forall'd type variables are defaulted
 498 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
 499 --      (b) There are no via-Indirect occurrences of the bound variables
 500 --          in the types, because instantiation does not look through such things
 501 --      (c) The call to tyCoVarsOfTypes is ok without looking through refs
 502
 503 -- The second argument of type TyVarSet is a set of type variables
 504 -- that are bound together with extra_env and should not be regarded
 505 -- as free in the types of extra_env.
 506   = do  { traceTc "env2" (ppr extra_env)
 507         ; env0 <- getLclEnv
 508         ; env1 <- tcExtendLocalTypeEnv env0 extra_env
 509         ; stage <- getStage
 510         ; let env2 = extend_local_env (top_lvl, thLevel stage) extra_env env1
 511         ; setLclEnv env2 thing_inside }
 512   where
 513     extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcLclEnv -> TcLclEnv
 514     -- Extend the local LocalRdrEnv and Template Haskell staging env simultaneously
 515     -- Reason for extending LocalRdrEnv: after running a TH splice we need
 516     -- to do renaming.
 517     extend_local_env thlvl pairs env@(TcLclEnv { tcl_rdr = rdr_env
 518                                                , tcl_th_bndrs = th_bndrs })
 519       = env { tcl_rdr      = extendLocalRdrEnvList rdr_env
 520                                 [ n | (n, _) <- pairs, isInternalName n ]
 521                                 -- The LocalRdrEnv contains only non-top-level names
 522                                 -- (GlobalRdrEnv handles the top level)
 523             , tcl_th_bndrs = extendNameEnvList th_bndrs  -- We only track Ids in tcl_th_bndrs
 524                                  [(n, thlvl) | (n, ATcId {}) <- pairs] }
 525
 526 tcExtendLocalTypeEnv :: TcLclEnv -> [(Name, TcTyThing)] -> TcM TcLclEnv
 527 tcExtendLocalTypeEnv lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) tc_ty_things
 528   | isEmptyVarSet extra_tvs
 529   = return (lcl_env { tcl_env = extendNameEnvList lcl_type_env tc_ty_things })
 530   | otherwise
 531   = do { global_tvs <- readMutVar (tcl_tyvars lcl_env)
 532        ; new_g_var  <- newMutVar (global_tvs `unionVarSet` extra_tvs)
 533        ; return (lcl_env { tcl_tyvars = new_g_var
 534                          , tcl_env = extendNameEnvList lcl_type_env tc_ty_things } ) }
 535   where
 536     extra_tvs = foldr get_tvs emptyVarSet tc_ty_things
 537
 538     get_tvs (_, ATcId { tct_id = id, tct_info = closed }) tvs
 539       = case closed of
 540           ClosedLet ->
 541             ASSERT2( isEmptyVarSet id_tvs, ppr id $$ ppr (idType id) ) tvs
 542           _           ->
 543             tvs `unionVarSet` id_tvs
 544         where id_tvs = tyCoVarsOfType (idType id)
 545
 546     get_tvs (_, ATyVar _ tv) tvs          -- See Note [Global TyVars]
 547       = tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv) `extendVarSet` tv
 548
 549     get_tvs (_, ATcTyCon tc) tvs = tvs `unionVarSet` tyCoVarsOfType (tyConKind tc)
 550
 551     get_tvs (_, AGlobal {})       tvs = tvs
 552     get_tvs (_, APromotionErr {}) tvs = tvs
 553
 554         -- Note [Global TyVars]
 555         -- It's important to add the in-scope tyvars to the global tyvar set
 556         -- as well.  Consider
 557         --      f (_::r) = let g y = y::r in ...
 558         -- Here, g mustn't be generalised.  This is also important during
 559         -- class and instance decls, when we mustn't generalise the class tyvars
 560         -- when typechecking the methods.
 561         --
 562         -- Nor must we generalise g over any kind variables free in r's kind
 563
 564
 565 {- *********************************************************************
 566 *                                                                      *
 567              The TcBinderStack
 568 *                                                                      *
 569 ********************************************************************* -}
 570
 571 tcExtendBinderStack :: [TcBinder] -> TcM a -> TcM a
 572 tcExtendBinderStack bndrs thing_inside
 573   = do { traceTc "tcExtendBinderStack" (ppr bndrs)
 574        ; updLclEnv (\env -> env { tcl_bndrs = bndrs ++ tcl_bndrs env })
 575                    thing_inside }
 576
 577 tcInitTidyEnv :: TcM TidyEnv
 578 -- We initialise the "tidy-env", used for tidying types before printing,
 579 -- by building a reverse map from the in-scope type variables to the
 580 -- OccName that the programmer originally used for them
 581 tcInitTidyEnv
 582   = do  { lcl_env <- getLclEnv
 583         ; go emptyTidyEnv (tcl_bndrs lcl_env) }
 584   where
 585     go (env, subst) []
 586       = return (env, subst)
 587     go (env, subst) (b : bs)
 588       | TcTvBndr name tyvar <- b
 589        = do { let (env', occ') = tidyOccName env (nameOccName name)
 590                   name'  = tidyNameOcc name occ'
 591                   tyvar1 = setTyVarName tyvar name'
 592             ; tyvar2 <- zonkTcTyVarToTyVar tyvar1
 593               -- Be sure to zonk here!  Tidying applies to zonked
 594               -- types, so if we don't zonk we may create an
 595               -- ill-kinded type (Trac #14175)
 596             ; go (env', extendVarEnv subst tyvar tyvar2) bs }
 597       | otherwise
 598       = go (env, subst) bs
 599
 600 -- | Get a 'TidyEnv' that includes mappings for all vars free in the given
 601 -- type. Useful when tidying open types.
 602 tcInitOpenTidyEnv :: [TyCoVar] -> TcM TidyEnv
 603 tcInitOpenTidyEnv tvs
 604   = do { env1 <- tcInitTidyEnv
 605        ; let env2 = tidyFreeTyCoVars env1 tvs
 606        ; return env2 }
 607
 608
 609
 610 {- *********************************************************************
 611 *                                                                      *
 612              Adding placeholders
 613 *                                                                      *
 614 ********************************************************************* -}
 615
 616 tcAddDataFamConPlaceholders :: [LInstDecl GhcRn] -> TcM a -> TcM a
 617 -- See Note [AFamDataCon: not promoting data family constructors]
 618 tcAddDataFamConPlaceholders inst_decls thing_inside
 619   = tcExtendKindEnvList [ (con, APromotionErr FamDataConPE)
 620                         | lid <- inst_decls, con <- get_cons lid ]
 621       thing_inside
 622       -- Note [AFamDataCon: not promoting data family constructors]
 623   where
 624     -- get_cons extracts the *constructor* bindings of the declaration
 625     get_cons :: LInstDecl GhcRn -> [Name]
 626     get_cons (L _ (TyFamInstD {}))                     = []
 627     get_cons (L _ (DataFamInstD { dfid_inst = fid }))  = get_fi_cons fid
 628     get_cons (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fids } }))
 629       = concatMap (get_fi_cons . unLoc) fids
 630
 631     get_fi_cons :: DataFamInstDecl GhcRn -> [Name]
 632     get_fi_cons (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
 633                   FamEqn { feqn_rhs = HsDataDefn { dd_cons = cons } }}})
 634       = map unLoc $ concatMap (getConNames . unLoc) cons
 635
 636
 637 tcAddPatSynPlaceholders :: [PatSynBind GhcRn GhcRn] -> TcM a -> TcM a
 638 -- See Note [Don't promote pattern synonyms]
 639 tcAddPatSynPlaceholders pat_syns thing_inside
 640   = tcExtendKindEnvList [ (name, APromotionErr PatSynPE)
 641                         | PSB{ psb_id = L _ name } <- pat_syns ]
 642        thing_inside
 643
 644 getTypeSigNames :: [LSig GhcRn] -> NameSet
 645 -- Get the names that have a user type sig
 646 getTypeSigNames sigs
 647   = foldr get_type_sig emptyNameSet sigs
 648   where
 649     get_type_sig :: LSig GhcRn -> NameSet -> NameSet
 650     get_type_sig sig ns =
 651       case sig of
 652         L _ (TypeSig names _) -> extendNameSetList ns (map unLoc names)
 653         L _ (PatSynSig names _) -> extendNameSetList ns (map unLoc names)
 654         _ -> ns
 655
 656
 657 {- Note [AFamDataCon: not promoting data family constructors]
 658 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 659 Consider
 660   data family T a
 661   data instance T Int = MkT
 662   data Proxy (a :: k)
 663   data S = MkS (Proxy 'MkT)
 664
 665 Is it ok to use the promoted data family instance constructor 'MkT' in
 666 the data declaration for S (where both declarations live in the same module)?
 667 No, we don't allow this. It *might* make sense, but at least it would mean that
 668 we'd have to interleave typechecking instances and data types, whereas at
 669 present we do data types *then* instances.
 670
 671 So to check for this we put in the TcLclEnv a binding for all the family
 672 constructors, bound to AFamDataCon, so that if we trip over 'MkT' when
 673 type checking 'S' we'll produce a decent error message.
 674
 675 Trac #12088 describes this limitation. Of course, when MkT and S live in
 676 different modules then all is well.
 677
 678 Note [Don't promote pattern synonyms]
 679 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 680 We never promote pattern synonyms.
 681
 682 Consider this (Trac #11265):
 683   pattern A = True
 684   instance Eq A
 685 We want a civilised error message from the occurrence of 'A'
 686 in the instance, yet 'A' really has not yet been type checked.
 687
 688 Similarly (Trac #9161)
 689   {-# LANGUAGE PatternSynonyms, DataKinds #-}
 690   pattern A = ()
 691   b :: A
 692   b = undefined
 693 Here, the type signature for b mentions A.  But A is a pattern
 694 synonym, which is typechecked as part of a group of bindings (for very
 695 good reasons; a view pattern in the RHS may mention a value binding).
 696 It is entirely reasonable to reject this, but to do so we need A to be
 697 in the kind environment when kind-checking the signature for B.
 698
 699 Hence tcAddPatSynPlaceholers adds a binding
 700     A -> APromotionErr PatSynPE
 701 to the environment. Then TcHsType.tcTyVar will find A in the kind
 702 environment, and will give a 'wrongThingErr' as a result.  But the
 703 lookup of A won't fail.
 704
 705
 706 ************************************************************************
 707 *                                                                      *
 708 \subsection{Rules}
 709 *                                                                      *
 710 ************************************************************************
 711 -}
 712
 713 tcExtendRules :: [LRuleDecl GhcTc] -> TcM a -> TcM a
 714         -- Just pop the new rules into the EPS and envt resp
 715         -- All the rules come from an interface file, not source
 716         -- Nevertheless, some may be for this module, if we read
 717         -- its interface instead of its source code
 718 tcExtendRules lcl_rules thing_inside
 719  = do { env <- getGblEnv
 720       ; let
 721           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
 722       ; setGblEnv env' thing_inside }
 723
 724 {-
 725 ************************************************************************
 726 *                                                                      *
 727                 Meta level
 728 *                                                                      *
 729 ************************************************************************
 730 -}
 731
 732 checkWellStaged :: SDoc         -- What the stage check is for
 733                 -> ThLevel      -- Binding level (increases inside brackets)
 734                 -> ThLevel      -- Use stage
 735                 -> TcM ()       -- Fail if badly staged, adding an error
 736 checkWellStaged pp_thing bind_lvl use_lvl
 737   | use_lvl >= bind_lvl         -- OK! Used later than bound
 738   = return ()                   -- E.g.  \x -> [| $(f x) |]
 739
 740   | bind_lvl == outerLevel      -- GHC restriction on top level splices
 741   = stageRestrictionError pp_thing
 742
 743   | otherwise                   -- Badly staged
 744   = failWithTc $                -- E.g.  \x -> $(f x)
 745     text "Stage error:" <+> pp_thing <+>
 746         hsep   [text "is bound at stage" <+> ppr bind_lvl,
 747                 text "but used at stage" <+> ppr use_lvl]
 748
 749 stageRestrictionError :: SDoc -> TcM a
 750 stageRestrictionError pp_thing
 751   = failWithTc $
 752     sep [ text "GHC stage restriction:"
 753         , nest 2 (vcat [ pp_thing <+> text "is used in a top-level splice, quasi-quote, or annotation,"
 754                        , text "and must be imported, not defined locally"])]
 755
 756 topIdLvl :: Id -> ThLevel
 757 -- Globals may either be imported, or may be from an earlier "chunk"
 758 -- (separated by declaration splices) of this module.  The former
 759 --  *can* be used inside a top-level splice, but the latter cannot.
 760 -- Hence we give the former impLevel, but the latter topLevel
 761 -- E.g. this is bad:
 762 --      x = [| foo |]
 763 --      $( f x )
 764 -- By the time we are prcessing the $(f x), the binding for "x"
 765 -- will be in the global env, not the local one.
 766 topIdLvl id | isLocalId id = outerLevel
 767             | otherwise    = impLevel
 768
 769 tcMetaTy :: Name -> TcM Type
 770 -- Given the name of a Template Haskell data type,
 771 -- return the type
 772 -- E.g. given the name "Expr" return the type "Expr"
 773 tcMetaTy tc_name = do
 774     t <- tcLookupTyCon tc_name
 775     return (mkTyConApp t [])
 776
 777 isBrackStage :: ThStage -> Bool
 778 isBrackStage (Brack {}) = True
 779 isBrackStage _other     = False
 780
 781 {-
 782 ************************************************************************
 783 *                                                                      *
 784                  getDefaultTys
 785 *                                                                      *
 786 ************************************************************************
 787 -}
 788
 789 tcGetDefaultTys :: TcM ([Type], -- Default types
 790                         (Bool,  -- True <=> Use overloaded strings
 791                          Bool)) -- True <=> Use extended defaulting rules
 792 tcGetDefaultTys
 793   = do  { dflags <- getDynFlags
 794         ; let ovl_strings = xopt LangExt.OverloadedStrings dflags
 795               extended_defaults = xopt LangExt.ExtendedDefaultRules dflags
 796                                         -- See also Trac #1974
 797               flags = (ovl_strings, extended_defaults)
 798
 799         ; mb_defaults <- getDeclaredDefaultTys
 800         ; case mb_defaults of {
 801            Just tys -> return (tys, flags) ;
 802                                 -- User-supplied defaults
 803            Nothing  -> do
 804
 805         -- No use-supplied default
 806         -- Use [Integer, Double], plus modifications
 807         { integer_ty <- tcMetaTy integerTyConName
 808         ; list_ty <- tcMetaTy listTyConName
 809         ; checkWiredInTyCon doubleTyCon
 810         ; let deflt_tys = opt_deflt extended_defaults [unitTy, list_ty]
 811                           -- Note [Extended defaults]
 812                           ++ [integer_ty, doubleTy]
 813                           ++ opt_deflt ovl_strings [stringTy]
 814         ; return (deflt_tys, flags) } } }
 815   where
 816     opt_deflt True  xs = xs
 817     opt_deflt False _  = []
 818
 819 {-
 820 Note [Extended defaults]
 821 ~~~~~~~~~~~~~~~~~~~~~
 822 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
 823 try when defaulting.  This has very little real impact, except in the following case.
 824 Consider:
 825         Text.Printf.printf "hello"
 826 This has type (forall a. IO a); it prints "hello", and returns 'undefined'.  We don't
 827 want the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to
 828 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
 829 and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
 830 () to the list of defaulting types.  See Trac #1200.
 831
 832 Additonally, the list type [] is added as a default specialization for
 833 Traversable and Foldable. As such the default default list now has types of
 834 varying kinds, e.g. ([] :: * -> *)  and (Integer :: *).
 835
 836 ************************************************************************
 837 *                                                                      *
 838 \subsection{The InstInfo type}
 839 *                                                                      *
 840 ************************************************************************
 841
 842 The InstInfo type summarises the information in an instance declaration
 843
 844     instance c => k (t tvs) where b
 845
 846 It is used just for *local* instance decls (not ones from interface files).
 847 But local instance decls includes
 848         - derived ones
 849         - generic ones
 850 as well as explicit user written ones.
 851 -}
 852
 853 data InstInfo a
 854   = InstInfo
 855       { iSpec   :: ClsInst          -- Includes the dfun id
 856       , iBinds  :: InstBindings a
 857       }
 858
 859 iDFunId :: InstInfo a -> DFunId
 860 iDFunId info = instanceDFunId (iSpec info)
 861
 862 data InstBindings a
 863   = InstBindings
 864       { ib_tyvars  :: [Name]   -- Names of the tyvars from the instance head
 865                                -- that are lexically in scope in the bindings
 866                                -- Must correspond 1-1 with the forall'd tyvars
 867                                -- of the dfun Id.  When typechecking, we are
 868                                -- going to extend the typechecker's envt with
 869                                --     ib_tyvars -> dfun_forall_tyvars
 870
 871       , ib_binds   :: LHsBinds a    -- Bindings for the instance methods
 872
 873       , ib_pragmas :: [LSig a]      -- User pragmas recorded for generating
 874                                     -- specialised instances
 875
 876       , ib_extensions :: [LangExt.Extension] -- Any extra extensions that should
 877                                              -- be enabled when type-checking
 878                                              -- this instance; needed for
 879                                              -- GeneralizedNewtypeDeriving
 880
 881       , ib_derived :: Bool
 882            -- True <=> This code was generated by GHC from a deriving clause
 883            --          or standalone deriving declaration
 884            --          Used only to improve error messages
 885       }
 886
 887 instance (SourceTextX a, OutputableBndrId a) => Outputable (InstInfo a) where
 888     ppr = pprInstInfoDetails
 889
 890 pprInstInfoDetails :: (SourceTextX a, OutputableBndrId a) => InstInfo a -> SDoc
 891 pprInstInfoDetails info
 892    = hang (pprInstanceHdr (iSpec info) <+> text "where")
 893         2 (details (iBinds info))
 894   where
 895     details (InstBindings { ib_binds = b }) = pprLHsBinds b
 896
 897 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
 898 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
 899                            (_, cls, [ty]) -> (cls, ty)
 900                            _ -> panic "simpleInstInfoClsTy"
 901
 902 simpleInstInfoTy :: InstInfo a -> Type
 903 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
 904
 905 simpleInstInfoTyCon :: InstInfo a -> TyCon
 906   -- Gets the type constructor for a simple instance declaration,
 907   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 908 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 909
 910 -- | Make a name for the dict fun for an instance decl.  It's an *external*
 911 -- name, like other top-level names, and hence must be made with
 912 -- newGlobalBinder.
 913 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
 914 newDFunName clas tys loc
 915   = do  { is_boot <- tcIsHsBootOrSig
 916         ; mod     <- getModule
 917         ; let info_string = occNameString (getOccName clas) ++
 918                             concatMap (occNameString.getDFunTyKey) tys
 919         ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
 920         ; newGlobalBinder mod dfun_occ loc }
 921
 922 -- | Special case of 'newDFunName' to generate dict fun name for a single TyCon.
 923 newDFunName' :: Class -> TyCon -> TcM Name
 924 newDFunName' clas tycon        -- Just a simple wrapper
 925   = do { loc <- getSrcSpanM     -- The location of the instance decl,
 926                                 -- not of the tycon
 927        ; newDFunName clas [mkTyConApp tycon []] loc }
 928        -- The type passed to newDFunName is only used to generate
 929        -- a suitable string; hence the empty type arg list
 930
 931 {-
 932 Make a name for the representation tycon of a family instance.  It's an
 933 *external* name, like other top-level names, and hence must be made with
 934 newGlobalBinder.
 935 -}
 936
 937 newFamInstTyConName :: Located Name -> [Type] -> TcM Name
 938 newFamInstTyConName (L loc name) tys = mk_fam_inst_name id loc name [tys]
 939
 940 newFamInstAxiomName :: Located Name -> [[Type]] -> TcM Name
 941 newFamInstAxiomName (L loc name) branches
 942   = mk_fam_inst_name mkInstTyCoOcc loc name branches
 943
 944 mk_fam_inst_name :: (OccName -> OccName) -> SrcSpan -> Name -> [[Type]] -> TcM Name
 945 mk_fam_inst_name adaptOcc loc tc_name tyss
 946   = do  { mod   <- getModule
 947         ; let info_string = occNameString (getOccName tc_name) ++
 948                             intercalate "|" ty_strings
 949         ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
 950         ; newGlobalBinder mod (adaptOcc occ) loc }
 951   where
 952     ty_strings = map (concatMap (occNameString . getDFunTyKey)) tyss
 953
 954 {-
 955 Stable names used for foreign exports and annotations.
 956 For stable names, the name must be unique (see #1533).  If the
 957 same thing has several stable Ids based on it, the
 958 top-level bindings generated must not have the same name.
 959 Hence we create an External name (doesn't change), and we
 960 append a Unique to the string right here.
 961 -}
 962
 963 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 964 mkStableIdFromString str sig_ty loc occ_wrapper = do
 965     uniq <- newUnique
 966     mod <- getModule
 967     name <- mkWrapperName "stable" str
 968     let occ = mkVarOccFS name :: OccName
 969         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
 970         id  = mkExportedVanillaId gnm sig_ty :: Id
 971     return id
 972
 973 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 974 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
 975
 976 mkWrapperName :: (MonadIO m, HasDynFlags m, HasModule m)
 977               => String -> String -> m FastString
 978 mkWrapperName what nameBase
 979     = do dflags <- getDynFlags
 980          thisMod <- getModule
 981          let -- Note [Generating fresh names for ccall wrapper]
 982              wrapperRef = nextWrapperNum dflags
 983              pkg = unitIdString  (moduleUnitId thisMod)
 984              mod = moduleNameString (moduleName      thisMod)
 985          wrapperNum <- liftIO $ atomicModifyIORef' wrapperRef $ \mod_env ->
 986              let num = lookupWithDefaultModuleEnv mod_env 0 thisMod
 987                  mod_env' = extendModuleEnv mod_env thisMod (num+1)
 988              in (mod_env', num)
 989          let components = [what, show wrapperNum, pkg, mod, nameBase]
 990          return $ mkFastString $ zEncodeString $ intercalate ":" components
 991
 992 {-
 993 Note [Generating fresh names for FFI wrappers]
 994
 995 We used to use a unique, rather than nextWrapperNum, to distinguish
 996 between FFI wrapper functions. However, the wrapper names that we
 997 generate are external names. This means that if a call to them ends up
 998 in an unfolding, then we can't alpha-rename them, and thus if the
 999 unique randomly changes from one compile to another then we get a
1000 spurious ABI change (#4012).
1001
1002 The wrapper counter has to be per-module, not global, so that the number we end
1003 up using is not dependent on the modules compiled before the current one.
1004 -}
1005
1006 {-
1007 ************************************************************************
1008 *                                                                      *
1009 \subsection{Errors}
1010 *                                                                      *
1011 ************************************************************************
1012 -}
1013
1014 pprBinders :: [Name] -> SDoc
1015 -- Used in error messages
1016 -- Use quotes for a single one; they look a bit "busy" for several
1017 pprBinders [bndr] = quotes (ppr bndr)
1018 pprBinders bndrs  = pprWithCommas ppr bndrs
1019
1020 notFound :: Name -> TcM TyThing
1021 notFound name
1022   = do { lcl_env <- getLclEnv
1023        ; let stage = tcl_th_ctxt lcl_env
1024        ; case stage of   -- See Note [Out of scope might be a staging error]
1025            Splice {}
1026              | isUnboundName name -> failM  -- If the name really isn't in scope
1027                                             -- don't report it again (Trac #11941)
1028              | otherwise -> stageRestrictionError (quotes (ppr name))
1029            _ -> failWithTc $
1030                 vcat[text "GHC internal error:" <+> quotes (ppr name) <+>
1031                      text "is not in scope during type checking, but it passed the renamer",
1032                      text "tcl_env of environment:" <+> ppr (tcl_env lcl_env)]
1033                        -- Take care: printing the whole gbl env can
1034                        -- cause an infinite loop, in the case where we
1035                        -- are in the middle of a recursive TyCon/Class group;
1036                        -- so let's just not print it!  Getting a loop here is
1037                        -- very unhelpful, because it hides one compiler bug with another
1038        }
1039
1040 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
1041 -- It's important that this only calls pprTcTyThingCategory, which in
1042 -- turn does not look at the details of the TcTyThing.
1043 -- See Note [Placeholder PatSyn kinds] in TcBinds
1044 wrongThingErr expected thing name
1045   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
1046                 text "used as a" <+> text expected)
1047
1048 {- Note [Out of scope might be a staging error]
1049 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1050 Consider
1051   x = 3
1052   data T = MkT $(foo x)
1053
1054 where 'foo' is imported from somewhere.
1055
1056 This is really a staging error, because we can't run code involving 'x'.
1057 But in fact the type checker processes types first, so 'x' won't even be
1058 in the type envt when we look for it in $(foo x).  So inside splices we
1059 report something missing from the type env as a staging error.
1060 See Trac #5752 and #5795.
1061 -}