diff options
| -rw-r--r-- | compiler/rename/RnEnv.hs | 81 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 39 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/break019.stderr | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T9881.script | 3 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T9881.stdout | 32 | ||||
| -rwxr-xr-x | testsuite/tests/ghci/scripts/all.T | 1 |
6 files changed, 100 insertions, 58 deletions
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index eeffe17dce..6aa21fa0ba 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -10,7 +10,7 @@ module RnEnv ( newTopSrcBinder, lookupLocatedTopBndrRn, lookupTopBndrRn, lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe, - lookupLocalOccRn_maybe, + lookupLocalOccRn_maybe, lookupInfoOccRn, lookupLocalOccThLvl_maybe, lookupTypeOccRn, lookupKindOccRn, lookupGlobalOccRn, lookupGlobalOccRn_maybe, @@ -75,6 +75,7 @@ import FastString import Control.Monad import Data.List import qualified Data.Set as Set +import ListSetOps ( minusList ) import Constants ( mAX_TUPLE_SIZE ) {- @@ -763,10 +764,12 @@ lookupOccRn_maybe rdr_name ; case mb_name of { Just name -> return (Just name) ; Nothing -> do - { dflags <- getDynFlags - ; is_ghci <- getIsGHCi -- This test is not expensive, - -- and only happens for failed lookups - ; lookupQualifiedNameGHCi dflags is_ghci rdr_name } } } } } + { ns <- lookupQualifiedNameGHCi rdr_name + -- This test is not expensive, + -- and only happens for failed lookups + ; case ns of + (n:_) -> return (Just n) -- Unlikely to be more than one...? + [] -> return Nothing } } } } } lookupGlobalOccRn :: RdrName -> RnM Name -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global @@ -778,6 +781,25 @@ lookupGlobalOccRn rdr_name Nothing -> do { traceRn (text "lookupGlobalOccRn" <+> ppr rdr_name) ; unboundName WL_Global rdr_name } } +lookupInfoOccRn :: RdrName -> RnM [Name] +-- lookupInfoOccRn is intended for use in GHCi's ":info" command +-- It finds all the GREs that RdrName could mean, not complaining +-- about ambiguity, but rather returning them all +-- C.f. Trac #9881 +lookupInfoOccRn rdr_name + | Just n <- isExact_maybe rdr_name -- e.g. (->) + = return [n] + + | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name + = do { n <- lookupOrig rdr_mod rdr_occ + ; return [n] } + + | otherwise + = do { rdr_env <- getGlobalRdrEnv + ; let ns = map gre_name (lookupGRE_RdrName rdr_name rdr_env) + ; qual_ns <- lookupQualifiedNameGHCi rdr_name + ; return (ns ++ (qual_ns `minusList` ns)) } + lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name) -- No filter function; does not report an error on failure @@ -957,32 +979,37 @@ and should instead check the qualified import but at the moment this requires some refactoring so leave as a TODO -} -lookupQualifiedNameGHCi :: DynFlags -> Bool -> RdrName -> RnM (Maybe Name) -lookupQualifiedNameGHCi dflags is_ghci rdr_name - | Just (mod,occ) <- isQual_maybe rdr_name - , is_ghci - , gopt Opt_ImplicitImportQualified dflags -- Enables this GHCi behaviour - , not (safeDirectImpsReq dflags) -- See Note [Safe Haskell and GHCi] +lookupQualifiedNameGHCi :: RdrName -> RnM [Name] +lookupQualifiedNameGHCi rdr_name = -- 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 ifaces - | (n:ns) <- [ name - | iface <- ifaces - , avail <- mi_exports iface - , name <- availNames avail - , nameOccName name == occ ] - -> ASSERT(all (==n) 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 } } + do { dflags <- getDynFlags + ; is_ghci <- getIsGHCi + ; go_for_it dflags is_ghci } - | otherwise - = return Nothing where + go_for_it dflags is_ghci + | Just (mod,occ) <- isQual_maybe rdr_name + , is_ghci + , gopt Opt_ImplicitImportQualified dflags -- Enables this GHCi behaviour + , not (safeDirectImpsReq dflags) -- See Note [Safe Haskell and GHCi] + = do { res <- loadSrcInterface_maybe doc mod False Nothing + ; case res of + Succeeded ifaces + -> return [ name + | iface <- ifaces + , avail <- mi_exports iface + , name <- availNames avail + , nameOccName name == occ ] + + _ -> -- 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 [] } } + + | otherwise + = return [] + doc = ptext (sLit "Need to find") <+> ppr rdr_name {- diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 47fdd3a8a3..b4644007b8 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -1892,38 +1892,17 @@ getModuleInterface hsc_env mod loadModuleInterface (ptext (sLit "getModuleInterface")) mod tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Messages, Maybe [Name]) +-- ^ Find all the Names that this RdrName could mean, in GHCi tcRnLookupRdrName hsc_env rdr_name = runTcInteractive hsc_env $ - lookup_rdr_name rdr_name - -lookup_rdr_name :: RdrName -> TcM [Name] -lookup_rdr_name rdr_name = do - -- If the identifier is a constructor (begins with an - -- upper-case letter), then we need to consider both - -- constructor and type class identifiers. - let rdr_names = dataTcOccs rdr_name - - -- results :: [Either Messages Name] - results <- mapM (tryTcErrs . lookupOccRn) rdr_names - - traceRn (text "xx" <+> vcat [ppr rdr_names, ppr (map snd results)]) - -- The successful lookups will be (Just name) - let (warns_s, good_names) = unzip [ (msgs, name) - | (msgs, Just name) <- results] - errs_s = [msgs | (msgs, Nothing) <- results] - - -- Fail if nothing good happened, else add warnings - if null good_names - then addMessages (head errs_s) >> failM - -- No lookup succeeded, so - -- pick the first error message and report it - -- ToDo: If one of the errors is "could be Foo.X or Baz.X", - -- while the other is "X is not in scope", - -- we definitely want the former; but we might pick the latter - else mapM_ addMessages warns_s - -- Add deprecation warnings - return good_names - + do { -- If the identifier is a constructor (begins with an + -- upper-case letter), then we need to consider both + -- constructor and type class identifiers. + let rdr_names = dataTcOccs rdr_name + ; names_s <- mapM lookupInfoOccRn rdr_names + ; let names = concat names_s + ; when (null names) (addErrTc (ptext (sLit "Not in scope:") <+> quotes (ppr rdr_name))) + ; return names } #endif tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing) diff --git a/testsuite/tests/ghci.debugger/scripts/break019.stderr b/testsuite/tests/ghci.debugger/scripts/break019.stderr index 36e9ac2327..d9675a8db4 100644 --- a/testsuite/tests/ghci.debugger/scripts/break019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/break019.stderr @@ -1,2 +1,2 @@ -Top level: Not in scope: data constructor ‘Test2’ +Top level: Not in scope: ‘Test2’ diff --git a/testsuite/tests/ghci/scripts/T9881.script b/testsuite/tests/ghci/scripts/T9881.script new file mode 100644 index 0000000000..30e1ef2489 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9881.script @@ -0,0 +1,3 @@ +import Data.ByteString +import Data.ByteString.Lazy +:info ByteString diff --git a/testsuite/tests/ghci/scripts/T9881.stdout b/testsuite/tests/ghci/scripts/T9881.stdout new file mode 100644 index 0000000000..6866a6a79c --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9881.stdout @@ -0,0 +1,32 @@ +data Data.ByteString.Lazy.ByteString + = Data.ByteString.Lazy.Internal.Empty + | Data.ByteString.Lazy.Internal.Chunk {-# UNPACK #-}Data.ByteString.ByteString + Data.ByteString.Lazy.ByteString + -- Defined in ‘Data.ByteString.Lazy.Internal’ +instance Eq Data.ByteString.Lazy.ByteString + -- Defined in ‘Data.ByteString.Lazy.Internal’ +instance Ord Data.ByteString.Lazy.ByteString + -- Defined in ‘Data.ByteString.Lazy.Internal’ +instance Read Data.ByteString.Lazy.ByteString + -- Defined in ‘Data.ByteString.Lazy.Internal’ +instance Show Data.ByteString.Lazy.ByteString + -- Defined in ‘Data.ByteString.Lazy.Internal’ +instance Monoid Data.ByteString.Lazy.ByteString + -- Defined in ‘Data.ByteString.Lazy.Internal’ + +data Data.ByteString.ByteString + = Data.ByteString.Internal.PS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr + GHC.Word.Word8) + {-# UNPACK #-}Int + {-# UNPACK #-}Int + -- Defined in ‘Data.ByteString.Internal’ +instance Eq Data.ByteString.ByteString + -- Defined in ‘Data.ByteString.Internal’ +instance Ord Data.ByteString.ByteString + -- Defined in ‘Data.ByteString.Internal’ +instance Read Data.ByteString.ByteString + -- Defined in ‘Data.ByteString.Internal’ +instance Show Data.ByteString.ByteString + -- Defined in ‘Data.ByteString.Internal’ +instance Monoid Data.ByteString.ByteString + -- Defined in ‘Data.ByteString.Internal’ diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index a802027569..a78068a452 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -193,3 +193,4 @@ test('T9086b', normal, ghci_script, ['T9086b.script']) test('T9140', combined_output, ghci_script, ['T9140.script']) test('T9658', normal, ghci_script, ['T9658.script']) test('T9293', normal, ghci_script_without_flag('-fno-warn-tabs'), ['T9293.script']) +test('T9881', normal, ghci_script, ['T9881.script'])
\ No newline at end of file |