From: simonmar Date: Wed, 27 Jun 2001 16:38:17 +0000 (+0000) Subject: [project @ 2001-06-27 16:38:17 by simonmar] X-Git-Tag: Approximately_9120_patches~1683 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=47108330f6f832dd82aba3d125a1ad114f4a45e7;p=ghc-hetmet.git [project @ 2001-06-27 16:38:17 by simonmar] When we're in --interactive or --make mode, we don't even *look* for interface files in the home package. This means that cd'ing into fptools/ghc/lib/std and starting up GHCi Just Works, which is a good thing. It also subsumes the previous hack about checking whether we're renaming a command-line expression before allowing a home interface to be loaded. The downside is that if you try to use a qualified name for a home module that's not loaded, you'll get a slightly less informative error message: "interface file not found" rather than "module not loaded", but this could be improved. --- diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index e890019..52a6485 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.83 2001/06/27 10:35:48 simonpj Exp $ +-- $Id: DriverPipeline.hs,v 1.84 2001/06/27 16:38:17 simonmar Exp $ -- -- GHC Driver -- @@ -63,17 +63,6 @@ import MatchPS ----------------------------------------------------------------------------- -- GHC modes of operation -data GhcMode - = DoMkDependHS -- ghc -M - | DoMkDLL -- ghc --mk-dll - | StopBefore Phase -- ghc -E | -C | -S | -c - | DoMake -- ghc --make - | DoInteractive -- ghc --interactive - | DoLink -- [ the default ] - deriving (Eq) - -GLOBAL_VAR(v_GhcMode, error "todo", GhcMode) - modeFlag :: String -> Maybe GhcMode modeFlag "-M" = Just $ DoMkDependHS modeFlag "--mk-dll" = Just $ DoMkDLL diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 21cb1bc..48e683a 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverState.hs,v 1.45 2001/06/15 08:29:58 simonpj Exp $ +-- $Id: DriverState.hs,v 1.46 2001/06/27 16:38:17 simonmar Exp $ -- -- Settings for the driver -- @@ -14,6 +14,7 @@ module DriverState where import Packages ( PackageConfig(..) ) import CmdLineOpts +import DriverPhases import DriverUtil import Util import Config @@ -31,6 +32,20 @@ import Monad cHaskell1Version = "5" -- i.e., Haskell 98 ----------------------------------------------------------------------------- +-- GHC modes of operation + +data GhcMode + = DoMkDependHS -- ghc -M + | DoMkDLL -- ghc --mk-dll + | StopBefore Phase -- ghc -E | -C | -S | -c + | DoMake -- ghc --make + | DoInteractive -- ghc --interactive + | DoLink -- [ the default ] + deriving (Eq) + +GLOBAL_VAR(v_GhcMode, error "mode not set", GhcMode) + +----------------------------------------------------------------------------- -- Global compilation flags -- Cpp-related flags diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index e5a185d..d7167ad 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -287,7 +287,7 @@ lookupQualifiedName rdr_name mod = rdrNameModule rdr_name occ = rdrNameOcc rdr_name in - loadInterface (ppr rdr_name) mod ImportByCmdLine `thenRn` \ iface -> + loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface -> case [ name | (_,avails) <- mi_exports iface, avail <- avails, name <- availNames avail, diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index 7e2a3db..c1f2788 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -17,6 +17,7 @@ module RnHiFiles ( #include "HsVersions.h" +import DriverState ( GhcMode(..), v_GhcMode ) import DriverUtil ( splitFilename ) import CmdLineOpts ( opt_IgnoreIfacePragmas ) import HscTypes ( ModuleLocation(..), @@ -43,24 +44,21 @@ import Name ( Name {-instance NamedThing-}, nameModule, isLocalName, nameIsLocalOrFrom ) import NameEnv -import Module ( Module, - moduleName, isHomeModule, - ModuleName, WhereFrom(..), - extendModuleEnv, mkVanillaModule - ) +import Module import RdrName ( rdrNameOcc ) import SrcLoc ( mkSrcLoc ) import Maybes ( maybeToBool, orElse ) import StringBuffer ( hGetStringBuffer ) import FastString ( mkFastString ) import ErrUtils ( Message ) -import Finder ( findModule ) +import Finder ( findModule, findPackageModule ) import Lex import FiniteMap import Outputable import Bag import Config +import IOExts import Directory \end{code} @@ -118,7 +116,6 @@ tryLoadInterface doc_str mod_name from ImportByUser -> not (mi_boot iface) ImportByUserSource -> mi_boot iface ImportBySystem -> True - ImportByCmdLine -> True -> returnRn (iface, Nothing) ; -- Already loaded -- The not (mi_boot iface) test checks that the already-loaded -- interface isn't a boot iface. This can conceivably happen, @@ -134,7 +131,6 @@ tryLoadInterface doc_str mod_name from = case (from, mod_info) of (ImportByUser, _) -> False -- Not hi-boot (ImportByUserSource, _) -> True -- hi-boot - (ImportByCmdLine, _) -> False (ImportBySystem, Just (_, is_boot)) -> is_boot (ImportBySystem, Nothing) -> False -- We're importing a module we know absolutely @@ -146,9 +142,6 @@ tryLoadInterface doc_str mod_name from = case (from, mod_info) of (ImportByUserSource, Just (_,False)) -> True other -> False - - home_allowed | ImportByCmdLine <- from = True - | otherwise = False in -- Issue a warning for a redundant {- SOURCE -} import @@ -165,7 +158,7 @@ tryLoadInterface doc_str mod_name from (warnSelfImport this_mod) `thenRn_` -- READ THE MODULE IN - findAndReadIface doc_str mod_name hi_boot_file home_allowed + findAndReadIface doc_str mod_name hi_boot_file `thenRn` \ read_result -> case read_result of { Left err -> -- Not found, so add an empty export env to the Ifaces map @@ -476,34 +469,45 @@ new_top_bndrs mod names_w_locs findAndReadIface :: SDoc -> ModuleName -> IsBootInterface -- True <=> Look for a .hi-boot file -- False <=> Look for .hi file - -> Bool -- True <=> can read home interface -> RnM d (Either Message (Module, ParsedIface)) -- Nothing <=> file not found, or unreadable, or illegible -- Just x <=> successfully found and parsed -findAndReadIface doc_str mod_name hi_boot_file home_allowed +findAndReadIface doc_str mod_name hi_boot_file = traceRn trace_msg `thenRn_` - ioToRnM (findModule mod_name) `thenRn` \ maybe_found -> + -- In interactive or --make mode, we are *not allowed* to demand-load + -- a home package .hi file. So don't even look for them. + -- This helps in the case where you are sitting in eg. ghc/lib/std + -- and start up GHCi - it won't complain that all the modules it tries + -- to load are found in the home location. + ioToRnM_no_fail (readIORef v_GhcMode) `thenRn` \ mode -> + let home_allowed = mode `notElem` [ DoInteractive, DoLink ] + in + + ioToRnM (if home_allowed + then findModule mod_name + else findPackageModule mod_name) `thenRn` \ maybe_found -> + case maybe_found of Right (Just (wanted_mod,locn)) - -> -- in CmdLineMode, we cannot demand-load home interfaces - -- because the corresponding code won't be loaded, so we - -- check for this here and emit an error message. - if (home_allowed && isHomeModule wanted_mod) - then returnRn (Left (notLoaded wanted_mod)) - else - - mkHiPath hi_boot_file locn `thenRn` \ file -> + -> mkHiPath hi_boot_file locn `thenRn` \ file -> readIface file `thenRn` \ read_result -> case read_result of Left bad -> returnRn (Left bad) Right iface -> let read_mod = pi_mod iface - in warnCheckRn (wanted_mod == read_mod) - (hiModuleNameMismatchWarn wanted_mod - read_mod) `thenRn_` + in -- check that the module names agree + checkRn + (wanted_mod == read_mod) + (hiModuleNameMismatchWarn wanted_mod read_mod) + `thenRn_` + -- check that the package names agree + checkRn + (modulePackage wanted_mod == modulePackage read_mod) + (packageNameMismatchWarn wanted_mod read_mod) + `thenRn_` returnRn (Right (wanted_mod, iface)) -- Can't find it other -> traceRn (ptext SLIT("...not found")) `thenRn_` @@ -628,6 +632,15 @@ hiModuleNameMismatchWarn requested_mod read_mod = , ppr read_mod ] +packageNameMismatchWarn :: Module -> Module -> Message +packageNameMismatchWarn requested_mod read_mod = + sep [ ptext SLIT("Module"), quotes (ppr requested_mod), + ptext SLIT("is located in package"), + quotes (ptext (modulePackage requested_mod)), + ptext SLIT("but its interface file claims it is part of package"), + quotes (ptext (modulePackage read_mod)) + ] + warnRedundantSourceImport mod_name = ptext SLIT("Unnecessary {- SOURCE -} in the import of module") <+> quotes (ppr mod_name)