From ef03a76a01e538ccae5239dce00c583e9da17984 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Tue, 21 Apr 2009 13:10:38 +0000 Subject: [PATCH] FIX #2682: banish silly cases of the "module Foo is not loaded" error In GHCi if you say 'import Foo' meaning to load a package module Foo, and Foo.hs is found on the search path, then GHCi replies "module Foo is not loaded", because it knows Foo refers to the source file rather than the package module, and you haven't loaded that module with :load. This is consistent with the usual module-finding semantics. However, it isn't particularly useful. And it leads to silly problems like not being able to start GHCi when you happen to be sitting in libraries/base, because GHCi thinks the Prelude hasn't been loaded. So now I've made a slight change to the way that 'import M' works: if M is loaded, then it refers to the loaded module, otherwise it looks for a package module M. This does what the reporter of #2682 wanted, and since it turns an error condition into meaningful behaviour it can't break anything. The only undesirable consequence is that 'import M' might refer to a different M than ':load M'. Hopefully that won't lead to confusion. --- compiler/ghci/InteractiveUI.hs | 4 +-- compiler/main/Finder.lhs | 1 + compiler/main/GHC.hs | 70 ++++++++++++++++++++++++++++++---------- 3 files changed, 56 insertions(+), 19 deletions(-) diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 327cf14..e0c49ce 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -335,7 +335,7 @@ interactiveUI srcs maybe_exprs = withTerminalReset $ do #endif -- initial context is just the Prelude - prel_mod <- GHC.findModule (GHC.mkModuleName "Prelude") Nothing + prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing GHC.setContext [] [prel_mod] default_editor <- liftIO $ findEditor @@ -2356,7 +2356,7 @@ mkTickArray ticks lookupModule :: String -> GHCi Module lookupModule modName - = GHC.findModule (GHC.mkModuleName modName) Nothing + = GHC.lookupModule (GHC.mkModuleName modName) Nothing -- don't reset the counter back to zero? discardActiveBreakPoints :: GHCi () diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 1d43591..7587bb3 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -10,6 +10,7 @@ module Finder ( findImportedModule, findExactModule, findHomeModule, + findExposedPackageModule, mkHomeModLocation, mkHomeModLocation2, mkHiOnlyModLocation, diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 72806cb..c5571cb 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -89,6 +89,7 @@ module GHC ( -- * Interactive evaluation getBindings, getPrintUnqual, findModule, + lookupModule, #ifdef GHCI setContext, getContext, getNamesInScope, @@ -2648,23 +2649,58 @@ showRichTokenStream ts = go startLoc ts "" -- filesystem and package database to find the corresponding 'Module', -- using the algorithm that is used for an @import@ declaration. findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module -findModule mod_name maybe_pkg = withSession $ \hsc_env -> liftIO $ -- XXX - let - dflags = hsc_dflags hsc_env - hpt = hsc_HPT hsc_env - this_pkg = thisPackage dflags - in - case lookupUFM hpt mod_name of - Just mod_info -> return (mi_module (hm_iface mod_info)) - _not_a_home_module -> do - res <- findImportedModule hsc_env mod_name maybe_pkg - case res of - Found _ m | modulePackageId m /= this_pkg -> return m - | otherwise -> ghcError (CmdLineError (showSDoc $ - text "module" <+> quotes (ppr (moduleName m)) <+> - text "is not loaded")) - err -> let msg = cannotFindModule dflags mod_name err in - ghcError (CmdLineError (showSDoc msg)) +findModule mod_name maybe_pkg = withSession $ \hsc_env -> do + let + dflags = hsc_dflags hsc_env + this_pkg = thisPackage dflags + -- + case maybe_pkg of + Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do + res <- findImportedModule hsc_env mod_name maybe_pkg + case res of + Found _ m -> return m + err -> noModError dflags noSrcSpan mod_name err + _otherwise -> do + home <- lookupLoadedHomeModule mod_name + case home of + Just m -> return m + Nothing -> liftIO $ do + res <- findImportedModule hsc_env mod_name maybe_pkg + case res of + Found loc m | modulePackageId m /= this_pkg -> return m + | otherwise -> modNotLoadedError m loc + err -> noModError dflags noSrcSpan mod_name err + +modNotLoadedError :: Module -> ModLocation -> IO a +modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $ + text "module is not loaded:" <+> + quotes (ppr (moduleName m)) <+> + parens (text (expectJust "modNotLoadedError" (ml_hs_file loc))) + +-- | Like 'findModule', but differs slightly when the module refers to +-- a source file, and the file has not been loaded via 'load'. In +-- this case, 'findModule' will throw an error (module not loaded), +-- but 'lookupModule' will check to see whether the module can also be +-- found in a package, and if so, that package 'Module' will be +-- returned. If not, the usual module-not-found error will be thrown. +-- +lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module +lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg) +lookupModule mod_name Nothing = withSession $ \hsc_env -> do + home <- lookupLoadedHomeModule mod_name + case home of + Just m -> return m + Nothing -> liftIO $ do + res <- findExposedPackageModule hsc_env mod_name Nothing + case res of + Found _ m -> return m + err -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err + +lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module) +lookupLoadedHomeModule mod_name = withSession $ \hsc_env -> + case lookupUFM (hsc_HPT hsc_env) mod_name of + Just mod_info -> return (Just (mi_module (hm_iface mod_info))) + _not_a_home_module -> return Nothing #ifdef GHCI getHistorySpan :: GhcMonad m => History -> m SrcSpan -- 1.7.10.4