Commit 35d213ab authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactor the imports of InteractiveContext

Instead of two fields
   ic_toplev_scope :: [Module]
   ic_imports      :: [ImportDecl RdrName]

we now just have one
   ic_imports :: [InteractiveImport]
with the auxiliary data type
   data InteractiveImport
    = IIDecl (ImportDecl RdrName)  -- Bring the exports of a particular module
    	   	       		   -- (filtered by an import decl) into scope

    | IIModule Module	-- Bring into scope the entire top-level envt of
    	     		-- of this module, including the things imported
			-- into it.

This makes lots of code less confusing.  No change in behaviour.
It's preparatory to fixing Trac #5147.

While I was at I also
  * Cleaned up the handling of the "implicit" Prelude import
    by adding a ideclImplicit field to ImportDecl.  This
    significantly reduces plumbing in the handling of
    the implicit Prelude import

  * Used record notation consistently for ImportDecl
parent 6059755e
......@@ -682,9 +682,12 @@ ppr_defn (UnhelpfulLoc _) = empty
instance Outputable ImportSpec where
ppr imp_spec
= ptext (sLit "imported from") <+> ppr (importSpecModule imp_spec)
= ptext (sLit "imported") <+> qual
<+> ptext (sLit "from") <+> ppr (importSpecModule imp_spec)
<+> pprLoc
where
qual | is_qual (is_decl imp_spec) = ptext (sLit "qualified")
| otherwise = empty
loc = importSpecLoc imp_spec
pprLoc = case loc of
RealSrcSpan s -> ptext (sLit "at") <+> ppr s
......
......@@ -38,6 +38,7 @@ data ImportDecl name
ideclSource :: Bool, -- ^ True <=> {-# SOURCE #-} import
ideclSafe :: Bool, -- ^ True => safe import
ideclQualified :: Bool, -- ^ True => qualified
ideclImplicit :: Bool, -- ^ True => implicit import (of Prelude)
ideclAs :: Maybe ModuleName, -- ^ as Module
ideclHiding :: Maybe (Bool, [LIE name]) -- ^ (True => hiding, names)
} deriving (Data, Typeable)
......@@ -48,6 +49,7 @@ simpleImportDecl mn = ImportDecl {
ideclPkgQual = Nothing,
ideclSource = False,
ideclSafe = True,
ideclImplicit = False,
ideclQualified = False,
ideclAs = Nothing,
ideclHiding = Nothing
......@@ -56,11 +58,17 @@ simpleImportDecl mn = ImportDecl {
\begin{code}
instance (Outputable name) => Outputable (ImportDecl name) where
ppr (ImportDecl mod' pkg from safe qual as spec)
= hang (hsep [ptext (sLit "import"), ppr_imp from, pp_safe safe,
ppr (ImportDecl { ideclName = mod', ideclPkgQual = pkg
, ideclSource = from, ideclSafe = safe
, ideclQualified = qual, ideclImplicit = implicit
, ideclAs = as, ideclHiding = spec })
= hang (hsep [ptext (sLit "import"), ppr_imp from, pp_implicit implicit, pp_safe safe,
pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])
4 (pp_spec spec)
where
pp_implicit False = empty
pp_implicit True = ptext (sLit ("(implicit)"))
pp_pkg Nothing = empty
pp_pkg (Just p) = doubleQuotes (ftext p)
......
......@@ -1173,7 +1173,7 @@ checkDependencies hsc_env summary iface
orM = foldr f (return False)
where f m rest = do b <- m; if b then return True else rest
dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _ _)) = do
dep_missing (L _ (ImportDecl { ideclName = L _ mod, ideclPkgQual = pkg })) = do
find_res <- liftIO $ findImportedModule hsc_env mod pkg
case find_res of
Found _ mod
......
......@@ -38,7 +38,7 @@ module GHC (
-- * Loading\/compiling the program
depanal,
load, LoadHowMuch(..),
load, LoadHowMuch(..), InteractiveImport(..),
SuccessFlag(..), succeeded, failed,
defaultWarnErrLogger, WarnErrLogger,
workingDirectoryChanged,
......
......@@ -100,19 +100,21 @@ mkPrelImports this_mod loc implicit_prelude import_decls
| otherwise = [preludeImportDecl]
where
explicit_prelude_import
= notNull [ () | L _ (ImportDecl mod Nothing _ _ _ _ _) <- import_decls,
unLoc mod == pRELUDE_NAME ]
= notNull [ () | L _ (ImportDecl { ideclName = mod
, ideclPkgQual = Nothing })
<- import_decls
, unLoc mod == pRELUDE_NAME ]
preludeImportDecl :: LImportDecl RdrName
preludeImportDecl
= L loc $
ImportDecl (L loc pRELUDE_NAME)
Nothing {- No specific package -}
False {- Not a boot interface -}
False {- Not a safe import -}
False {- Not qualified -}
Nothing {- No "as" -}
Nothing {- No import list -}
= L loc $ ImportDecl { ideclName = L loc pRELUDE_NAME,
ideclPkgQual = Nothing,
ideclSource = False,
ideclSafe = False, -- Not a safe import
ideclQualified = False,
ideclImplicit = True, -- Implicit!
ideclAs = Nothing,
ideclHiding = Nothing }
parseError :: SrcSpan -> Message -> IO a
parseError span err = throwOneError $ mkPlainErrMsg span err
......
......@@ -312,9 +312,7 @@ hscRnImportDecls hsc_env this_mod import_decls
= runHsc hsc_env $ ioMsgMaybe $
initTc hsc_env HsSrcFile False this_mod $
fmap tcg_rdr_env $
tcRnImports hsc_env this_mod loc import_decls
where
loc = mkGeneralSrcSpan (mkFastString "In a call to hscRnImportDecls")
tcRnImports hsc_env this_mod import_decls
#endif
-- -----------------------------------------------------------------------------
......
......@@ -123,7 +123,8 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
sig_info (GenericSig _ _) = (0,0,0,0,1)
sig_info _ = (0,0,0,0,0)
import_info (L _ (ImportDecl _ _ _ safe qual as spec))
import_info (L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual
, ideclAs = as, ideclHiding = spec }))
= add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec)
safe_info = qual_info
qual_info False = 0
......
......@@ -42,6 +42,7 @@ module HscTypes (
-- * Interactive context
InteractiveContext(..), emptyInteractiveContext,
InteractiveImport(..),
icPrintUnqual, extendInteractiveContext,
substInteractiveContext,
mkPrintUnqualified, pprModulePrefix,
......@@ -883,15 +884,12 @@ emptyModIface mod
--
data InteractiveContext
= InteractiveContext {
-- These two fields are only stored here so that the client
-- can retrieve them with GHC.getContext. GHC itself doesn't
-- use them, but it does reset them to empty sometimes (such
-- This field is only stored here so that the client
-- can retrieve it with GHC.getContext. GHC itself doesn't
-- use it, but does reset it to empty sometimes (such
-- as before a GHC.load). The context is set with GHC.setContext.
ic_toplev_scope :: [Module],
-- ^ The context includes the "top-level" scope of
-- these modules
ic_imports :: [ImportDecl RdrName],
-- ^ The context is extended with these import declarations
ic_imports :: [InteractiveImport],
-- ^ The GHCi context is extended with these imports
ic_rn_gbl_env :: GlobalRdrEnv,
-- ^ The contexts' cached 'GlobalRdrEnv', built by
......@@ -914,11 +912,17 @@ data InteractiveContext
-- virtual CWD of the program
}
data InteractiveImport
= IIDecl (ImportDecl RdrName) -- Bring the exports of a particular module
-- (filtered by an import decl) into scope
| IIModule Module -- Bring into scope the entire top-level envt of
-- of this module, including the things imported
-- into it.
emptyInteractiveContext :: InteractiveContext
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
ic_imports = [],
= InteractiveContext { ic_imports = [],
ic_rn_gbl_env = emptyGlobalRdrEnv,
ic_tmp_ids = []
#ifdef GHCI
......@@ -948,6 +952,10 @@ substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst
= ictxt { ic_tmp_ids = map subst_ty ids }
where
subst_ty id = id `setIdType` substTy subst (idType id)
instance Outputable InteractiveImport where
ppr (IIModule m) = char '*' <> ppr m
ppr (IIDecl d) = ppr d
\end{code}
%************************************************************************
......@@ -1675,6 +1683,7 @@ ms_imps ms = ms_textual_imps ms ++ map mk_additional_import (dynFlagDependencies
ideclName = noLoc mod_nm,
ideclPkgQual = Nothing,
ideclSource = False,
ideclImplicit = True, -- Maybe implicit because not "in the program text"
ideclQualified = False,
ideclAs = Nothing,
ideclHiding = Nothing,
......
......@@ -778,29 +778,32 @@ fromListBL bound l = BL (length l) bound l []
-- Setting the context doesn't throw away any bindings; the bindings
-- we've built up in the InteractiveContext simply move to the new
-- module. They always shadow anything in scope in the current context.
setContext :: GhcMonad m =>
[Module] -- ^ entire top level scope of these modules
-> [ImportDecl RdrName] -- ^ these import declarations
-> m ()
setContext toplev_mods import_decls = do
hsc_env <- getSession
let old_ic = hsc_IC hsc_env
hpt = hsc_HPT hsc_env
imprt_decls = map noLoc import_decls
--
import_env <-
if null imprt_decls then return emptyGlobalRdrEnv else do
let this_mod | null toplev_mods = pRELUDE
| otherwise = head toplev_mods
liftIO $ hscRnImportDecls hsc_env this_mod imprt_decls
toplev_envs <- liftIO $ mapM (mkTopLevEnv hpt) toplev_mods
let all_env = foldr plusGlobalRdrEnv import_env toplev_envs
modifySession $ \_ ->
hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,
ic_imports = import_decls,
ic_rn_gbl_env = all_env }}
setContext :: GhcMonad m => [InteractiveImport] -> m ()
setContext imports
= do { hsc_env <- getSession
; let old_ic = hsc_IC hsc_env
; all_env <- liftIO $ findGlobalRdrEnv hsc_env imports
; modifySession $ \_ ->
hsc_env{ hsc_IC = old_ic { ic_imports = imports
, ic_rn_gbl_env = all_env }}}
findGlobalRdrEnv :: HscEnv -> [InteractiveImport] -> IO GlobalRdrEnv
-- Compute the GlobalRdrEnv for the interactive context
findGlobalRdrEnv hsc_env imports
= do { idecls_env <- hscRnImportDecls hsc_env this_mod idecls
-- This call also loads any orphan modules
; imods_env <- mapM (mkTopLevEnv (hsc_HPT hsc_env)) imods
; return (foldr plusGlobalRdrEnv idecls_env imods_env) }
where
idecls :: [LImportDecl RdrName]
idecls = [noLoc d | IIDecl d <- imports]
imods :: [Module]
imods = [m | IIModule m <- imports]
this_mod = case imods of
[] -> pRELUDE
(m:_) -> m
availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv
availsToGlobalRdrEnv mod_name avails
......@@ -828,9 +831,9 @@ mkTopLevEnv hpt modl
-- | Get the interactive evaluation context, consisting of a pair of the
-- set of modules from which we take the full top-level scope, and the set
-- of modules from which we take just the exports respectively.
getContext :: GhcMonad m => m ([Module],[ImportDecl RdrName])
getContext :: GhcMonad m => m [InteractiveImport]
getContext = withSession $ \HscEnv{ hsc_IC=ic } ->
return (ic_toplev_scope ic, ic_imports ic)
return (ic_imports ic)
-- | Returns @True@ if the specified module is interpreted, and hence has
-- its full top-level scope available.
......
......@@ -504,7 +504,11 @@ importdecls :: { [LImportDecl RdrName] }
importdecl :: { LImportDecl RdrName }
: 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
{ L (comb4 $1 $6 $7 $8) (ImportDecl $6 $5 $2 $3 $4 (unLoc $7) (unLoc $8)) }
{ L (comb4 $1 $6 $7 $8) $
ImportDecl { ideclName = $6, ideclPkgQual = $5
, ideclSource = $2, ideclSafe = $3
, ideclQualified = $4, ideclImplicit = False
, ideclAs = unLoc $7, ideclHiding = unLoc $8 } }
maybe_src :: { IsBootInterface }
: '{-# SOURCE' '#-}' { True }
......
......@@ -21,8 +21,6 @@ import RnHsDoc ( rnHsDoc )
import IfaceEnv ( ifaceExportNames )
import LoadIface ( loadSrcInterface )
import TcRnMonad
import HeaderInfo ( mkPrelImports )
import PrelNames
import Module
import Name
......@@ -132,29 +130,21 @@ with yes we have gone with no for now.
\begin{code}
rnImports :: SrcSpan -> [LImportDecl RdrName]
-> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports :: [LImportDecl RdrName]
-> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports prel_imp_loc imports
rnImports imports
-- PROCESS IMPORT DECLS
-- Do the non {- SOURCE -} ones first, so that we get a helpful
-- warning for {- SOURCE -} ones that are unnecessary
= do this_mod <- getModule
implicit_prelude <- xoptM Opt_ImplicitPrelude
let prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc
implicit_prelude imports
(source, ordinary) = partition is_source_import imports
is_source_import (L _ (ImportDecl _ _ is_boot _ _ _ _)) = is_boot
ifWOptM Opt_WarnImplicitPrelude $
when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
stuff1 <- mapM (rnImportDecl this_mod True) prel_imports
stuff2 <- mapM (rnImportDecl this_mod False) ordinary
stuff3 <- mapM (rnImportDecl this_mod False) source
let (source, ordinary) = partition is_source_import imports
is_source_import d = ideclSource (unLoc d)
stuff1 <- mapM (rnImportDecl this_mod) ordinary
stuff2 <- mapM (rnImportDecl this_mod) source
-- Safe Haskell: See Note [Tracking Trust Transitively]
let (decls, rdr_env, imp_avails, hpc_usage) =
combine (stuff1 ++ stuff2 ++ stuff3)
combine (stuff1 ++ stuff2)
return (decls, rdr_env, imp_avails, hpc_usage)
where
......@@ -169,15 +159,15 @@ rnImports prel_imp_loc imports
imp_avails1 `plusImportAvails` imp_avails2,
hpc_usage1 || hpc_usage2 )
rnImportDecl :: Module -> Bool
rnImportDecl :: Module
-> LImportDecl RdrName
-> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl this_mod implicit_prelude
(L loc (ImportDecl { ideclName = loc_imp_mod_name, ideclPkgQual = mb_pkg
, ideclSource = want_boot, ideclSafe = mod_safe
, ideclQualified = qual_only
, ideclAs = as_mod, ideclHiding = imp_details }))
rnImportDecl this_mod
(L loc decl@(ImportDecl { ideclName = loc_imp_mod_name, ideclPkgQual = mb_pkg
, ideclSource = want_boot, ideclSafe = mod_safe
, ideclQualified = qual_only, ideclImplicit = implicit
, ideclAs = as_mod, ideclHiding = imp_details }))
= setSrcSpan loc $ do
when (isJust mb_pkg) $ do
......@@ -194,11 +184,11 @@ rnImportDecl this_mod implicit_prelude
-- (Opt_WarnMissingImportList also checks for T(..) items
-- but that is done in checkDodgyImport below)
case imp_details of
Just (False, _) -> return () -- Explicit import list
_ | implicit_prelude -> return ()
| qual_only -> return ()
| otherwise -> ifWOptM Opt_WarnMissingImportList $
addWarn (missingImportListWarn imp_mod_name)
Just (False, _) -> return () -- Explicit import list
_ | implicit -> return () -- Do not bleat for implicit imports
| qual_only -> return ()
| otherwise -> ifWOptM Opt_WarnMissingImportList $
addWarn (missingImportListWarn imp_mod_name)
iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
......@@ -309,8 +299,8 @@ rnImportDecl this_mod implicit_prelude
-- should the import be safe?
mod_safe' = mod_safe
|| (not implicit_prelude && safeDirectImpsReq dflags)
|| (implicit_prelude && safeImplicitImpsReq dflags)
|| (not implicit && safeDirectImpsReq dflags)
|| (implicit && safeImplicitImpsReq dflags)
imports = ImportAvails {
imp_mods = unitModuleEnv imp_mod
......@@ -339,8 +329,8 @@ rnImportDecl this_mod implicit_prelude
_ -> return ()
)
let new_imp_decl = L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot mod_safe'
qual_only as_mod new_imp_details)
let new_imp_decl = L loc (decl { ideclSafe = mod_safe'
, ideclHiding = new_imp_details })
return (new_imp_decl, gbl_env, imports, mi_hpc iface)
)
......@@ -1758,10 +1748,6 @@ moduleWarn mod (DeprecatedTxt txt)
<+> ptext (sLit "is deprecated:"),
nest 2 (vcat (map ppr txt)) ]
implicitPreludeWarn :: SDoc
implicitPreludeWarn
= ptext (sLit "Module `Prelude' implicitly imported")
packageImportErr :: SDoc
packageImportErr
= ptext (sLit "Package-qualified imports are not enabled; use -XPackageImports")
......
......@@ -37,6 +37,7 @@ import InstEnv
import FamInstEnv
import TcAnnotations
import TcBinds
import HeaderInfo ( mkPrelImports )
import TcType ( tidyTopType )
import TcDefaults
import TcEnv
......@@ -131,8 +132,15 @@ tcRnModule hsc_env hsc_src save_rn_syntax
initTc hsc_env hsc_src save_rn_syntax this_mod $
setSrcSpan loc $
do { -- Deal with imports;
tcg_env <- tcRnImports hsc_env this_mod prel_imp_loc import_decls ;
do { -- Deal with imports; first add implicit prelude
implicit_prelude <- xoptM Opt_ImplicitPrelude;
let { prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc
implicit_prelude import_decls } ;
ifWOptM Opt_WarnImplicitPrelude $
when (notNull prel_imports) $ addWarn (implicitPreludeWarn) ;
tcg_env <- tcRnImports hsc_env this_mod (prel_imports ++ import_decls) ;
setGblEnv tcg_env $ do {
-- Load the hi-boot interface for this module, if any
......@@ -192,6 +200,11 @@ tcRnModule hsc_env hsc_src save_rn_syntax
tcDump tcg_env ;
return tcg_env
}}}}
implicitPreludeWarn :: SDoc
implicitPreludeWarn
= ptext (sLit "Module `Prelude' implicitly imported")
\end{code}
......@@ -203,10 +216,9 @@ tcRnModule hsc_env hsc_src save_rn_syntax
\begin{code}
tcRnImports :: HscEnv -> Module
-> SrcSpan -- Location for the implicit prelude import
-> [LImportDecl RdrName] -> TcM TcGblEnv
tcRnImports hsc_env this_mod prel_imp_loc import_decls
= do { (rn_imports, rdr_env, imports,hpc_info) <- rnImports prel_imp_loc import_decls ;
tcRnImports hsc_env this_mod import_decls
= do { (rn_imports, rdr_env, imports,hpc_info) <- rnImports import_decls ;
; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
-- Make sure we record the dependencies from the DynFlags in the EPS or we
......
This diff is collapsed.
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment