diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/basicTypes/RdrName.lhs | 5 | ||||
| -rw-r--r-- | compiler/hsSyn/HsImpExp.lhs | 12 | ||||
| -rw-r--r-- | compiler/iface/MkIface.lhs | 2 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 2 | ||||
| -rw-r--r-- | compiler/main/HeaderInfo.hs | 22 | ||||
| -rw-r--r-- | compiler/main/HscMain.lhs | 4 | ||||
| -rw-r--r-- | compiler/main/HscStats.lhs | 3 | ||||
| -rw-r--r-- | compiler/main/HscTypes.lhs | 29 | ||||
| -rw-r--r-- | compiler/main/InteractiveEval.hs | 53 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 6 | ||||
| -rw-r--r-- | compiler/rename/RnNames.lhs | 60 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnDriver.lhs | 22 |
12 files changed, 123 insertions, 97 deletions
diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index 3b19356e49..096c866941 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -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 diff --git a/compiler/hsSyn/HsImpExp.lhs b/compiler/hsSyn/HsImpExp.lhs index 9dbb4417ae..0f7ad6e678 100644 --- a/compiler/hsSyn/HsImpExp.lhs +++ b/compiler/hsSyn/HsImpExp.lhs @@ -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) diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 7e1a4631a5..1ca97731a0 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -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 diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 3ebfd52bad..c7b7687023 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -38,7 +38,7 @@ module GHC ( -- * Loading\/compiling the program depanal, - load, LoadHowMuch(..), + load, LoadHowMuch(..), InteractiveImport(..), SuccessFlag(..), succeeded, failed, defaultWarnErrLogger, WarnErrLogger, workingDirectoryChanged, diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index c7a281cff8..a3f7e79dde 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -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 diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 2603d21bc4..ff52d2de76 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -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 -- ----------------------------------------------------------------------------- diff --git a/compiler/main/HscStats.lhs b/compiler/main/HscStats.lhs index 76699a5f85..34310e038c 100644 --- a/compiler/main/HscStats.lhs +++ b/compiler/main/HscStats.lhs @@ -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 diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index d43105b02d..436feb0094 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -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, diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 0386273de8..24f340b33d 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -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. diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index d199fb534f..42988feeeb 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -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 } diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index c6c941c4ca..c28c5c765d 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -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") diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index cdd614299e..437877aa7d 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -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 |