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