[commit: ghc] master: Improve error message when using qualified names in GHCi (e60a841)
git at git.haskell.org
git at git.haskell.org
Fri Jan 3 16:14:41 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/e60a841b07d000703e7aceb0faec908ce8f3257f/ghc
>---------------------------------------------------------------
commit e60a841b07d000703e7aceb0faec908ce8f3257f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Jan 3 15:39:35 2014 +0000
Improve error message when using qualified names in GHCi
When you say
ghci> :i Foo.x
GHCi tries to find module Foo and get 'x' from it. But
if Foo doesn't exist we don't want to say:
Attempting to use module ‛Foo’ which is not loaded
This is a bit confusing. Rather we just want to say that
Foo.x is not in scope.
>---------------------------------------------------------------
e60a841b07d000703e7aceb0faec908ce8f3257f
compiler/iface/LoadIface.lhs | 34 +++++++++++--------
compiler/rename/RnEnv.lhs | 75 +++++++++++++++++++++++-------------------
2 files changed, 62 insertions(+), 47 deletions(-)
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 08e7466..d787794 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -10,7 +10,8 @@ Loading interface files
module LoadIface (
-- RnM/TcM functions
loadModuleInterface, loadModuleInterfaces,
- loadSrcInterface, loadInterfaceForName, loadInterfaceForModule,
+ loadSrcInterface, loadSrcInterface_maybe,
+ loadInterfaceForName, loadInterfaceForModule,
-- IfM functions
loadInterface, loadWiredInHomeIface,
@@ -84,23 +85,30 @@ loadSrcInterface :: SDoc
-> Maybe FastString -- "package", if any
-> RnM ModIface
-loadSrcInterface doc mod want_boot maybe_pkg = do
+loadSrcInterface doc mod want_boot maybe_pkg
+ = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg
+ ; case res of
+ Failed err -> failWithTc err
+ Succeeded iface -> return iface }
+
+-- | Like loadSrcInterface, but returns a MaybeErr
+loadSrcInterface_maybe :: SDoc
+ -> ModuleName
+ -> IsBootInterface -- {-# SOURCE #-} ?
+ -> Maybe FastString -- "package", if any
+ -> RnM (MaybeErr MsgDoc ModIface)
+
+loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- We must first find which Module this import refers to. This involves
-- calling the Finder, which as a side effect will search the filesystem
-- and create a ModLocation. If successful, loadIface will read the
-- interface; it will call the Finder again, but the ModLocation will be
-- cached from the first search.
- hsc_env <- getTopEnv
- res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
- case res of
- Found _ mod -> do
- mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
- case mb_iface of
- Failed err -> failWithTc err
- Succeeded iface -> return iface
- err ->
- let dflags = hsc_dflags hsc_env in
- failWithTc (cannotFindInterface dflags mod err)
+ = do { hsc_env <- getTopEnv
+ ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
+ ; case res of
+ Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
+ err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
-- | Load interface for a module.
loadModuleInterface :: SDoc -> Module -> TcM ModIface
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index c49652b..c11cca0 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -46,7 +46,7 @@ module RnEnv (
#include "HsVersions.h"
-import LoadIface ( loadInterfaceForName, loadSrcInterface )
+import LoadIface ( loadInterfaceForName, loadSrcInterface_maybe )
import IfaceEnv
import HsSyn
import RdrName
@@ -645,23 +645,10 @@ lookupOccRn_maybe rdr_name
; case mb_name of {
Just name -> return (Just name) ;
Nothing -> do
- { -- We allow qualified names on the command line to refer to
- -- *any* name exported by any module in scope, just as if there
- -- was an "import qualified M" declaration for every module.
- -- But we DONT allow it under Safe Haskell as we need to check
- -- imports. We can and should instead check the qualified import
- -- but at the moment this requires some refactoring so leave as a TODO
- ; dflags <- getDynFlags
- ; let allow_qual = gopt Opt_ImplicitImportQualified dflags &&
- not (safeDirectImpsReq dflags)
- ; is_ghci <- getIsGHCi
- -- This test is not expensive,
- -- and only happens for failed lookups
- ; if isQual rdr_name && allow_qual && is_ghci
- then lookupQualifiedName rdr_name
- else do { traceRn (text "lookupOccRn failed" <+> ppr rdr_name)
- ; return Nothing } } } } } }
-
+ { dflags <- getDynFlags
+ ; is_ghci <- getIsGHCi -- This test is not expensive,
+ -- and only happens for failed lookups
+ ; lookupQualifiedNameGHCi dflags is_ghci rdr_name } } } } }
lookupGlobalOccRn :: RdrName -> RnM Name
-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
@@ -836,26 +823,46 @@ this is, after all, wired-in stuff.
%* *
%*********************************************************
+A qualified name on the command line can refer to any module at
+all: we try to load the interface if we don't already have it, just
+as if there was an "import qualified M" declaration for every
+module.
+
+If we fail we just return Nothing, rather than bleating
+about "attempting to use module ‛D’ (./D.hs) which is not loaded"
+which is what loadSrcInterface does.
+
+Note [Safe Haskell and GHCi]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We DONT do this Safe Haskell as we need to check imports. We can
+and should instead check the qualified import but at the moment
+this requires some refactoring so leave as a TODO
+
\begin{code}
--- A qualified name on the command line can refer to any module at all: we
--- try to load the interface if we don't already have it.
-lookupQualifiedName :: RdrName -> RnM (Maybe Name)
-lookupQualifiedName rdr_name
+lookupQualifiedNameGHCi :: DynFlags -> Bool -> RdrName -> RnM (Maybe Name)
+lookupQualifiedNameGHCi dflags is_ghci rdr_name
| Just (mod,occ) <- isQual_maybe rdr_name
- -- Note: we want to behave as we would for a source file import here,
- -- and respect hiddenness of modules/packages, hence loadSrcInterface.
- = do iface <- loadSrcInterface doc mod False Nothing
-
- case [ name
- | avail <- mi_exports iface,
- name <- availNames avail,
- nameOccName name == occ ] of
- (n:ns) -> ASSERT(null ns) return (Just n)
- _ -> do { traceRn (text "lookupQualified" <+> ppr rdr_name)
- ; return Nothing }
+ , is_ghci
+ , gopt Opt_ImplicitImportQualified dflags -- Enables this GHCi behaviour
+ , not (safeDirectImpsReq dflags) -- See Note [Safe Haskell and GHCi]
+ = -- We want to behave as we would for a source file import here,
+ -- and respect hiddenness of modules/packages, hence loadSrcInterface.
+ do { res <- loadSrcInterface_maybe doc mod False Nothing
+ ; case res of
+ Succeeded iface
+ | (n:ns) <- [ name
+ | avail <- mi_exports iface
+ , name <- availNames avail
+ , nameOccName name == occ ]
+ -> ASSERT(null ns) return (Just n)
+
+ _ -> -- Either we couldn't load the interface, or
+ -- we could but we didn't find the name in it
+ do { traceRn (text "lookupQualifiedNameGHCi" <+> ppr rdr_name)
+ ; return Nothing } }
| otherwise
- = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
+ = return Nothing
where
doc = ptext (sLit "Need to find") <+> ppr rdr_name
\end{code}
More information about the ghc-commits
mailing list