Commit 73c08ab1 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Re-work the naming story for the GHCi prompt (Trac #8649)

The basic idea here is simple, and described in Note [The interactive package]
in HscTypes, which starts thus:

    Note [The interactive package]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Type and class declarations at the command prompt are treated as if
    they were defined in modules
       interactive:Ghci1
       interactive:Ghci2
       ...etc...
    with each bunch of declarations using a new module, all sharing a
    common package 'interactive' (see Module.interactivePackageId, and
    PrelNames.mkInteractiveModule).

    This scheme deals well with shadowing.  For example:

       ghci> data T = A
       ghci> data T = B
       ghci> :i A
       data Ghci1.T = A  -- Defined at <interactive>:2:10

    Here we must display info about constructor A, but its type T has been
    shadowed by the second declaration.  But it has a respectable
    qualified name (Ghci1.T), and its source location says where it was
    defined.

    So the main invariant continues to hold, that in any session an original
    name M.T only refers to oe unique thing.  (In a previous iteration both
    the T's above were called :Interactive.T, albeit with different uniques,
    which gave rise to all sorts of trouble.)

This scheme deals nicely with the original problem.  It allows us to
eliminate a couple of grotseque hacks
  - Note [Outputable Orig RdrName] in HscTypes
  - Note [interactive name cache] in IfaceEnv
(both these comments have gone, because the hacks they describe are no
longer necessary). I was also able to simplify Outputable.QueryQualifyName,
so that it takes a Module/OccName as args rather than a Name.

However, matters are never simple, and this change took me an
unreasonably long time to get right.  There are some details in
Note [The interactive package] in HscTypes.
parent 322b48b9
......@@ -41,6 +41,7 @@ module Module
dphParPackageId,
mainPackageId,
thisGhcPackageId,
interactivePackageId, isInteractiveModule,
-- * The Module type
Module,
......@@ -357,20 +358,24 @@ packageIdString = unpackFS . packageIdFS
integerPackageId, primPackageId,
basePackageId, rtsPackageId,
thPackageId, dphSeqPackageId, dphParPackageId,
mainPackageId, thisGhcPackageId :: PackageId
primPackageId = fsToPackageId (fsLit "ghc-prim")
integerPackageId = fsToPackageId (fsLit cIntegerLibrary)
basePackageId = fsToPackageId (fsLit "base")
rtsPackageId = fsToPackageId (fsLit "rts")
thPackageId = fsToPackageId (fsLit "template-haskell")
dphSeqPackageId = fsToPackageId (fsLit "dph-seq")
dphParPackageId = fsToPackageId (fsLit "dph-par")
thisGhcPackageId = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
mainPackageId, thisGhcPackageId, interactivePackageId :: PackageId
primPackageId = fsToPackageId (fsLit "ghc-prim")
integerPackageId = fsToPackageId (fsLit cIntegerLibrary)
basePackageId = fsToPackageId (fsLit "base")
rtsPackageId = fsToPackageId (fsLit "rts")
thPackageId = fsToPackageId (fsLit "template-haskell")
dphSeqPackageId = fsToPackageId (fsLit "dph-seq")
dphParPackageId = fsToPackageId (fsLit "dph-par")
thisGhcPackageId = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
interactivePackageId = fsToPackageId (fsLit "interactive")
-- | This is the package Id for the current program. It is the default
-- package Id if you don't specify a package name. We don't add this prefix
-- to symbol names, since there can be only one main package per program.
mainPackageId = fsToPackageId (fsLit "main")
isInteractiveModule :: Module -> Bool
isInteractiveModule mod = modulePackageId mod == interactivePackageId
\end{code}
%************************************************************************
......
......@@ -442,17 +442,17 @@ instance OutputableBndr Name where
pprName :: Name -> SDoc
pprName n@(Name {n_sort = sort, n_uniq = u, n_occ = occ})
pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
= getPprStyle $ \ sty ->
case sort of
WiredIn mod _ builtin -> pprExternal sty uniq mod occ n True builtin
External mod -> pprExternal sty uniq mod occ n False UserSyntax
WiredIn mod _ builtin -> pprExternal sty uniq mod occ True builtin
External mod -> pprExternal sty uniq mod occ False UserSyntax
System -> pprSystem sty uniq occ
Internal -> pprInternal sty uniq occ
where uniq = mkUniqueGrimily (iBox u)
pprExternal :: PprStyle -> Unique -> Module -> OccName -> Name -> Bool -> BuiltInSyntax -> SDoc
pprExternal sty uniq mod occ name is_wired is_builtin
pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal sty uniq mod occ is_wired is_builtin
| codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
-- In code style, always qualify
-- ToDo: maybe we could print all wired-in things unqualified
......@@ -462,7 +462,7 @@ pprExternal sty uniq mod occ name is_wired is_builtin
pprNameSpaceBrief (occNameSpace occ),
pprUnique uniq])
| BuiltInSyntax <- is_builtin = ppr_occ_name occ -- Never qualify builtin syntax
| otherwise = pprModulePrefix sty mod name <> ppr_occ_name occ
| otherwise = pprModulePrefix sty mod occ <> ppr_occ_name occ
where
pp_mod = sdocWithDynFlags $ \dflags ->
if gopt Opt_SuppressModulePrefixes dflags
......@@ -491,14 +491,14 @@ pprSystem sty uniq occ
-- so print the unique
pprModulePrefix :: PprStyle -> Module -> Name -> SDoc
pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
-- Print the "M." part of a name, based on whether it's in scope or not
-- See Note [Printing original names] in HscTypes
pprModulePrefix sty mod name = sdocWithDynFlags $ \dflags ->
pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
if gopt Opt_SuppressModulePrefixes dflags
then empty
else
case qualName sty name of -- See Outputable.QualifyName:
case qualName sty mod occ of -- See Outputable.QualifyName:
NameQual modname -> ppr modname <> dot -- Name is in scope
NameNotInScope1 -> ppr mod <> dot -- Not in scope
NameNotInScope2 -> ppr (modulePackageId mod) <> colon -- Module not in
......
......@@ -265,9 +265,7 @@ instance Outputable RdrName where
ppr (Exact name) = ppr name
ppr (Unqual occ) = ppr occ
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod name <> ppr occ)
where name = mkExternalName (mkUniqueGrimily 0) mod occ noSrcSpan
-- Note [Outputable Orig RdrName] in HscTypes
ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
instance OutputableBndr RdrName where
pprBndr _ n
......
......@@ -34,7 +34,6 @@ import NameEnv
import Rules
import BasicTypes ( Activation(.. ) )
import CoreMonad ( endPass, CoreToDo(..) )
import PrelNames ( iNTERACTIVE )
import FastString
import ErrUtils
import Outputable
......@@ -232,7 +231,7 @@ deSugarExpr hsc_env tc_expr
; showPass dflags "Desugar"
-- Do desugaring
; (msgs, mb_core_expr) <- initDs hsc_env iNTERACTIVE rdr_env
; (msgs, mb_core_expr) <- initDs hsc_env (icInteractiveModule icntxt) rdr_env
type_env fam_inst_env $
dsLExpr tc_expr
......
......@@ -52,7 +52,6 @@ import FastString
import Config
import Platform
import SysTools
import PrelNames
-- Standard libraries
import Control.Monad
......@@ -525,27 +524,26 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
-- Find all the packages and linkables that a set of modules depends on
= do {
-- 1. Find the dependent home-pkg-modules/packages from each iface
-- (omitting iINTERACTIVE, which is already linked)
(mods_s, pkgs_s) <- follow_deps (filter ((/=) iNTERACTIVE) mods)
-- (omitting modules from the interactive package, which is already linked)
; (mods_s, pkgs_s) <- follow_deps (filterOut isInteractiveModule mods)
emptyUniqSet emptyUniqSet;
let {
; let {
-- 2. Exclude ones already linked
-- Main reason: avoid findModule calls in get_linkable
mods_needed = mods_s `minusList` linked_mods ;
pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
linked_mods = map (moduleName.linkableModule)
(objs_loaded pls ++ bcos_loaded pls)
} ;
(objs_loaded pls ++ bcos_loaded pls) }
-- 3. For each dependent module, find its linkable
-- This will either be in the HPT or (in the case of one-shot
-- compilation) we may need to use maybe_getFileLinkable
let { osuf = objectSuf dflags } ;
lnks_needed <- mapM (get_linkable osuf) mods_needed ;
; let { osuf = objectSuf dflags }
; lnks_needed <- mapM (get_linkable osuf) mods_needed
return (lnks_needed, pkgs_needed) }
; return (lnks_needed, pkgs_needed) }
where
dflags = hsc_dflags hsc_env
this_pkg = thisPackage dflags
......
......@@ -569,7 +569,11 @@ runTR hsc_env thing = do
Just x -> return x
runTR_maybe :: HscEnv -> TR a -> IO (Maybe a)
runTR_maybe hsc_env = fmap snd . initTc hsc_env HsSrcFile False iNTERACTIVE
runTR_maybe hsc_env thing_inside
= do { (_errs, res) <- initTc hsc_env HsSrcFile False
(icInteractiveModule (hsc_IC hsc_env))
thing_inside
; return res }
traceTR :: SDoc -> TR ()
traceTR = liftTcM . traceOptTcRn Opt_D_dump_rtti
......
......@@ -110,12 +110,14 @@ allocateGlobalBinder name_supply mod occ loc
-- Their wired-in-ness is in their NameSort
-- and their Module is correct.
Just name | isWiredInName name -> (name_supply, name)
| mod /= iNTERACTIVE -> (new_name_supply, name')
-- Note [interactive name cache]
Just name | isWiredInName name
-> (name_supply, name)
| otherwise
-> (new_name_supply, name')
where
uniq = nameUnique name
name' = mkExternalName uniq mod occ loc
-- name' is like name, but with the right SrcSpan
new_cache = extendNameCache (nsNames name_supply) mod occ name'
new_name_supply = name_supply {nsNames = new_cache}
......@@ -128,16 +130,6 @@ allocateGlobalBinder name_supply mod occ loc
new_cache = extendNameCache (nsNames name_supply) mod occ name
new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
{- Note [interactive name cache]
In GHCi we always create Names with the same Module, ":Interactive".
However, we want to be able to shadow older declarations with newer
ones, and we don't want the Name cache giving us back the same Unique
for the new Name as for the old, hence this special case.
See also Note [Outputable Orig RdrName] in HscTypes.
-}
newImplicitBinder :: Name -- Base name
-> (OccName -> OccName) -- Occurrence name modifier
-> TcRnIf m n Name -- Implicit name
......
......@@ -404,7 +404,7 @@ strDisplayName_llvm lbl = do
dflags <- getDynFlags
let sdoc = pprCLabel platform lbl
depth = Outp.PartWay 1
style = Outp.mkUserStyle (const Outp.NameNotInScope2, const True) depth
style = Outp.mkUserStyle (\ _ _ -> Outp.NameNotInScope2, Outp.alwaysQualifyModules) depth
str = Outp.renderWithStyle dflags sdoc style
return (fsLit (dropInfoSuffix str))
......@@ -422,7 +422,7 @@ strProcedureName_llvm lbl = do
dflags <- getDynFlags
let sdoc = pprCLabel platform lbl
depth = Outp.PartWay 1
style = Outp.mkUserStyle (const Outp.NameUnqual, const False) depth
style = Outp.mkUserStyle Outp.neverQualify depth
str = Outp.renderWithStyle dflags sdoc style
return (fsLit str)
......
......@@ -5,10 +5,10 @@ module DynamicLoading (
forceLoadModuleInterfaces,
forceLoadNameModuleInterface,
forceLoadTyCon,
-- * Finding names
lookupRdrNameInModuleForPlugins,
-- * Loading values
getValueSafely,
getHValueSafely,
......@@ -20,18 +20,16 @@ module DynamicLoading (
import Linker ( linkModule, getHValue )
import SrcLoc ( noSrcSpan )
import Finder ( findImportedModule, cannotFindModule )
import DriverPhases ( HscSource(HsSrcFile) )
import TcRnMonad ( initTc, initIfaceTcRn )
import TcRnMonad ( initTcInteractive, initIfaceTcRn )
import LoadIface ( loadPluginInterface )
import RdrName ( RdrName, Provenance(..), ImportSpec(..), ImpDeclSpec(..)
, ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName, gre_name )
import RnNames ( gresFromAvails )
import PrelNames ( iNTERACTIVE )
import DynFlags
import HscTypes ( HscEnv(..), FindResult(..), ModIface(..), lookupTypeHscEnv )
import HscTypes
import BasicTypes ( HValue )
import TypeRep ( TyThing(..), pprTyThingCategory )
import TypeRep ( pprTyThingCategory )
import Type ( Type, eqType )
import TyCon ( TyCon )
import Name ( Name, nameModule_maybe )
......@@ -52,7 +50,10 @@ import GHC.Exts ( unsafeCoerce# )
-- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
forceLoadModuleInterfaces :: HscEnv -> SDoc -> [Module] -> IO ()
forceLoadModuleInterfaces hsc_env doc modules
= (initTc hsc_env HsSrcFile False iNTERACTIVE $ initIfaceTcRn $ mapM_ (loadPluginInterface doc) modules) >> return ()
= (initTcInteractive hsc_env $
initIfaceTcRn $
mapM_ (loadPluginInterface doc) modules)
>> return ()
-- | Force the interface for the module containing the name to be loaded. The 'SDoc' parameter is used
-- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
......@@ -151,7 +152,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
case found_module of
Found _ mod -> do
-- Find the exports of the module
(_, mb_iface) <- initTc hsc_env HsSrcFile False iNTERACTIVE $ initIfaceTcRn $ loadPluginInterface (ptext (sLit "contains a name used in an invocation of lookupRdrNameInModule")) mod
(_, mb_iface) <- initTcInteractive hsc_env $
initIfaceTcRn $
loadPluginInterface doc mod
case mb_iface of
Just iface -> do
-- Try and find the required name in the exports
......@@ -166,8 +169,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
Nothing -> throwCmdLineErrorS dflags $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name]
err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
where dflags = hsc_dflags hsc_env
where
dflags = hsc_dflags hsc_env
doc = ptext (sLit "contains a name used in an invocation of lookupRdrNameInModule")
wrongTyThingError :: Name -> TyThing -> SDoc
wrongTyThingError name got_thing = hsep [ptext (sLit "The name"), ppr name, ptext (sLit "is not that of a value but rather a"), pprTyThingCategory got_thing]
......
......@@ -283,9 +283,10 @@ hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do
-- is used to indicate that.
hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst]))
hscTcRnGetInfo hsc_env0 name = runInteractiveHsc hsc_env0 $ do
hsc_env <- getHscEnv
ioMsgMaybe' $ tcRnGetInfo hsc_env name
hscTcRnGetInfo hsc_env0 name
= runInteractiveHsc hsc_env0 $
do { hsc_env <- getHscEnv
; ioMsgMaybe' $ tcRnGetInfo hsc_env name }
#ifdef GHCI
hscIsGHCiMonad :: HscEnv -> String -> IO Name
......@@ -1327,7 +1328,7 @@ you run it you get a list of HValues that should be the same length as the list
of names; add them to the ClosureEnv.
A naked expression returns a singleton Name [it]. The stmt is lifted into the
IO monad as explained in Note [Interactively-bound Ids in GHCi] in TcRnDriver
IO monad as explained in Note [Interactively-bound Ids in GHCi] in HscTypes
-}
#ifdef GHCI
......@@ -1349,16 +1350,18 @@ hscStmtWithLocation :: HscEnv
-> IO (Maybe ([Id], IO [HValue], FixityEnv))
hscStmtWithLocation hsc_env0 stmt source linenumber =
runInteractiveHsc hsc_env0 $ do
hsc_env <- getHscEnv
maybe_stmt <- hscParseStmtWithLocation source linenumber stmt
case maybe_stmt of
Nothing -> return Nothing
Just parsed_stmt -> do
-- Rename and typecheck it
-- Here we lift the stmt into the IO monad, see Note
-- [Interactively-bound Ids in GHCi] in TcRnDriver
(ids, tc_expr, fix_env) <- ioMsgMaybe $ tcRnStmt hsc_env parsed_stmt
hsc_env <- getHscEnv
let interactive_hsc_env = setInteractivePackage hsc_env
-- Bindings created here belong to the interactive package
-- See Note [The interactive package] in HscTypes
-- (NB: maybe not necessary, since Stmts bind only Ids)
(ids, tc_expr, fix_env) <- ioMsgMaybe $ tcRnStmt interactive_hsc_env parsed_stmt
-- Desugar it
ds_expr <- ioMsgMaybe $ deSugarExpr hsc_env tc_expr
......@@ -1366,6 +1369,9 @@ hscStmtWithLocation hsc_env0 stmt source linenumber =
handleWarnings
-- Then code-gen, and link it
-- It's important NOT to have package 'interactive' as thisPackageId
-- for linking, else we try to link 'main' and can't find it.
-- Whereas the linker already knows to ignore 'interactive'
let src_span = srcLocSpan interactiveSrcLoc
hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
let hval_io = unsafeCoerce# hval :: IO [HValue]
......@@ -1386,12 +1392,15 @@ hscDeclsWithLocation :: HscEnv
-> IO ([TyThing], InteractiveContext)
hscDeclsWithLocation hsc_env0 str source linenumber =
runInteractiveHsc hsc_env0 $ do
hsc_env <- getHscEnv
L _ (HsModule{ hsmodDecls = decls }) <-
hscParseThingWithLocation source linenumber parseModule str
{- Rename and typecheck it -}
tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env decls
hsc_env <- getHscEnv
let interactive_hsc_env = setInteractivePackage hsc_env
-- Bindings created here belong to the interactive package
-- See Note [The interactive package] in HscTypes
tc_gblenv <- ioMsgMaybe $ tcRnDeclsi interactive_hsc_env decls
{- Grab the new instances -}
-- We grab the whole environment because of the overlapping that may have
......@@ -1432,7 +1441,6 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
prepd_binds data_tycons mod_breaks
let src_span = srcLocSpan interactiveSrcLoc
hsc_env <- getHscEnv
liftIO $ linkDecls hsc_env src_span cbc
let tcs = filterOut isImplicitTyCon (mg_tcs simpl_mg)
......@@ -1611,7 +1619,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr
{- Convert to BCOs -}
; bcos <- coreExprToBCOs dflags iNTERACTIVE prepd_expr
; bcos <- coreExprToBCOs dflags (icInteractiveModule (hsc_IC hsc_env)) prepd_expr
{- link it -}
; hval <- linkExpr hsc_env srcspan bcos
......
This diff is collapsed.
......@@ -432,12 +432,9 @@ mAIN, rOOT_MAIN :: Module
mAIN = mkMainModule_ mAIN_NAME
rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation
-- The ':xxx' makes a module name that the user can never
-- use himself. The z-encoding for ':' is "ZC", so the z-encoded
-- module name still starts with a capital letter, which keeps
-- the z-encoded version consistent.
iNTERACTIVE :: Module
iNTERACTIVE = mkMainModule (fsLit ":Interactive")
mkInteractiveModule :: Int -> Module
-- (mkInteractiveMoudule 9) makes module 'interactive:M9'
mkInteractiveModule n = mkModule interactivePackageId (mkModuleName ("Ghci" ++ show n))
pRELUDE_NAME, mAIN_NAME :: ModuleName
pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude")
......
......@@ -64,7 +64,7 @@ import DataCon ( dataConFieldLabels, dataConTyCon )
import TyCon ( isTupleTyCon, tyConArity )
import PrelNames ( mkUnboundName, isUnboundName, rOOT_MAIN, forall_tv_RDR )
import ErrUtils ( MsgDoc )
import BasicTypes ( Fixity(..), FixityDirection(..), minPrecedence )
import BasicTypes ( Fixity(..), FixityDirection(..), minPrecedence, defaultFixity )
import SrcLoc
import Outputable
import Util
......@@ -1136,17 +1136,18 @@ lookupFixityRn name
-- where 'foo' is not in scope, should not give an error (Trac #7937)
| otherwise
= do { this_mod <- getModule
; if nameIsLocalOrFrom this_mod name
then lookup_local
else lookup_imported }
= do { local_fix_env <- getFixityEnv
; case lookupNameEnv local_fix_env name of {
Just (FixItem _ fix) -> return fix ;
Nothing ->
do { this_mod <- getModule
; if nameIsLocalOrFrom this_mod name || isInteractiveModule (nameModule name)
-- Interactive modules are all in the fixity env,
-- and don't have entries in the HPT
then return defaultFixity
else lookup_imported } } }
where
lookup_local -- It's defined in this module
= do { local_fix_env <- getFixityEnv
; traceRn (text "lookupFixityRn: looking up name in local environment:" <+>
vcat [ppr name, ppr local_fix_env])
; return (lookupFixity local_fix_env name) }
lookup_imported
-- For imported names, we have to get their fixities by doing a
-- loadInterfaceForName, and consulting the Ifaces that comes back
......
......@@ -347,7 +347,7 @@ created by its bindings.
Note [Top-level Names in Template Haskell decl quotes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also: Note [Interactively-bound Ids in GHCi] in TcRnDriver
See also: Note [Interactively-bound Ids in GHCi] in HscTypes
Consider a Template Haskell declaration quotation like this:
module M where
......
......@@ -257,7 +257,7 @@ lintInteractiveExpr what hsc_env expr
interactiveInScope :: HscEnv -> [Var]
-- In GHCi we may lint expressions, or bindings arising from 'deriving'
-- clauses, that mention variables bound in the interactive context.
-- These are Local things (see Note [Interactively-bound Ids in GHCi] in TcRnDriver).
-- These are Local things (see Note [Interactively-bound Ids in GHCi] in HscTypes).
-- So we have to tell Lint about them, lest it reports them as out of scope.
--
-- We do this by find local-named things that may appear free in interactive
......
......@@ -244,10 +244,10 @@ tcExtendLocalFamInstEnv fam_insts thing_inside
fam_insts
; let env' = env { tcg_fam_insts = fam_insts'
, tcg_fam_inst_env = inst_env' }
; setGblEnv env' thing_inside
; setGblEnv env' thing_inside
}
-- Check that the proposed new instance is OK,
-- Check that the proposed new instance is OK,
-- and then add it to the home inst env
-- This must be lazy in the fam_inst arguments, see Note [Lazy axiom match]
-- in FamInstEnv.lhs
......@@ -258,10 +258,13 @@ addLocalFamInst (home_fie, my_fis) fam_inst
= do { traceTc "addLocalFamInst" (ppr fam_inst)
; isGHCi <- getIsGHCi
; mod <- getModule
; traceTc "alfi" (ppr mod $$ ppr isGHCi)
-- In GHCi, we *override* any identical instances
-- that are also defined in the interactive context
; let (home_fie', my_fis')
-- Trac #7102
; let (home_fie', my_fis')
| isGHCi = ( deleteFromFamInstEnv home_fie fam_inst
, filterOut (identicalFamInst fam_inst) my_fis)
| otherwise = (home_fie, my_fis)
......@@ -276,9 +279,8 @@ addLocalFamInst (home_fie, my_fis) fam_inst
; no_conflict <- checkForConflicts inst_envs fam_inst
; if no_conflict then
return (home_fie'', fam_inst : my_fis')
else
else
return (home_fie, my_fis) }
\end{code}
%************************************************************************
......
......@@ -116,27 +116,24 @@ tcLookupGlobal :: Name -> TcM TyThing
tcLookupGlobal name
= do { -- Try local envt
env <- getGblEnv
; case lookupNameEnv (tcg_type_env env) name of {
; case lookupNameEnv (tcg_type_env env) name of {
Just thing -> return thing ;
Nothing ->
-- Should it have been in the local envt?
case nameModule_maybe name of {
Nothing -> notFound name ; -- Internal names can happen in GHCi
Just mod | mod == tcg_mod env -- Names from this module
-> notFound name -- should be in tcg_type_env
| otherwise -> do
-- Should it have been in the local envt?
if nameIsLocalOrFrom (tcg_mod env) name
then notFound name -- Internal names can happen in GHCi
else
-- Try home package table and external package table
{ mb_thing <- tcLookupImported_maybe name
do { mb_thing <- tcLookupImported_maybe name
; case mb_thing of
Succeeded thing -> return thing
Failed msg -> failWithTc msg
}}}}
}}}
tcLookupField :: Name -> TcM Id -- Returns the selector Id
tcLookupField name
tcLookupField name
= tcLookupId name -- Note [Record field lookup]
{- Note [Record field lookup]
......
This diff is collapsed.
......@@ -199,17 +199,21 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
return (msgs, final_res)
}
initTcPrintErrors -- Used from the interactive loop only
:: HscEnv
-> Module
-> TcM r
-> IO (Messages, Maybe r)
initTcPrintErrors env mod todo = initTc env HsSrcFile False mod todo
initTcInteractive :: HscEnv -> TcM a -> IO (Messages, Maybe a)
-- Initialise the type checker monad for use in GHCi
initTcInteractive hsc_env thing_inside
= initTc hsc_env HsSrcFile False
(icInteractiveModule (hsc_IC hsc_env))
thing_inside
initTcForLookup :: HscEnv -> TcM a -> IO a
initTcForLookup hsc_env tcm
= do (msgs, m) <- initTc hsc_env HsSrcFile False iNTERACTIVE tcm
-- The thing_inside is just going to look up something
-- in the environment, so we don't need much setup
initTcForLookup hsc_env thing_inside
= do (msgs, m) <- initTc hsc_env HsSrcFile False
(icInteractiveModule (hsc_IC hsc_env)) -- Irrelevant really
thing_inside
case m of
Nothing -> throwIO $ mkSrcErr $ snd msgs
Just x -> return x
......@@ -518,7 +522,8 @@ setModule :: Module -> TcRn a -> TcRn a
setModule mod thing_inside = updGblEnv (\env -> env { tcg_mod = mod }) thing_inside
getIsGHCi :: TcRn Bool
getIsGHCi = do { mod <- getModule; return (mod == iNTERACTIVE) }
getIsGHCi = do { mod <- getModule
; return (isInteractiveModule mod) }
getGHCiMonad :: TcRn Name
getGHCiMonad = do { hsc <- getTopEnv; return (ic_monad $ hsc_IC hsc) }
......
......@@ -216,6 +216,7 @@ data TcGblEnv
tcg_fix_env :: FixityEnv, -- ^ Just for things in this module
tcg_field_env :: RecFieldEnv, -- ^ Just for things in this module
-- See Note [The interactive package] in HscTypes
tcg_type_env :: TypeEnv,
-- ^ Global type env for the module we are compiling now. All
......@@ -224,6 +225,9 @@ data TcGblEnv
--
-- (Ids defined in this module start in the local envt, though they
-- move to the global envt during zonking)
--
-- NB: for what "things in this module" means, see
-- Note [The interactive package] in HscTypes
tcg_type_env_var :: TcRef TypeEnv,
-- Used only to initialise the interface-file
......
......@@ -1110,15 +1110,18 @@ tcLookupTh name
= do { (gbl_env, lcl_env) <- getEnvs
; case lookupNameEnv (tcl_env lcl_env) name of {
Just thing -> return thing;
Nothing -> do
{ if nameIsLocalOrFrom (tcg_mod gbl_env) name
Nothing ->
case lookupNameEnv (tcg_type_env gbl_env) name of {
Just thing -> return (AGlobal thing);
Nothing ->
if nameIsLocalOrFrom (tcg_mod gbl_env) name
then -- It's defined in this module
case lookupNameEnv (tcg_type_env gbl_env) name of
Just thing -> return (AGlobal thing)
Nothing -> failWithTc (notInEnv name)
failWithTc (notInEnv name)
else do -- It's imported
{ mb_thing <- tcLookupImported_maybe name
else
do { mb_thing <- tcLookupImported_maybe name
; case mb_thing of
Succeeded thing -> return (AGlobal thing)
Failed msg -> failWithTc msg
......
......@@ -47,6 +47,7 @@ import Coercion
import CoAxiom
import VarSet
import VarEnv
import Module( isInteractiveModule )
import Name
import UniqFM
import Outputable
......@@ -353,6 +354,7 @@ extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm})
add (FamIE items) _ = FamIE (ins_item:items)
deleteFromFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv
-- Used only for overriding in GHCi
deleteFromFamInstEnv inst_env fam_inst@(FamInst {fi_fam = fam_nm})
= adjustUFM adjust inst_env fam_nm
where
......@@ -361,13 +363,14 @@ deleteFromFamInstEnv inst_env fam_inst@(FamInst {fi_fam = fam_nm})
= FamIE (filterOut (identicalFamInst fam_inst) items)
identicalFamInst :: FamInst -> FamInst -> Bool
-- Same LHS, *and* the instance is defined in the same module
-- Same LHS, *and* both instances are on the interactive command line
-- Used for overriding in GHCi
identicalFamInst (FamInst { fi_axiom = ax1 }) (FamInst { fi_axiom = ax2 })
= nameModule (coAxiomName ax1) == nameModule (coAxiomName ax2)
&& coAxiomTyCon ax1 == coAxiomTyCon ax2
&& brListLength brs1 == brListLength brs2
&& and (brListZipWith identical_ax_branch brs1 brs2)
= isInteractiveModule (nameModule (coAxiomName ax1))
&& isInteractiveModule (nameModule (coAxiomName ax2))
&& coAxiomTyCon ax1 == coAxiomTyCon ax2
&& brListLength brs1 == brListLength brs2
&& and (brListZipWith identical_ax_branch brs1 brs2)
where brs1 = coAxiomBranches ax1
brs2 = coAxiomBranches ax2
identical_ax_branch br1 br2
......
......@@ -53,7 +53,9 @@ module Outputable (
-- * Controlling the style in which output is printed
BindingSite(..),
PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
PprStyle, CodeStyle(..), PrintUnqualified,
alwaysQualify, alwaysQualifyNames, alwaysQualifyModules,
neverQualify, neverQualifyNames, neverQualifyModules,
QualifyName(..),
sdocWithDynFlags, sdocWithPlatform,
getPprStyle, withPprStyle, withPprStyleDoc,
......@@ -75,7 +77,7 @@ import {-# SOURCE #-} DynFlags( DynFlags,
useUnicodeQuotes,
unsafeGlobalDynFlags )
import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
import {-# SOURCE #-} Name( Name, nameModule )
import {-# SOURCE #-} OccName( OccName )
import {-# SOURCE #-} StaticFlags( opt_PprStyle_Debug, opt_NoDebugOutput )
import FastString
......@@ -145,13 +147,20 @@ data Depth = AllTheWay
-- purpose of the pair of functions that gets passed around
-- when rendering 'SDoc'.
type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
-- | given an /original/ name, this function tells you which module
-- name it should be qualified with when printing for the user, if
-- any. For example, given @Control.Exception.catch@, which is in scope
-- as @Exception.catch@, this fuction will return @Just "Exception"@.
-- Note that the return value is a ModuleName, not a Module, because
-- in source code, names are qualified by ModuleNames.
type QueryQualifyName = Name -> QualifyName
type QueryQualifyName = Module -> OccName -> QualifyName
-- | For a given module, we need to know whether to print it with
-- a package name to disambiguate it.
type QueryQualifyModule = Module -> Bool
-- See Note [Printing original names] in HscTypes
data QualifyName -- given P:M.T
......@@ -164,18 +173,11 @@ data QualifyName -- given P:M.T
-- it is not in scope at all, and M.T is already bound in the
-- current scope, so we must refer to it as "P:M.T"
-- | For a given module, we need to know whether to print it with
-- a package name to disambiguate it.
type QueryQualifyModule = Module -> Bool
type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
alwaysQualifyNames :: QueryQualifyName
alwaysQualifyNames n = NameQual (moduleName (nameModule n))
alwaysQualifyNames m _ = NameQual (moduleName m)
neverQualifyNames :: QueryQualifyName
neverQualifyNames _ = NameUnqual
neverQualifyNames _ _ = NameUnqual
alwaysQualifyModules :: QueryQualifyModule
alwaysQualifyModules _ = True
......@@ -296,8 +298,8 @@ sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform)
\begin{code}
qualName :: PprStyle -> QueryQualifyName
qualName (PprUser (qual_name,_) _) n = qual_name n
qualName _other n = NameQual (moduleName (nameModule n))
qualName (PprUser (qual_name,_) _) mod occ = qual_name mod occ
qualName _other mod _ = NameQual (moduleName mod)