never executed always true always false
    1 module GHC.Runtime.Context
    2    ( InteractiveContext (..)
    3    , InteractiveImport (..)
    4    , emptyInteractiveContext
    5    , extendInteractiveContext
    6    , extendInteractiveContextWithIds
    7    , setInteractivePrintName
    8    , substInteractiveContext
    9    , replaceImportEnv
   10    , icReaderEnv
   11    , icInteractiveModule
   12    , icInScopeTTs
   13    , icPrintUnqual
   14    )
   15 where
   16 
   17 import GHC.Prelude
   18 
   19 import GHC.Hs
   20 
   21 import GHC.Driver.Session
   22 import {-# SOURCE #-} GHC.Driver.Plugins
   23 
   24 import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume )
   25 
   26 import GHC.Unit
   27 import GHC.Unit.Env
   28 
   29 import GHC.Core.FamInstEnv
   30 import GHC.Core.InstEnv ( ClsInst, identicalClsInstHead )
   31 import GHC.Core.Type
   32 
   33 import GHC.Types.Avail
   34 import GHC.Types.Fixity.Env
   35 import GHC.Types.Id ( isRecordSelector )
   36 import GHC.Types.Id.Info ( IdDetails(..) )
   37 import GHC.Types.Name
   38 import GHC.Types.Name.Env
   39 import GHC.Types.Name.Reader
   40 import GHC.Types.Name.Ppr
   41 import GHC.Types.TyThing
   42 import GHC.Types.Var
   43 
   44 import GHC.Builtin.Names ( ioTyConName, printName, mkInteractiveModule )
   45 
   46 import GHC.Utils.Outputable
   47 import GHC.Utils.Misc
   48 
   49 {-
   50 Note [The interactive package]
   51 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   52 Type, class, and value declarations at the command prompt are treated
   53 as if they were defined in modules
   54    interactive:Ghci1
   55    interactive:Ghci2
   56    ...etc...
   57 with each bunch of declarations using a new module, all sharing a
   58 common package 'interactive' (see Module.interactiveUnitId, and
   59 GHC.Builtin.Names.mkInteractiveModule).
   60 
   61 This scheme deals well with shadowing.  For example:
   62 
   63    ghci> data T = A
   64    ghci> data T = B
   65    ghci> :i A
   66    data Ghci1.T = A  -- Defined at <interactive>:2:10
   67 
   68 Here we must display info about constructor A, but its type T has been
   69 shadowed by the second declaration.  But it has a respectable
   70 qualified name (Ghci1.T), and its source location says where it was
   71 defined.
   72 
   73 So the main invariant continues to hold, that in any session an
   74 original name M.T only refers to one unique thing.  (In a previous
   75 iteration both the T's above were called :Interactive.T, albeit with
   76 different uniques, which gave rise to all sorts of trouble.)
   77 
   78 The details are a bit tricky though:
   79 
   80  * The field ic_mod_index counts which Ghci module we've got up to.
   81    It is incremented when extending ic_tythings
   82 
   83  * ic_tythings contains only things from the 'interactive' package.
   84 
   85  * Module from the 'interactive' package (Ghci1, Ghci2 etc) never go
   86    in the Home Package Table (HPT).  When you say :load, that's when we
   87    extend the HPT.
   88 
   89  * The 'homeUnitId' field of DynFlags is *not* set to 'interactive'.
   90    It stays as 'main' (or whatever -this-unit-id says), and is the
   91    package to which :load'ed modules are added to.
   92 
   93  * So how do we arrange that declarations at the command prompt get to
   94    be in the 'interactive' package?  Simply by setting the tcg_mod
   95    field of the TcGblEnv to "interactive:Ghci1".  This is done by the
   96    call to initTc in initTcInteractive, which in turn get the module
   97    from it 'icInteractiveModule' field of the interactive context.
   98 
   99    The 'homeUnitId' field stays as 'main' (or whatever -this-unit-id says.
  100 
  101  * The main trickiness is that the type environment (tcg_type_env) and
  102    fixity envt (tcg_fix_env), now contain entities from all the
  103    interactive-package modules (Ghci1, Ghci2, ...) together, rather
  104    than just a single module as is usually the case.  So you can't use
  105    "nameIsLocalOrFrom" to decide whether to look in the TcGblEnv vs
  106    the HPT/PTE.  This is a change, but not a problem provided you
  107    know.
  108 
  109 * However, the tcg_binds, tcg_sigs, tcg_insts, tcg_fam_insts, etc fields
  110   of the TcGblEnv, which collect "things defined in this module", all
  111   refer to stuff define in a single GHCi command, *not* all the commands
  112   so far.
  113 
  114   In contrast, tcg_inst_env, tcg_fam_inst_env, have instances from
  115   all GhciN modules, which makes sense -- they are all "home package"
  116   modules.
  117 
  118 
  119 Note [Interactively-bound Ids in GHCi]
  120 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  121 The Ids bound by previous Stmts in GHCi are currently
  122         a) GlobalIds, with
  123         b) An External Name, like Ghci4.foo
  124            See Note [The interactive package] above
  125         c) A tidied type
  126 
  127  (a) They must be GlobalIds (not LocalIds) otherwise when we come to
  128      compile an expression using these ids later, the byte code
  129      generator will consider the occurrences to be free rather than
  130      global.
  131 
  132  (b) Having an External Name is important because of Note
  133      [GlobalRdrEnv shadowing] in GHC.Types.Names.RdrName
  134 
  135  (c) Their types are tidied. This is important, because :info may ask
  136      to look at them, and :info expects the things it looks up to have
  137      tidy types
  138 
  139 Where do interactively-bound Ids come from?
  140 
  141   - GHCi REPL Stmts   e.g.
  142          ghci> let foo x = x+1
  143     These start with an Internal Name because a Stmt is a local
  144     construct, so the renamer naturally builds an Internal name for
  145     each of its binders.  Then in tcRnStmt they are externalised via
  146     GHC.Tc.Module.externaliseAndTidyId, so they get Names like Ghic4.foo.
  147 
  148   - Ids bound by the debugger etc have Names constructed by
  149     GHC.Iface.Env.newInteractiveBinder; at the call sites it is followed by
  150     mkVanillaGlobal or mkVanillaGlobalWithInfo.  So again, they are
  151     all Global, External.
  152 
  153   - TyCons, Classes, and Ids bound by other top-level declarations in
  154     GHCi (eg foreign import, record selectors) also get External
  155     Names, with Ghci9 (or 8, or 7, etc) as the module name.
  156 
  157 
  158 Note [ic_tythings]
  159 ~~~~~~~~~~~~~~~~~~
  160 The ic_tythings field contains
  161   * The TyThings declared by the user at the command prompt
  162     (eg Ids, TyCons, Classes)
  163 
  164   * The user-visible Ids that arise from such things, which
  165     *don't* come from 'implicitTyThings', notably:
  166        - record selectors
  167        - class ops
  168     The implicitTyThings are readily obtained from the TyThings
  169     but record selectors etc are not
  170 
  171 It does *not* contain
  172   * DFunIds (they can be gotten from ic_instances)
  173   * CoAxioms (ditto)
  174 
  175 See also Note [Interactively-bound Ids in GHCi]
  176 
  177 Note [Override identical instances in GHCi]
  178 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  179 If you declare a new instance in GHCi that is identical to a previous one,
  180 we simply override the previous one; we don't regard it as overlapping.
  181 e.g.    Prelude> data T = A | B
  182         Prelude> instance Eq T where ...
  183         Prelude> instance Eq T where ...   -- This one overrides
  184 
  185 It's exactly the same for type-family instances.  See #7102
  186 
  187 Note [icReaderEnv recalculation]
  188 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  189 The GlobalRdrEnv describing what’s in scope at the prompts consists
  190 of all the imported things, followed by all the things defined on the prompt, with
  191 shadowing. Defining new things on the prompt is easy: we shadow as needed and then extend the environment.  But changing the set of imports, which can happen later as well,
  192 is tricky: we need to re-apply the shadowing from all the things defined at the prompt!
  193 
  194 For example:
  195 
  196     ghci> let empty = True
  197     ghci> import Data.IntMap.Strict     -- Exports 'empty'
  198     ghci> empty   -- Still gets the 'empty' defined at the prompt
  199     True
  200 
  201 
  202 It would be correct ot re-construct the env from scratch based on
  203 `ic_tythings`, but that'd be quite expensive if there are many entires in
  204 `ic_tythings` that shadow each other.
  205 
  206 Therefore we keep around a that `GlobalRdrEnv` in `igre_prompt_env` that
  207 contians _just_ the things defined at the prompt, and use that in
  208 `replaceImportEnv` to rebuild the full env.  Conveniently, `shadowNames` takes
  209 such an `OccEnv` to denote the set of names to shadow.
  210 
  211 INVARIANT: Every `OccName` in `igre_prompt_env` is present unqualified as well
  212 (else it would not be right to use pass `igre_prompt_env` to `shadowNames`.)
  213 
  214 The definition of the IcGlobalRdrEnv type should conceptually be in this module, and
  215 made abstract, but it’s used in `Resume`, so it lives in GHC.Runtime.Eval.Type.
  216 -
  217 -}
  218 
  219 -- | Interactive context, recording information about the state of the
  220 -- context in which statements are executed in a GHCi session.
  221 data InteractiveContext
  222   = InteractiveContext {
  223          ic_dflags     :: DynFlags,
  224              -- ^ The 'DynFlags' used to evaluate interactive expressions
  225              -- and statements.
  226 
  227          ic_mod_index :: Int,
  228              -- ^ Each GHCi stmt or declaration brings some new things into
  229              -- scope. We give them names like interactive:Ghci9.T,
  230              -- where the ic_index is the '9'.  The ic_mod_index is
  231              -- incremented whenever we add something to ic_tythings
  232              -- See Note [The interactive package]
  233 
  234          ic_imports :: [InteractiveImport],
  235              -- ^ The GHCi top-level scope (icReaderEnv) is extended with
  236              -- these imports
  237              --
  238              -- This field is only stored here so that the client
  239              -- can retrieve it with GHC.getContext. GHC itself doesn't
  240              -- use it, but does reset it to empty sometimes (such
  241              -- as before a GHC.load). The context is set with GHC.setContext.
  242 
  243          ic_tythings   :: [TyThing],
  244              -- ^ TyThings defined by the user, in reverse order of
  245              -- definition (ie most recent at the front)
  246              -- See Note [ic_tythings]
  247 
  248          ic_gre_cache :: IcGlobalRdrEnv,
  249              -- ^ Essentially the cached 'GlobalRdrEnv'.
  250              --
  251              -- The GlobalRdrEnv contains everything in scope at the command
  252              -- line, both imported and everything in ic_tythings, with the
  253              -- correct shadowing.
  254              --
  255              -- The IcGlobalRdrEnv contains extra data to allow efficient
  256              -- recalculation when the set of imports change.
  257              -- See Note [icReaderEnv recalculation]
  258 
  259          ic_instances  :: ([ClsInst], [FamInst]),
  260              -- ^ All instances and family instances created during
  261              -- this session.  These are grabbed en masse after each
  262              -- update to be sure that proper overlapping is retained.
  263              -- That is, rather than re-check the overlapping each
  264              -- time we update the context, we just take the results
  265              -- from the instance code that already does that.
  266 
  267          ic_fix_env :: FixityEnv,
  268             -- ^ Fixities declared in let statements
  269 
  270          ic_default :: Maybe [Type],
  271              -- ^ The current default types, set by a 'default' declaration
  272 
  273          ic_resume :: [Resume],
  274              -- ^ The stack of breakpoint contexts
  275 
  276          ic_monad      :: Name,
  277              -- ^ The monad that GHCi is executing in
  278 
  279          ic_int_print  :: Name,
  280              -- ^ The function that is used for printing results
  281              -- of expressions in ghci and -e mode.
  282 
  283          ic_cwd :: Maybe FilePath,
  284              -- ^ virtual CWD of the program
  285 
  286          ic_plugins :: ![LoadedPlugin]
  287              -- ^ Cache of loaded plugins. We store them here to avoid having to
  288              -- load them everytime we switch to the interctive context.
  289     }
  290 
  291 data InteractiveImport
  292   = IIDecl (ImportDecl GhcPs)
  293       -- ^ Bring the exports of a particular module
  294       -- (filtered by an import decl) into scope
  295 
  296   | IIModule ModuleName
  297       -- ^ Bring into scope the entire top-level envt of
  298       -- of this module, including the things imported
  299       -- into it.
  300 
  301 emptyIcGlobalRdrEnv :: IcGlobalRdrEnv
  302 emptyIcGlobalRdrEnv = IcGlobalRdrEnv
  303     { igre_env = emptyGlobalRdrEnv
  304     , igre_prompt_env = emptyGlobalRdrEnv
  305     }
  306 
  307 -- | Constructs an empty InteractiveContext.
  308 emptyInteractiveContext :: DynFlags -> InteractiveContext
  309 emptyInteractiveContext dflags
  310   = InteractiveContext {
  311        ic_dflags     = dflags,
  312        ic_imports    = [],
  313        ic_gre_cache  = emptyIcGlobalRdrEnv,
  314        ic_mod_index  = 1,
  315        ic_tythings   = [],
  316        ic_instances  = ([],[]),
  317        ic_fix_env    = emptyNameEnv,
  318        ic_monad      = ioTyConName,  -- IO monad by default
  319        ic_int_print  = printName,    -- System.IO.print by default
  320        ic_default    = Nothing,
  321        ic_resume     = [],
  322        ic_cwd        = Nothing,
  323        ic_plugins    = []
  324        }
  325 
  326 icReaderEnv :: InteractiveContext -> GlobalRdrEnv
  327 icReaderEnv = igre_env . ic_gre_cache
  328 
  329 icInteractiveModule :: InteractiveContext -> Module
  330 icInteractiveModule (InteractiveContext { ic_mod_index = index })
  331   = mkInteractiveModule index
  332 
  333 -- | This function returns the list of visible TyThings (useful for
  334 -- e.g. showBindings)
  335 icInScopeTTs :: InteractiveContext -> [TyThing]
  336 icInScopeTTs = ic_tythings
  337 
  338 -- | Get the PrintUnqualified function based on the flags and this InteractiveContext
  339 icPrintUnqual :: UnitEnv -> InteractiveContext -> PrintUnqualified
  340 icPrintUnqual unit_env ictxt = mkPrintUnqualified unit_env (icReaderEnv ictxt)
  341 
  342 -- | extendInteractiveContext is called with new TyThings recently defined to update the
  343 -- InteractiveContext to include them.  Ids are easily removed when shadowed,
  344 -- but Classes and TyCons are not.  Some work could be done to determine
  345 -- whether they are entirely shadowed, but as you could still have references
  346 -- to them (e.g. instances for classes or values of the type for TyCons), it's
  347 -- not clear whether removing them is even the appropriate behavior.
  348 extendInteractiveContext :: InteractiveContext
  349                          -> [TyThing]
  350                          -> [ClsInst] -> [FamInst]
  351                          -> Maybe [Type]
  352                          -> FixityEnv
  353                          -> InteractiveContext
  354 extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults fix_env
  355   = ictxt { ic_mod_index  = ic_mod_index ictxt + 1
  356                             -- Always bump this; even instances should create
  357                             -- a new mod_index (#9426)
  358           , ic_tythings   = new_tythings ++ old_tythings
  359           , ic_gre_cache  = ic_gre_cache  ictxt `icExtendIcGblRdrEnv` new_tythings
  360           , ic_instances  = ( new_cls_insts ++ old_cls_insts
  361                             , new_fam_insts ++ fam_insts )
  362                             -- we don't shadow old family instances (#7102),
  363                             -- so don't need to remove them here
  364           , ic_default    = defaults
  365           , ic_fix_env    = fix_env  -- See Note [Fixity declarations in GHCi]
  366           }
  367   where
  368     new_ids = [id | AnId id <- new_tythings]
  369     old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
  370 
  371     -- Discard old instances that have been fully overridden
  372     -- See Note [Override identical instances in GHCi]
  373     (cls_insts, fam_insts) = ic_instances ictxt
  374     old_cls_insts = filterOut (\i -> any (identicalClsInstHead i) new_cls_insts) cls_insts
  375 
  376 extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
  377 -- Just a specialised version
  378 extendInteractiveContextWithIds ictxt new_ids
  379   | null new_ids = ictxt
  380   | otherwise
  381   = ictxt { ic_mod_index  = ic_mod_index ictxt + 1
  382           , ic_tythings   = new_tythings ++ old_tythings
  383           , ic_gre_cache  = ic_gre_cache ictxt `icExtendIcGblRdrEnv` new_tythings
  384           }
  385   where
  386     new_tythings = map AnId new_ids
  387     old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
  388 
  389 shadowed_by :: [Id] -> TyThing -> Bool
  390 shadowed_by ids = shadowed
  391   where
  392     -- Keep record selectors because they might be needed by HasField (#19322)
  393     shadowed (AnId id) | isRecordSelector id = False
  394     shadowed tything = getOccName tything `elemOccSet` new_occs
  395     new_occs = mkOccSet (map getOccName ids)
  396 
  397 setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
  398 setInteractivePrintName ic n = ic{ic_int_print = n}
  399 
  400 icExtendIcGblRdrEnv :: IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
  401 icExtendIcGblRdrEnv igre tythings = IcGlobalRdrEnv
  402     { igre_env = igre_env igre `icExtendGblRdrEnv` tythings
  403     , igre_prompt_env = igre_prompt_env igre `icExtendGblRdrEnv` tythings
  404     }
  405 
  406 -- This is used by setContext in GHC.Runtime.Eval when the set of imports
  407 -- changes, and recalculates the GlobalRdrEnv. See Note [icReaderEnv recalculation]
  408 replaceImportEnv :: IcGlobalRdrEnv -> GlobalRdrEnv -> IcGlobalRdrEnv
  409 replaceImportEnv igre import_env = igre { igre_env = new_env }
  410   where
  411     import_env_shadowed = import_env `shadowNames` igre_prompt_env igre
  412     new_env = import_env_shadowed `plusGlobalRdrEnv` igre_prompt_env igre
  413 
  414 -- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing
  415 -- later ones, and shadowing existing entries in the GlobalRdrEnv.
  416 icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
  417 icExtendGblRdrEnv env tythings
  418   = foldr add env tythings  -- Foldr makes things in the front of
  419                             -- the list shadow things at the back
  420   where
  421     -- One at a time, to ensure each shadows the previous ones
  422     add thing env
  423        | is_sub_bndr thing
  424        = env
  425        | otherwise
  426        = foldl' extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail)
  427        where
  428           new_gres = concatMap availGreNames avail
  429           new_occs = occSetToEnv (mkOccSet (map occName new_gres))
  430           env1  = shadowNames env new_occs
  431           avail = tyThingAvailInfo thing
  432 
  433     -- Ugh! The new_tythings may include record selectors, since they
  434     -- are not implicit-ids, and must appear in the TypeEnv.  But they
  435     -- will also be brought into scope by the corresponding (ATyCon
  436     -- tc).  And we want the latter, because that has the correct
  437     -- parent (#10520)
  438     is_sub_bndr (AnId f) = case idDetails f of
  439                              RecSelId {}  -> True
  440                              ClassOpId {} -> True
  441                              _            -> False
  442     is_sub_bndr _ = False
  443 
  444 substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext
  445 substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
  446   | isEmptyTCvSubst subst = ictxt
  447   | otherwise             = ictxt { ic_tythings = map subst_ty tts }
  448   where
  449     subst_ty (AnId id)
  450       = AnId $ updateIdTypeAndMult (substTyAddInScope subst) id
  451       -- Variables in the interactive context *can* mention free type variables
  452       -- because of the runtime debugger. Otherwise you'd expect all
  453       -- variables bound in the interactive context to be closed.
  454     subst_ty tt
  455       = tt
  456 
  457 instance Outputable InteractiveImport where
  458   ppr (IIModule m) = char '*' <> ppr m
  459   ppr (IIDecl d)   = ppr d