Re-work the naming story for the GHCi prompt (Trac #8649)
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 9 Jan 2014 17:58:18 +0000 (17:58 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 9 Jan 2014 17:58:48 +0000 (17:58 +0000)
The basic idea here is simple, and described in Note [The interactive package]
in HscTypes, which starts thus:

    Note [The interactive package]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Type and class declarations at the command prompt are treated as if
    they were defined in modules
       interactive:Ghci1
       interactive:Ghci2
       ...etc...
    with each bunch of declarations using a new module, all sharing a
    common package 'interactive' (see Module.interactivePackageId, and
    PrelNames.mkInteractiveModule).

    This scheme deals well with shadowing.  For example:

       ghci> data T = A
       ghci> data T = B
       ghci> :i A
       data Ghci1.T = A  -- Defined at <interactive>:2:10

    Here we must display info about constructor A, but its type T has been
    shadowed by the second declaration.  But it has a respectable
    qualified name (Ghci1.T), and its source location says where it was
    defined.

    So the main invariant continues to hold, that in any session an original
    name M.T only refers to oe unique thing.  (In a previous iteration both
    the T's above were called :Interactive.T, albeit with different uniques,
    which gave rise to all sorts of trouble.)

This scheme deals nicely with the original problem.  It allows us to
eliminate a couple of grotseque hacks
  - Note [Outputable Orig RdrName] in HscTypes
  - Note [interactive name cache] in IfaceEnv
(both these comments have gone, because the hacks they describe are no
longer necessary). I was also able to simplify Outputable.QueryQualifyName,
so that it takes a Module/OccName as args rather than a Name.

However, matters are never simple, and this change took me an
unreasonably long time to get right.  There are some details in
Note [The interactive package] in HscTypes.

23 files changed:
compiler/basicTypes/Module.lhs
compiler/basicTypes/Name.lhs
compiler/basicTypes/RdrName.lhs
compiler/deSugar/Desugar.lhs
compiler/ghci/Linker.lhs
compiler/ghci/RtClosureInspect.hs
compiler/iface/IfaceEnv.lhs
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/main/DynamicLoading.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.lhs
compiler/prelude/PrelNames.lhs
compiler/rename/RnEnv.lhs
compiler/rename/RnNames.lhs
compiler/simplCore/CoreMonad.lhs
compiler/typecheck/FamInst.lhs
compiler/typecheck/TcEnv.lhs
compiler/typecheck/TcRnDriver.lhs
compiler/typecheck/TcRnMonad.lhs
compiler/typecheck/TcRnTypes.lhs
compiler/typecheck/TcSplice.lhs
compiler/types/FamInstEnv.lhs
compiler/utils/Outputable.lhs

index f9e7942..90bf717 100644 (file)
@@ -41,6 +41,7 @@ module Module
         dphParPackageId,
         mainPackageId,
         thisGhcPackageId,
+        interactivePackageId, isInteractiveModule,
 
         -- * The Module type
         Module,
@@ -357,20 +358,24 @@ packageIdString = unpackFS . packageIdFS
 integerPackageId, primPackageId,
   basePackageId, rtsPackageId,
   thPackageId, dphSeqPackageId, dphParPackageId,
-  mainPackageId, thisGhcPackageId  :: PackageId
-primPackageId      = fsToPackageId (fsLit "ghc-prim")
-integerPackageId   = fsToPackageId (fsLit cIntegerLibrary)
-basePackageId      = fsToPackageId (fsLit "base")
-rtsPackageId       = fsToPackageId (fsLit "rts")
-thPackageId        = fsToPackageId (fsLit "template-haskell")
-dphSeqPackageId    = fsToPackageId (fsLit "dph-seq")
-dphParPackageId    = fsToPackageId (fsLit "dph-par")
-thisGhcPackageId   = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
+  mainPackageId, thisGhcPackageId, interactivePackageId  :: PackageId
+primPackageId        = fsToPackageId (fsLit "ghc-prim")
+integerPackageId     = fsToPackageId (fsLit cIntegerLibrary)
+basePackageId        = fsToPackageId (fsLit "base")
+rtsPackageId         = fsToPackageId (fsLit "rts")
+thPackageId          = fsToPackageId (fsLit "template-haskell")
+dphSeqPackageId      = fsToPackageId (fsLit "dph-seq")
+dphParPackageId      = fsToPackageId (fsLit "dph-par")
+thisGhcPackageId     = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
+interactivePackageId = fsToPackageId (fsLit "interactive")
 
 -- | This is the package Id for the current program.  It is the default
 -- package Id if you don't specify a package name.  We don't add this prefix
 -- to symbol names, since there can be only one main package per program.
 mainPackageId      = fsToPackageId (fsLit "main")
+
+isInteractiveModule :: Module -> Bool
+isInteractiveModule mod = modulePackageId mod == interactivePackageId
 \end{code}
 
 %************************************************************************
index bddf2de..e2742bb 100644 (file)
@@ -442,17 +442,17 @@ instance OutputableBndr Name where
 
 
 pprName :: Name -> SDoc
-pprName n@(Name {n_sort = sort, n_uniq = u, n_occ = occ})
+pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
   = getPprStyle $ \ sty ->
     case sort of
-      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
-      External mod            -> pprExternal sty uniq mod occ False UserSyntax
+      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
+      External mod            -> pprExternal sty uniq mod occ False UserSyntax
       System                  -> pprSystem sty uniq occ
       Internal                -> pprInternal sty uniq occ
   where uniq = mkUniqueGrimily (iBox u)
 
-pprExternal :: PprStyle -> Unique -> Module -> OccName -> Name -> Bool -> BuiltInSyntax -> SDoc
-pprExternal sty uniq mod occ name is_wired is_builtin
+pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
+pprExternal sty uniq mod occ is_wired is_builtin
   | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
         -- In code style, always qualify
         -- ToDo: maybe we could print all wired-in things unqualified
@@ -462,7 +462,7 @@ pprExternal sty uniq mod occ name is_wired is_builtin
                                       pprNameSpaceBrief (occNameSpace occ),
                                       pprUnique uniq])
   | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax
-  | otherwise                   = pprModulePrefix sty mod name <> ppr_occ_name occ
+  | otherwise                   = pprModulePrefix sty mod occ <> ppr_occ_name occ
   where
     pp_mod = sdocWithDynFlags $ \dflags ->
              if gopt Opt_SuppressModulePrefixes dflags
@@ -491,14 +491,14 @@ pprSystem sty uniq occ
                                 -- so print the unique
 
 
-pprModulePrefix :: PprStyle -> Module -> Name -> SDoc
+pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
 -- Print the "M." part of a name, based on whether it's in scope or not
 -- See Note [Printing original names] in HscTypes
-pprModulePrefix sty mod name = sdocWithDynFlags $ \dflags ->
+pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
   if gopt Opt_SuppressModulePrefixes dflags
   then empty
   else
-    case qualName sty name of              -- See Outputable.QualifyName:
+    case qualName sty mod occ of              -- See Outputable.QualifyName:
       NameQual modname -> ppr modname <> dot       -- Name is in scope
       NameNotInScope1  -> ppr mod <> dot           -- Not in scope
       NameNotInScope2  -> ppr (modulePackageId mod) <> colon     -- Module not in
index 56f48ae..4ffeae0 100644 (file)
@@ -265,9 +265,7 @@ instance Outputable RdrName where
     ppr (Exact name)   = ppr name
     ppr (Unqual occ)   = ppr occ
     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
-    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod name <> ppr occ)
-       where name = mkExternalName (mkUniqueGrimily 0) mod occ noSrcSpan
-         -- Note [Outputable Orig RdrName] in HscTypes
+    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
 
 instance OutputableBndr RdrName where
     pprBndr _ n
index 709f2fe..7ef407b 100644 (file)
@@ -34,7 +34,6 @@ import NameEnv
 import Rules
 import BasicTypes       ( Activation(.. ) )
 import CoreMonad        ( endPass, CoreToDo(..) )
-import PrelNames        ( iNTERACTIVE )
 import FastString
 import ErrUtils
 import Outputable
@@ -232,7 +231,7 @@ deSugarExpr hsc_env tc_expr
        ; showPass dflags "Desugar"
 
          -- Do desugaring
-       ; (msgs, mb_core_expr) <- initDs hsc_env iNTERACTIVE rdr_env
+       ; (msgs, mb_core_expr) <- initDs hsc_env (icInteractiveModule icntxt) rdr_env
                                         type_env fam_inst_env $
                                  dsLExpr tc_expr
 
index 62f7a70..eb3e226 100644 (file)
@@ -52,7 +52,6 @@ import FastString
 import Config
 import Platform
 import SysTools
-import PrelNames
 
 -- Standard libraries
 import Control.Monad
@@ -525,27 +524,26 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
 -- Find all the packages and linkables that a set of modules depends on
  = do {
         -- 1.  Find the dependent home-pkg-modules/packages from each iface
-        -- (omitting iINTERACTIVE, which is already linked)
-        (mods_s, pkgs_s) <- follow_deps (filter ((/=) iNTERACTIVE) mods)
+        -- (omitting modules from the interactive package, which is already linked)
+      ; (mods_s, pkgs_s) <- follow_deps (filterOut isInteractiveModule mods)
                                         emptyUniqSet emptyUniqSet;
 
-        let {
+      ; let {
         -- 2.  Exclude ones already linked
         --      Main reason: avoid findModule calls in get_linkable
             mods_needed = mods_s `minusList` linked_mods     ;
             pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
 
             linked_mods = map (moduleName.linkableModule)
-                                (objs_loaded pls ++ bcos_loaded pls)
-        } ;
+                                (objs_loaded pls ++ bcos_loaded pls)  }
 
         -- 3.  For each dependent module, find its linkable
         --     This will either be in the HPT or (in the case of one-shot
         --     compilation) we may need to use maybe_getFileLinkable
-        let { osuf = objectSuf dflags } ;
-        lnks_needed <- mapM (get_linkable osuf) mods_needed ;
+      ; let { osuf = objectSuf dflags }
+      ; lnks_needed <- mapM (get_linkable osuf) mods_needed
 
-        return (lnks_needed, pkgs_needed) }
+      ; return (lnks_needed, pkgs_needed) } 
   where
     dflags = hsc_dflags hsc_env
     this_pkg = thisPackage dflags
index eb1c644..76b8451 100644 (file)
@@ -569,7 +569,11 @@ runTR hsc_env thing = do
     Just x  -> return x
 
 runTR_maybe :: HscEnv -> TR a -> IO (Maybe a)
-runTR_maybe hsc_env = fmap snd . initTc hsc_env HsSrcFile False  iNTERACTIVE
+runTR_maybe hsc_env thing_inside
+  = do { (_errs, res) <- initTc hsc_env HsSrcFile False 
+                                (icInteractiveModule (hsc_IC hsc_env))
+                                thing_inside
+       ; return res }
 
 traceTR :: SDoc -> TR ()
 traceTR = liftTcM . traceOptTcRn Opt_D_dump_rtti
index ef102e4..42c3e32 100644 (file)
@@ -110,12 +110,14 @@ allocateGlobalBinder name_supply mod occ loc
         --           Their wired-in-ness is in their NameSort
         --           and their Module is correct.
 
-        Just name | isWiredInName name -> (name_supply, name)
-                  | mod /= iNTERACTIVE -> (new_name_supply, name')
-                     -- Note [interactive name cache]
+        Just name | isWiredInName name
+                  -> (name_supply, name)
+                  | otherwise
+                  -> (new_name_supply, name')
                   where
                     uniq            = nameUnique name
                     name'           = mkExternalName uniq mod occ loc
+                                      -- name' is like name, but with the right SrcSpan
                     new_cache       = extendNameCache (nsNames name_supply) mod occ name'
                     new_name_supply = name_supply {nsNames = new_cache}
 
@@ -128,16 +130,6 @@ allocateGlobalBinder name_supply mod occ loc
                     new_cache       = extendNameCache (nsNames name_supply) mod occ name
                     new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
 
-{- Note [interactive name cache]
-
-In GHCi we always create Names with the same Module, ":Interactive".
-However, we want to be able to shadow older declarations with newer
-ones, and we don't want the Name cache giving us back the same Unique
-for the new Name as for the old, hence this special case.
-
-See also Note [Outputable Orig RdrName] in HscTypes.
--}
-
 newImplicitBinder :: Name                      -- Base name
                  -> (OccName -> OccName)       -- Occurrence name modifier
                  -> TcRnIf m n Name            -- Implicit name
index fb9668b..5d5f385 100644 (file)
@@ -404,7 +404,7 @@ strDisplayName_llvm lbl = do
     dflags <- getDynFlags
     let sdoc = pprCLabel platform lbl
         depth = Outp.PartWay 1
-        style = Outp.mkUserStyle (const Outp.NameNotInScope2, const True) depth
+        style = Outp.mkUserStyle (\ _ _ -> Outp.NameNotInScope2, Outp.alwaysQualifyModules) depth
         str = Outp.renderWithStyle dflags sdoc style
     return (fsLit (dropInfoSuffix str))
 
@@ -422,7 +422,7 @@ strProcedureName_llvm lbl = do
     dflags <- getDynFlags
     let sdoc = pprCLabel platform lbl
         depth = Outp.PartWay 1
-        style = Outp.mkUserStyle (const Outp.NameUnqual, const False) depth
+        style = Outp.mkUserStyle Outp.neverQualify depth
         str = Outp.renderWithStyle dflags sdoc style
     return (fsLit str)
 
index 0498464..ffafc78 100644 (file)
@@ -5,10 +5,10 @@ module DynamicLoading (
         forceLoadModuleInterfaces,
         forceLoadNameModuleInterface,
         forceLoadTyCon,
-        
+
         -- * Finding names
         lookupRdrNameInModuleForPlugins,
-        
+
         -- * Loading values
         getValueSafely,
         getHValueSafely,
@@ -20,18 +20,16 @@ module DynamicLoading (
 import Linker           ( linkModule, getHValue )
 import SrcLoc           ( noSrcSpan )
 import Finder           ( findImportedModule, cannotFindModule )
-import DriverPhases     ( HscSource(HsSrcFile) )
-import TcRnMonad        ( initTc, initIfaceTcRn )
+import TcRnMonad        ( initTcInteractive, initIfaceTcRn )
 import LoadIface        ( loadPluginInterface )
 import RdrName          ( RdrName, Provenance(..), ImportSpec(..), ImpDeclSpec(..)
                         , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName, gre_name )
 import RnNames          ( gresFromAvails )
-import PrelNames        ( iNTERACTIVE )
 import DynFlags
 
-import HscTypes         ( HscEnv(..), FindResult(..), ModIface(..), lookupTypeHscEnv )
+import HscTypes
 import BasicTypes       ( HValue )
-import TypeRep          ( TyThing(..), pprTyThingCategory )
+import TypeRep          ( pprTyThingCategory )
 import Type             ( Type, eqType )
 import TyCon            ( TyCon )
 import Name             ( Name, nameModule_maybe )
@@ -52,7 +50,10 @@ import GHC.Exts          ( unsafeCoerce# )
 -- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
 forceLoadModuleInterfaces :: HscEnv -> SDoc -> [Module] -> IO ()
 forceLoadModuleInterfaces hsc_env doc modules
-    = (initTc hsc_env HsSrcFile False iNTERACTIVE $ initIfaceTcRn $ mapM_ (loadPluginInterface doc) modules) >> return ()
+    = (initTcInteractive hsc_env $
+       initIfaceTcRn $
+       mapM_ (loadPluginInterface doc) modules) 
+      >> return ()
 
 -- | Force the interface for the module containing the name to be loaded. The 'SDoc' parameter is used
 -- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
@@ -151,7 +152,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
     case found_module of
         Found _ mod -> do
             -- Find the exports of the module
-            (_, mb_iface) <- initTc hsc_env HsSrcFile False iNTERACTIVE $ initIfaceTcRn $ loadPluginInterface (ptext (sLit "contains a name used in an invocation of lookupRdrNameInModule")) mod
+            (_, mb_iface) <- initTcInteractive hsc_env $
+                             initIfaceTcRn $
+                             loadPluginInterface doc mod
             case mb_iface of
                 Just iface -> do
                     -- Try and find the required name in the exports
@@ -166,8 +169,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
 
                 Nothing -> throwCmdLineErrorS dflags $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name]
         err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
-  where dflags = hsc_dflags hsc_env
-
+  where
+    dflags = hsc_dflags hsc_env
+    doc = ptext (sLit "contains a name used in an invocation of lookupRdrNameInModule")
 
 wrongTyThingError :: Name -> TyThing -> SDoc
 wrongTyThingError name got_thing = hsep [ptext (sLit "The name"), ppr name, ptext (sLit "is not that of a value but rather a"), pprTyThingCategory got_thing]
index a6c187e..d2fa195 100644 (file)
@@ -283,9 +283,10 @@ hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do
       -- is used to indicate that.
 
 hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst]))
-hscTcRnGetInfo hsc_env0 name = runInteractiveHsc hsc_env0 $ do
-  hsc_env <- getHscEnv
-  ioMsgMaybe' $ tcRnGetInfo hsc_env name
+hscTcRnGetInfo hsc_env0 name
+  = runInteractiveHsc hsc_env0 $
+    do { hsc_env <- getHscEnv
+       ; ioMsgMaybe' $ tcRnGetInfo hsc_env name }
 
 #ifdef GHCI
 hscIsGHCiMonad :: HscEnv -> String -> IO Name
@@ -1327,7 +1328,7 @@ you run it you get a list of HValues that should be the same length as the list
 of names; add them to the ClosureEnv.
 
 A naked expression returns a singleton Name [it]. The stmt is lifted into the
-IO monad as explained in Note [Interactively-bound Ids in GHCi] in TcRnDriver
+IO monad as explained in Note [Interactively-bound Ids in GHCi] in HscTypes
 -}
 
 #ifdef GHCI
@@ -1349,16 +1350,18 @@ hscStmtWithLocation :: HscEnv
                     -> IO (Maybe ([Id], IO [HValue], FixityEnv))
 hscStmtWithLocation hsc_env0 stmt source linenumber =
  runInteractiveHsc hsc_env0 $ do
-    hsc_env <- getHscEnv
     maybe_stmt <- hscParseStmtWithLocation source linenumber stmt
     case maybe_stmt of
         Nothing -> return Nothing
 
         Just parsed_stmt -> do
             -- Rename and typecheck it
-            -- Here we lift the stmt into the IO monad, see Note
-            -- [Interactively-bound Ids in GHCi] in TcRnDriver
-            (ids, tc_expr, fix_env) <- ioMsgMaybe $ tcRnStmt hsc_env parsed_stmt
+            hsc_env <- getHscEnv
+            let interactive_hsc_env = setInteractivePackage hsc_env
+                  -- Bindings created here belong to the interactive package
+                  -- See Note [The interactive package] in HscTypes
+                  -- (NB: maybe not necessary, since Stmts bind only Ids)
+            (ids, tc_expr, fix_env) <- ioMsgMaybe $ tcRnStmt interactive_hsc_env parsed_stmt
 
             -- Desugar it
             ds_expr <- ioMsgMaybe $ deSugarExpr hsc_env tc_expr
@@ -1366,6 +1369,9 @@ hscStmtWithLocation hsc_env0 stmt source linenumber =
             handleWarnings
 
             -- Then code-gen, and link it
+            -- It's important NOT to have package 'interactive' as thisPackageId
+            -- for linking, else we try to link 'main' and can't find it.
+            -- Whereas the linker already knows to ignore 'interactive'
             let  src_span     = srcLocSpan interactiveSrcLoc
             hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
             let hval_io = unsafeCoerce# hval :: IO [HValue]
@@ -1386,12 +1392,15 @@ hscDeclsWithLocation :: HscEnv
                      -> IO ([TyThing], InteractiveContext)
 hscDeclsWithLocation hsc_env0 str source linenumber =
  runInteractiveHsc hsc_env0 $ do
-    hsc_env <- getHscEnv
     L _ (HsModule{ hsmodDecls = decls }) <-
         hscParseThingWithLocation source linenumber parseModule str
 
     {- Rename and typecheck it -}
-    tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env decls
+    hsc_env <- getHscEnv
+    let interactive_hsc_env = setInteractivePackage hsc_env
+            -- Bindings created here belong to the interactive package
+            -- See Note [The interactive package] in HscTypes
+    tc_gblenv <- ioMsgMaybe $ tcRnDeclsi interactive_hsc_env decls
 
     {- Grab the new instances -}
     -- We grab the whole environment because of the overlapping that may have
@@ -1432,7 +1441,6 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
                                 prepd_binds data_tycons mod_breaks
 
     let src_span = srcLocSpan interactiveSrcLoc
-    hsc_env <- getHscEnv
     liftIO $ linkDecls hsc_env src_span cbc
 
     let tcs = filterOut isImplicitTyCon (mg_tcs simpl_mg)
@@ -1611,7 +1619,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
          ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr
 
            {- Convert to BCOs -}
-         ; bcos <- coreExprToBCOs dflags iNTERACTIVE prepd_expr
+         ; bcos <- coreExprToBCOs dflags (icInteractiveModule (hsc_IC hsc_env)) prepd_expr
 
            {- link it -}
          ; hval <- linkExpr hsc_env srcspan bcos
index b7ea898..071f7ef 100644 (file)
@@ -31,7 +31,7 @@ module HscTypes (
 
         -- * State relating to modules in this package
         HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
-        hptInstances, hptRules, hptVectInfo,
+        hptInstances, hptRules, hptVectInfo, pprHPT,
         hptObjs,
 
         -- * State relating to known packages
@@ -50,8 +50,8 @@ module HscTypes (
         InteractiveContext(..), emptyInteractiveContext,
         icPrintUnqual, icInScopeTTs, icExtendGblRdrEnv,
         extendInteractiveContext, substInteractiveContext,
-        setInteractivePrintName,
-        InteractiveImport(..),
+        setInteractivePrintName, icInteractiveModule,
+        InteractiveImport(..), setInteractivePackage,
         mkPrintUnqualified, pprModulePrefix,
 
         -- * Interfaces
@@ -144,7 +144,7 @@ import Class
 import TyCon
 import CoAxiom
 import DataCon
-import PrelNames        ( gHC_PRIM, ioTyConName, printName )
+import PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )
 import Packages hiding  ( Version(..) )
 import DynFlags
 import DriverPhases     ( Phase, HscSource(..), isHsBoot, hscSourceString )
@@ -155,7 +155,7 @@ import Maybes
 import Outputable
 import BreakArray
 import SrcLoc
-import Unique
+-- import Unique
 import UniqFM
 import UniqSupply
 import FastString
@@ -168,7 +168,7 @@ import ErrUtils
 import Platform
 import Util
 
-import Control.Monad    ( mplus, guard, liftM, when, ap )
+import Control.Monad    ( guard, liftM, when, ap )
 import Data.Array       ( Array, array )
 import Data.IORef
 import Data.Time
@@ -218,12 +218,13 @@ runHsc hsc_env (Hsc hsc) = do
     printOrThrowWarnings (hsc_dflags hsc_env) w
     return a
 
+runInteractiveHsc :: HscEnv -> Hsc a -> IO a
 -- A variant of runHsc that switches in the DynFlags from the
 -- InteractiveContext before running the Hsc computation.
---
-runInteractiveHsc :: HscEnv -> Hsc a -> IO a
-runInteractiveHsc hsc_env =
-  runHsc (hsc_env { hsc_dflags = ic_dflags (hsc_IC hsc_env) })
+runInteractiveHsc hsc_env
+  = runHsc (hsc_env { hsc_dflags = interactive_dflags })
+  where
+    interactive_dflags = ic_dflags (hsc_IC hsc_env)
 
 -- -----------------------------------------------------------------------------
 -- Source Errors
@@ -451,6 +452,21 @@ emptyHomePackageTable  = emptyUFM
 emptyPackageIfaceTable :: PackageIfaceTable
 emptyPackageIfaceTable = emptyModuleEnv
 
+pprHPT :: HomePackageTable -> SDoc
+-- A bit aribitrary for now
+pprHPT hpt
+  = vcat [ hang (ppr (mi_module (hm_iface hm)))
+              2 (ppr (md_types (hm_details hm)))
+         | hm <- eltsUFM hpt ]
+
+lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
+-- The HPT is indexed by ModuleName, not Module,
+-- we must check for a hit on the right Module
+lookupHptByModule hpt mod
+  = case lookupUFM hpt (moduleName mod) of
+      Just hm | mi_module (hm_iface hm) == mod -> Just hm
+      _otherwise                               -> Nothing
+
 -- | Information about modules in the package being compiled
 data HomeModInfo
   = HomeModInfo {
@@ -487,15 +503,10 @@ lookupIfaceByModule
         -> PackageIfaceTable
         -> Module
         -> Maybe ModIface
-lookupIfaceByModule dflags hpt pit mod
-  | modulePackageId mod == thisPackage dflags
-        -- The module comes from the home package, so look first
-        -- in the HPT.  If it's not from the home package it's wrong to look
-        -- in the HPT, because the HPT is indexed by *ModuleName* not Module
-  = fmap hm_iface (lookupUFM hpt (moduleName mod))
-    `mplus` lookupModuleEnv pit mod
-
-  | otherwise = lookupModuleEnv pit mod         -- Look in PIT only
+lookupIfaceByModule _dflags hpt pit mod
+  = case lookupHptByModule hpt mod of
+       Just hm -> Just (hm_iface hm)
+       Nothing -> lookupModuleEnv pit mod
 
 -- If the module does come from the home package, why do we look in the PIT as well?
 -- (a) In OneShot mode, even home-package modules accumulate in the PIT
@@ -1080,6 +1091,110 @@ appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
 %*                                                                      *
 %************************************************************************
 
+Note [The interactive package]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Type and class declarations at the command prompt are treated as if
+they were defined in modules
+   interactive:Ghci1
+   interactive:Ghci2
+   ...etc...
+with each bunch of declarations using a new module, all sharing a
+common package 'interactive' (see Module.interactivePackageId, and
+PrelNames.mkInteractiveModule).
+
+This scheme deals well with shadowing.  For example:
+
+   ghci> data T = A
+   ghci> data T = B
+   ghci> :i A
+   data Ghci1.T = A  -- Defined at <interactive>:2:10
+
+Here we must display info about constructor A, but its type T has been
+shadowed by the second declaration.  But it has a respectable
+qualified name (Ghci1.T), and its source location says where it was
+defined.
+
+So the main invariant continues to hold, that in any session an original
+name M.T only refers to oe unique thing.  (In a previous iteration both
+the T's above were called :Interactive.T, albeit with different uniques,
+which gave rise to all sorts of trouble.)
+
+The details are a bit tricky though:
+
+ * The field ic_mod_index counts which Ghci module we've got up to.
+   It is incremented when extending ic_tythings
+
+ * ic_tythings contains only things from the 'interactive' package.
+
+ * Module from the 'interactive' package (Ghci1, Ghci2 etc) never go
+   in the Home Package Table (HPT).  When you say :load, that's when
+   extend the HPT.
+
+ * The 'thisPackage' field of DynFlags is *not* set to 'interactive'.
+   It stays as 'main' (or whatever -package-name says), and is the
+   package to which :load'ed modules are added to.
+
+ * So how do we arrange that declarations at the command prompt get
+   to be in the 'interactive' package?  By setting 'thisPackage' just
+   before the typecheck/rename step for command-line processing;
+   see the calls to HscTypes.setInteractivePackage in
+   HscMain.hscDeclsWithLocation and hscStmtWithLocation.
+
+ * The main trickiness is that the type environment (tcg_type_env and
+   fixity envt (tcg_fix_env) now contains entities from all the
+   GhciN modules together, rather than just a single module as is usually
+   the case.  So you can't use "nameIsLocalOrFrom" to decide whether
+   to look in the TcGblEnv vs the HPT/PTE.  This is a change, but not
+   a problem provided you know.
+
+
+Note [Interactively-bound Ids in GHCi]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The Ids bound by previous Stmts in GHCi are currently
+        a) GlobalIds
+        b) with an Internal Name (not External)
+        c) and a tidied type
+
+ (a) They must be GlobalIds (not LocalIds) otherwise when we come to
+     compile an expression using these ids later, the byte code
+     generator will consider the occurrences to be free rather than
+     global.
+
+ (b) They start with an Internal Name because a Stmt is a local
+     construct, so the renamer naturally builds an Internal name for
+     each of its binders.  It would be possible subsequently to give
+     them an External Name (in a GhciN module) but then we'd have
+     to substitute it out.  So for now they stay Internal.
+
+ (c) Their types are tidied. This is important, because :info may ask
+     to look at them, and :info expects the things it looks up to have
+     tidy types
+
+However note that TyCons, Classes, and even Ids bound by other top-level
+declarations in GHCi (eg foreign import, record selectors) currently get
+External Names, with Ghci9 (or 8, or 7, etc) as the module name. 
+
+
+Note [ic_tythings]
+~~~~~~~~~~~~~~~~~~
+The ic_tythings field contains
+  * The TyThings declared by the user at the command prompt
+    (eg Ids, TyCons, Classes)
+
+  * The user-visible Ids that arise from such things, which 
+    *don't* come from 'implicitTyThings', notably:
+       - record selectors
+       - class ops
+    The implicitTyThings are readily obtained from the TyThings
+    but record selectors etc are not
+
+It does *not* contain
+  * DFunIds (they can be gotten from ic_instances)
+  * CoAxioms (ditto)
+
+See also Note [Interactively-bound Ids in GHCi]
+
+
 \begin{code}
 -- | Interactive context, recording information about the state of the
 -- context in which statements are executed in a GHC session.
@@ -1089,28 +1204,33 @@ data InteractiveContext
              -- ^ The 'DynFlags' used to evaluate interative expressions
              -- and statements.
 
-         ic_monad      :: Name,
-             -- ^ The monad that GHCi is executing in
+         ic_mod_index :: Int,
+             -- ^ Each GHCi stmt or declaration brings some new things into
+             -- scope. We give them names like interactive:Ghci9.T,
+             -- where the ic_index is the '9'.  The ic_mod_index is
+             -- incremented whenever we add something to ic_tythings
+             -- See Note [The interactive package]
 
-         ic_imports    :: [InteractiveImport],
-             -- ^ The GHCi context is extended with these imports
+         ic_imports :: [InteractiveImport],
+             -- ^ The GHCi top-level scope (ic_rn_gbl_env) is extended with
+             -- these imports
              --
              -- 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_tythings   :: [TyThing],
+             -- ^ TyThings defined by the user, in reverse order of
+             -- definition (ie most recent at the front)
+             -- See Note [ic_tythings]
+
          ic_rn_gbl_env :: GlobalRdrEnv,
              -- ^ The cached 'GlobalRdrEnv', built by
              -- 'InteractiveEval.setContext' and updated regularly
              -- It contains everything in scope at the command line,
              -- including everything in ic_tythings
 
-         ic_tythings   :: [TyThing],
-             -- ^ TyThings defined by the user, in reverse order of
-             -- definition (ie most recent at the front)
-             -- See Note [ic_tythings]
-
          ic_instances  :: ([ClsInst], [FamInst]),
              -- ^ All instances and family instances created during
              -- this session.  These are grabbed en masse after each
@@ -1122,10 +1242,6 @@ data InteractiveContext
          ic_fix_env :: FixityEnv,
             -- ^ Fixities declared in let statements
 
-         ic_int_print  :: Name,
-             -- ^ The function that is used for printing results
-             -- of expressions in ghci and -e mode.
-
          ic_default :: Maybe [Type],
              -- ^ The current default types, set by a 'default' declaration
 
@@ -1134,49 +1250,50 @@ data InteractiveContext
              -- ^ The stack of breakpoint contexts
 #endif
 
-          ic_cwd :: Maybe FilePath
+         ic_monad      :: Name,
+             -- ^ The monad that GHCi is executing in
+
+         ic_int_print  :: Name,
+             -- ^ The function that is used for printing results
+             -- of expressions in ghci and -e mode.
+
+         ic_cwd :: Maybe FilePath
              -- virtual CWD of the program
     }
 
-{-
-Note [ic_tythings]
-~~~~~~~~~~~~~~~~~~
-The ic_tythings field contains
-  * The TyThings declared by the user at the command prompt
-    (eg Ids, TyCons, Classes)
-
-  * The user-visible Ids that arise from such things, which 
-    *don't* come from 'implicitTyThings', notably:
-       - record selectors
-       - class ops
-    The implicitTyThings are readily obtained from the TyThings
-    but record selectors etc are not
+data InteractiveImport
+  = IIDecl (ImportDecl RdrName)
+      -- ^ Bring the exports of a particular module
+      -- (filtered by an import decl) into scope
 
-It does *not* contain
-  * DFunIds (they can be gotten from ic_instances)
-  * CoAxioms (ditto)
+  | IIModule ModuleName
+      -- ^ Bring into scope the entire top-level envt of
+      -- of this module, including the things imported
+      -- into it.
 
-See also Note [Interactively-bound Ids in GHCi] in TcRnDriver
--}
 
 -- | Constructs an empty InteractiveContext.
 emptyInteractiveContext :: DynFlags -> InteractiveContext
 emptyInteractiveContext dflags
-  = InteractiveContext { ic_dflags     = dflags,
-                         -- IO monad by default
-                         ic_monad      = ioTyConName,
-                         ic_imports    = [],
-                         ic_rn_gbl_env = emptyGlobalRdrEnv,
-                         ic_tythings   = [],
-                         ic_instances  = ([],[]),
-                         ic_fix_env    = emptyNameEnv,
-                         -- System.IO.print by default
-                         ic_int_print  = printName,
-                         ic_default    = Nothing,
+  = InteractiveContext {
+       ic_dflags     = dflags,
+       ic_imports    = [],
+       ic_rn_gbl_env = emptyGlobalRdrEnv,
+       ic_mod_index  = 1,
+       ic_tythings   = [],
+       ic_instances  = ([],[]),
+       ic_fix_env    = emptyNameEnv,
+       ic_monad      = ioTyConName,  -- IO monad by default
+       ic_int_print  = printName,    -- System.IO.print by default
+       ic_default    = Nothing,
 #ifdef GHCI
-                         ic_resume     = [],
+       ic_resume     = [],
 #endif
-                         ic_cwd        = Nothing }
+       ic_cwd        = Nothing }
+
+icInteractiveModule :: InteractiveContext -> Module
+icInteractiveModule (InteractiveContext { ic_mod_index = index }) 
+  = mkInteractiveModule index
 
 -- | This function returns the list of visible TyThings (useful for
 -- e.g. showBindings)
@@ -1196,7 +1313,11 @@ icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } =
 -- not clear whether removing them is even the appropriate behavior.
 extendInteractiveContext :: InteractiveContext -> [TyThing] -> InteractiveContext
 extendInteractiveContext ictxt new_tythings
-  = ictxt { ic_tythings   = new_tythings ++ old_tythings
+  | null new_tythings
+  = ictxt
+  | otherwise
+  = ictxt { ic_mod_index  = ic_mod_index ictxt + 1
+          , ic_tythings   = new_tythings ++ old_tythings
           , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings
           }
   where
@@ -1207,6 +1328,11 @@ extendInteractiveContext ictxt new_tythings
 
     new_names = [ nameOccName (getName id) | AnId id <- new_tythings ]
 
+setInteractivePackage :: HscEnv -> HscEnv
+-- Set the 'thisPackage' DynFlag to 'interactive'
+setInteractivePackage hsc_env
+   = hsc_env { hsc_dflags = (hsc_dflags hsc_env) { thisPackage = interactivePackageId } }
+
 setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
 setInteractivePrintName ic n = ic{ic_int_print = n}
 
@@ -1231,16 +1357,6 @@ substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
     subst_ty (AnId id) = AnId $ id `setIdType` substTy subst (idType id)
     subst_ty tt        = tt
 
-data InteractiveImport
-  = IIDecl (ImportDecl RdrName)
-      -- ^ Bring the exports of a particular module
-      -- (filtered by an import decl) into scope
-
-  | IIModule ModuleName
-      -- ^ Bring into scope the entire top-level envt of
-      -- of this module, including the things imported
-      -- into it.
-
 instance Outputable InteractiveImport where
   ppr (IIModule m) = char '*' <> ppr m
   ppr (IIDecl d)   = ppr d
@@ -1288,30 +1404,26 @@ the (ppr mod) of case (3), in Name.pprModulePrefix
 mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
 mkPrintUnqualified dflags env = (qual_name, qual_mod)
   where
-  qual_name name
-        | [gre] <- unqual_gres, right_name gre = NameUnqual
+  qual_name mod occ
+        | [gre] <- unqual_gres
+        , right_name gre
+        = NameUnqual
                 -- If there's a unique entity that's in scope unqualified with 'occ'
                 -- AND that entity is the right one, then we can use the unqualified name
 
-        | [gre] <- qual_gres = NameQual (get_qual_mod (gre_prov gre))
+        | [gre] <- qual_gres
+        = NameQual (get_qual_mod (gre_prov gre))
 
-        | null qual_gres =
-              if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
-                   then NameNotInScope1
-                   else NameNotInScope2
+        | null qual_gres
+        = if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
+          then NameNotInScope1
+          else NameNotInScope2
 
-        | otherwise = NameNotInScope1   -- Can happen if 'f' is bound twice in the module
-                                        -- Eg  f = True; g = 0; f = False
+        | otherwise
+        = NameNotInScope1   -- Can happen if 'f' is bound twice in the module
+                            -- Eg  f = True; g = 0; f = False
       where
-        mod = nameModule name
-        occ = nameOccName name
-
-        is_rdr_orig = nameUnique name == mkUniqueGrimily 0
-         -- Note [Outputable Orig RdrName]
-
-        right_name gre
-          | is_rdr_orig = nameModule_maybe (gre_name gre) == Just mod
-          | otherwise   = gre_name gre == name
+        right_name gre = nameModule_maybe (gre_name gre) == Just mod
 
         unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
         qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)
@@ -1335,25 +1447,6 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
 
      | otherwise = True
      where lookup = lookupModuleInAllPackages dflags (moduleName mod)
-
--- Note [Outputable Orig RdrName]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- This is a Grotesque Hack.  The Outputable instance for RdrEnv wants
--- to print Orig names, which are just pairs of (Module,OccName).  But
--- we want to use full Names here, because in GHCi we might have Ids
--- that have the same (Module,OccName) pair but a different Unique
--- (this happens when you shadow a TyCon or Class in GHCi).
---
--- So in Outputable RdrName we just use a dummy Unique (0), and check
--- for it here.
---
--- Arguably GHCi is invalidating the assumption that (Module,OccName)
--- uniquely identifies an entity.  But we do want to be able to shadow
--- old declarations with new ones in GHCi, and it would be hard to
--- delete all references to the old declaration when that happened.
--- See also Note [interactive name cache] in IfaceEnv for somewhere
--- else that this broken assumption bites.
---
 \end{code}
 
 
@@ -1578,16 +1671,14 @@ lookupType :: DynFlags
            -> Maybe TyThing
 
 lookupType dflags hpt pte name
-  -- in one-shot, we don't use the HPT
-  | not (isOneShot (ghcMode dflags)) && modulePackageId mod == this_pkg
-  = do hm <- lookupUFM hpt (moduleName mod) -- Maybe monad
-       x <- lookupNameEnv (md_types (hm_details hm)) name
-       return x
-  | otherwise
+  | isOneShot (ghcMode dflags)  -- in one-shot, we don't use the HPT
   = lookupNameEnv pte name
+  | otherwise
+  = case lookupHptByModule hpt mod of
+       Just hm -> lookupNameEnv (md_types (hm_details hm)) name
+       Nothing -> lookupNameEnv pte name
   where
     mod = ASSERT2( isExternalName name, ppr name ) nameModule name
-    this_pkg = thisPackage dflags
 
 -- | As 'lookupType', but with a marginally easier-to-use interface
 -- if you have a 'HscEnv'
index 53cf251..3f00c62 100644 (file)
@@ -432,12 +432,9 @@ mAIN, rOOT_MAIN :: Module
 mAIN            = mkMainModule_ mAIN_NAME
 rOOT_MAIN       = mkMainModule (fsLit ":Main") -- Root module for initialisation
 
-        -- The ':xxx' makes a module name that the user can never
-        -- use himself.  The z-encoding for ':' is "ZC", so the z-encoded
-        -- module name still starts with a capital letter, which keeps
-        -- the z-encoded version consistent.
-iNTERACTIVE :: Module
-iNTERACTIVE    = mkMainModule (fsLit ":Interactive")
+mkInteractiveModule :: Int -> Module
+-- (mkInteractiveMoudule 9) makes module 'interactive:M9'
+mkInteractiveModule n = mkModule interactivePackageId (mkModuleName ("Ghci" ++ show n))
 
 pRELUDE_NAME, mAIN_NAME :: ModuleName
 pRELUDE_NAME   = mkModuleNameFS (fsLit "Prelude")
index c11cca0..d29c3f3 100644 (file)
@@ -64,7 +64,7 @@ import DataCon          ( dataConFieldLabels, dataConTyCon )
 import TyCon            ( isTupleTyCon, tyConArity )
 import PrelNames        ( mkUnboundName, isUnboundName, rOOT_MAIN, forall_tv_RDR )
 import ErrUtils         ( MsgDoc )
-import BasicTypes       ( Fixity(..), FixityDirection(..), minPrecedence )
+import BasicTypes       ( Fixity(..), FixityDirection(..), minPrecedence, defaultFixity )
 import SrcLoc
 import Outputable
 import Util
@@ -1136,17 +1136,18 @@ lookupFixityRn name
     -- where 'foo' is not in scope, should not give an error (Trac #7937)
 
   | otherwise
-  = do { this_mod <- getModule
-       ; if nameIsLocalOrFrom this_mod name
-         then lookup_local
-         else lookup_imported }
+  = do { local_fix_env <- getFixityEnv
+       ; case lookupNameEnv local_fix_env name of {
+           Just (FixItem _ fix) -> return fix ;
+           Nothing ->
+
+    do { this_mod <- getModule
+       ; if nameIsLocalOrFrom this_mod name || isInteractiveModule (nameModule name)
+               -- Interactive modules are all in the fixity env,
+               -- and don't have entries in the HPT
+         then return defaultFixity
+         else lookup_imported } } }
   where
-    lookup_local   -- It's defined in this module
-      = do { local_fix_env <- getFixityEnv
-           ; traceRn (text "lookupFixityRn: looking up name in local environment:" <+>
-                     vcat [ppr name, ppr local_fix_env])
-           ; return (lookupFixity local_fix_env name) }
-
     lookup_imported
       -- For imported names, we have to get their fixities by doing a
       -- loadInterfaceForName, and consulting the Ifaces that comes back
index 783823b..8231233 100644 (file)
@@ -347,7 +347,7 @@ created by its bindings.
 
 Note [Top-level Names in Template Haskell decl quotes]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-See also: Note [Interactively-bound Ids in GHCi] in TcRnDriver
+See also: Note [Interactively-bound Ids in GHCi] in HscTypes
 
 Consider a Template Haskell declaration quotation like this:
       module M where
index 62e45e0..3f89508 100644 (file)
@@ -257,7 +257,7 @@ lintInteractiveExpr what hsc_env expr
 interactiveInScope :: HscEnv -> [Var]
 -- In GHCi we may lint expressions, or bindings arising from 'deriving'
 -- clauses, that mention variables bound in the interactive context.
--- These are Local things (see Note [Interactively-bound Ids in GHCi] in TcRnDriver).
+-- These are Local things (see Note [Interactively-bound Ids in GHCi] in HscTypes).
 -- So we have to tell Lint about them, lest it reports them as out of scope.
 -- 
 -- We do this by find local-named things that may appear free in interactive
index ef47667..8821241 100644 (file)
@@ -244,10 +244,10 @@ tcExtendLocalFamInstEnv fam_insts thing_inside
                                           fam_insts
       ; let env' = env { tcg_fam_insts    = fam_insts'
                       , tcg_fam_inst_env = inst_env' }
-      ; setGblEnv env' thing_inside 
+      ; setGblEnv env' thing_inside
       }
 
--- Check that the proposed new instance is OK, 
+-- Check that the proposed new instance is OK,
 -- and then add it to the home inst env
 -- This must be lazy in the fam_inst arguments, see Note [Lazy axiom match]
 -- in FamInstEnv.lhs
@@ -258,10 +258,13 @@ addLocalFamInst (home_fie, my_fis) fam_inst
   = do { traceTc "addLocalFamInst" (ppr fam_inst)
 
        ; isGHCi <- getIsGHCi
+       ; mod <- getModule
+       ; traceTc "alfi" (ppr mod $$ ppr isGHCi)
+
            -- In GHCi, we *override* any identical instances
            -- that are also defined in the interactive context
-       ; let (home_fie', my_fis') 
+           -- Trac #7102
+       ; let (home_fie', my_fis')
                | isGHCi    = ( deleteFromFamInstEnv home_fie fam_inst
                              , filterOut (identicalFamInst fam_inst) my_fis)
                | otherwise = (home_fie, my_fis)
@@ -276,9 +279,8 @@ addLocalFamInst (home_fie, my_fis) fam_inst
        ; no_conflict <- checkForConflicts inst_envs fam_inst
        ; if no_conflict then
             return (home_fie'', fam_inst : my_fis')
-         else 
+         else
             return (home_fie,   my_fis) }
-
 \end{code}
 
 %************************************************************************
index 6be4772..1ac649b 100644 (file)
@@ -116,27 +116,24 @@ tcLookupGlobal :: Name -> TcM TyThing
 tcLookupGlobal name
   = do  {    -- Try local envt
           env <- getGblEnv
-        ; case lookupNameEnv (tcg_type_env env) name of { 
+        ; case lookupNameEnv (tcg_type_env env) name of {
                 Just thing -> return thing ;
                 Nothing    ->
-         
-                -- Should it have been in the local envt?
-          case nameModule_maybe name of {
-                Nothing -> notFound name ; -- Internal names can happen in GHCi
 
-                Just mod | mod == tcg_mod env   -- Names from this module 
-                         -> notFound name       -- should be in tcg_type_env
-                         | otherwise -> do
+                -- Should it have been in the local envt?
+          if nameIsLocalOrFrom (tcg_mod env) name
+          then notFound name  -- Internal names can happen in GHCi
+          else
 
            -- Try home package table and external package table
-        { mb_thing <- tcLookupImported_maybe name
+    do  { mb_thing <- tcLookupImported_maybe name
         ; case mb_thing of
             Succeeded thing -> return thing
             Failed msg      -> failWithTc msg
-        }}}}
+        }}}
 
 tcLookupField :: Name -> TcM Id         -- Returns the selector Id
-tcLookupField name 
+tcLookupField name
   = tcLookupId name     -- Note [Record field lookup]
 
 {- Note [Record field lookup]
index e1ea4d3..59dc175 100644 (file)
@@ -124,34 +124,35 @@ tcRnModule hsc_env hsc_src save_rn_syntax
    parsedModule@HsParsedModule {hpm_module=L loc this_module}
  = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
 
-   let { this_pkg = thisPackage (hsc_dflags hsc_env) ;
-         pair@(this_mod,_)
-            = case hsmodName this_module of
-                Nothing -- 'module M where' is omitted
-                    ->  (mAIN, srcLocSpan (srcSpanStart loc))
+      ; let { this_pkg = thisPackage (hsc_dflags hsc_env)
+            ; pair@(this_mod,_)
+                = case hsmodName this_module of
+                    Nothing -- 'module M where' is omitted
+                        ->  (mAIN, srcLocSpan (srcSpanStart loc))
 
-                Just (L mod_loc mod)  -- The normal case
-                    -> (mkModule this_pkg mod, mod_loc) } ;
+                    Just (L mod_loc mod)  -- The normal case
+                        -> (mkModule this_pkg mod, mod_loc) } ;
 
-   initTc hsc_env hsc_src save_rn_syntax this_mod $
-     tcRnModuleTcRnM hsc_env hsc_src parsedModule pair }
+      ; initTc hsc_env hsc_src save_rn_syntax this_mod $
+        tcRnModuleTcRnM hsc_env hsc_src parsedModule pair }
 
 tcRnModuleTcRnM :: HscEnv
                 -> HscSource
                 -> HsParsedModule
                 -> (Module, SrcSpan)
                 -> TcRn TcGblEnv
+-- Factored out separately so that a Core plugin can
+-- call the type checker directly
 tcRnModuleTcRnM hsc_env hsc_src
-   (HsParsedModule {
-      hpm_module =
-         (L loc (HsModule maybe_mod export_ies
-                          import_decls local_decls mod_deprec
-                          maybe_doc_hdr)),
-      hpm_src_files =
-         src_files
-   })
-   (this_mod, prel_imp_loc) =
-   setSrcSpan loc $
+                (HsParsedModule {
+                   hpm_module =
+                      (L loc (HsModule maybe_mod export_ies
+                                       import_decls local_decls mod_deprec
+                                       maybe_doc_hdr)),
+                   hpm_src_files = src_files
+                })
+                (this_mod, prel_imp_loc)
+ = setSrcSpan loc $
    do {         -- Deal with imports; first add implicit prelude
         implicit_prelude <- xoptM Opt_ImplicitPrelude;
         let { prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc
@@ -161,7 +162,7 @@ tcRnModuleTcRnM hsc_env hsc_src
              when (notNull prel_imports) $ addWarn (implicitPreludeWarn) ;
 
         tcg_env <- {-# SCC "tcRnImports" #-}
-                   tcRnImports hsc_env this_mod (prel_imports ++ import_decls) ;
+                   tcRnImports hsc_env (prel_imports ++ import_decls) ;
 
           -- If the whole module is warned about or deprecated 
           -- (via mod_deprec) record that in tcg_warns. If we do thereby add
@@ -239,11 +240,11 @@ implicitPreludeWarn
 %************************************************************************
 
 \begin{code}
-tcRnImports :: HscEnv -> Module
-            -> [LImportDecl RdrName] -> TcM TcGblEnv
-tcRnImports hsc_env this_mod import_decls
+tcRnImports :: HscEnv -> [LImportDecl RdrName] -> TcM TcGblEnv
+tcRnImports hsc_env import_decls
   = do  { (rn_imports, rdr_env, imports, hpc_info) <- rnImports import_decls ;
 
+        ; this_mod <- getModule
         ; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
               ; dep_mods = imp_dep_mods imports
 
@@ -269,7 +270,7 @@ tcRnImports hsc_env this_mod import_decls
                 -- Update the gbl env
         ; updGblEnv ( \ gbl ->
             gbl {
-              tcg_rdr_env      = plusOccEnv (tcg_rdr_env gbl) rdr_env,
+              tcg_rdr_env      = tcg_rdr_env gbl `plusGlobalRdrEnv` rdr_env,
               tcg_imports      = tcg_imports gbl `plusImportAvails` imports,
               tcg_rn_imports   = rn_imports,
               tcg_inst_env     = extendInstEnvList (tcg_inst_env gbl) home_insts,
@@ -1439,24 +1440,11 @@ get two defns for 'main' in the interface file!
 %*********************************************************
 
 \begin{code}
-setInteractiveContext :: HscEnv -> TcRn a -> TcRn a
-setInteractiveContext hsc_env thing_inside
-  = let -- Initialise the tcg_inst_env with instances from all home modules.
-        -- This mimics the more selective call to hptInstances in tcRnImports
-        icxt = hsc_IC hsc_env
-        (home_insts, home_fam_insts) = hptInstances hsc_env (\_ -> True)
-        (ic_insts, ic_finsts) = ic_instances icxt
-        ty_things = ic_tythings icxt
-
-        type_env1 = mkTypeEnvWithImplicits ty_things
-        type_env  = extendTypeEnvWithIds type_env1 (map instanceDFunId ic_insts)
-                    -- Putting the dfuns in the type_env is just
-                    -- to keep Core Lint happy
-
-        con_fields = [ (dataConName c, dataConFieldLabels c)
-                     | ATyCon t <- ic_tythings icxt
-                     , c <- tyConDataCons t ]
-    in
+runTcInteractive :: HscEnv -> TcRn a -> IO (Messages, Maybe a)
+-- Initialise the tcg_inst_env with instances from all home modules.
+-- This mimics the more selective call to hptInstances in tcRnImports
+runTcInteractive hsc_env thing_inside
+  = initTcInteractive hsc_env $
     do { traceTc "setInteractiveContext" $
             vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt))
                  , text "ic_insts:" <+> vcat (map (pprBndr LetBind . instanceDFunId) ic_insts)
@@ -1487,6 +1475,22 @@ setInteractiveContext hsc_env thing_inside
        ; setGblEnv gbl_env' $
          tcExtendGhciIdEnv ty_things $   -- See Note [Initialising the type environment for GHCi]
          thing_inside }                  -- in TcEnv
+  where
+    (home_insts, home_fam_insts) = hptInstances hsc_env (\_ -> True)
+
+    icxt                  = hsc_IC hsc_env
+    (ic_insts, ic_finsts) = ic_instances icxt
+    ty_things             = ic_tythings icxt
+
+    type_env1 = mkTypeEnvWithImplicits ty_things
+    type_env  = extendTypeEnvWithIds type_env1 (map instanceDFunId ic_insts)
+                -- Putting the dfuns in the type_env
+                -- is just to keep Core Lint happy
+
+    con_fields = [ (dataConName c, dataConFieldLabels c)
+                 | ATyCon t <- ty_things
+                 , c <- tyConDataCons t ]
+
 
 #ifdef GHCI
 -- | The returned [Id] is the list of new Ids bound by this statement. It can
@@ -1497,8 +1501,7 @@ setInteractiveContext hsc_env thing_inside
 tcRnStmt :: HscEnv -> GhciLStmt RdrName
          -> IO (Messages, Maybe ([Id], LHsExpr Id, FixityEnv))
 tcRnStmt hsc_env rdr_stmt
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env $ do {
+  = runTcInteractive hsc_env $ do {
 
     -- The real work is done here
     ((bound_ids, tc_expr), fix_env) <- tcUserStmt rdr_stmt ;
@@ -1511,7 +1514,7 @@ tcRnStmt hsc_env rdr_stmt
 
     traceTc "tcs 1" empty ;
     let { global_ids = map globaliseAndTidyId zonked_ids } ;
-        -- Note [Interactively-bound Ids in GHCi]
+        -- Note [Interactively-bound Ids in GHCi] in HscTypes
 
 {- ---------------------------------------------
    At one stage I removed any shadowed bindings from the type_env;
@@ -1543,29 +1546,6 @@ tcRnStmt hsc_env rdr_stmt
                                   nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
 \end{code}
 
-Note [Interactively-bound Ids in GHCi]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The Ids bound by previous Stmts in GHCi are currently
-        a) GlobalIds
-        b) with an Internal Name (not External)
-        c) and a tidied type
-
- (a) They must be GlobalIds (not LocalIds) otherwise when we come to
-     compile an expression using these ids later, the byte code
-     generator will consider the occurrences to be free rather than
-     global.
-
- (b) They retain their Internal names because we don't have a suitable
-     Module to name them with. We could revisit this choice.
-
- (c) Their types are tidied. This is important, because :info may ask
-     to look at them, and :info expects the things it looks up to have
-     tidy types
-
-However note that TyCons, Classes, and even Ids bound by other top-level
-declarations in GHCi (eg foreign import, record selectors) currently get
-External Names, with :INTERACTIVE as the module name.  This seems 
-totally inconsistent to me.
 
 --------------------------------------------------------------------------
                 Typechecking Stmts in GHCi
@@ -1605,11 +1585,11 @@ runPlans (p:ps) = tryTcLIE_ (runPlans ps) p
 -- | Typecheck (and 'lift') a stmt entered by the user in GHCi into the
 -- GHCi 'environemnt'.
 --
--- By 'lift' and 'environment we mean that the code is changed to execute
--- properly in an IO monad. See Note [Interactively-bound Ids in GHCi] above
--- for more details. We do this lifting by trying different ways ('plans') of
--- lifting the code into the IO monad and type checking each plan until one
--- succeeds.
+-- By 'lift' and 'environment we mean that the code is changed to
+-- execute properly in an IO monad. See Note [Interactively-bound Ids
+-- in GHCi] in HscTypes for more details. We do this lifting by trying
+-- different ways ('plans') of lifting the code into the IO monad and
+-- type checking each plan until one succeeds.
 tcUserStmt :: GhciLStmt RdrName -> TcM (PlanResult, FixityEnv)
 
 -- An expression typed at the prompt is treated very specially
@@ -1776,8 +1756,7 @@ getGhciStepIO = do
 
 isGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name)
 isGHCiMonad hsc_env ty
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env $ do
+  = runTcInteractive hsc_env $ do
         rdrEnv <- getGlobalRdrEnv
         let occIO = lookupOccEnv rdrEnv (mkOccName tcName ty)
         case occIO of
@@ -1802,8 +1781,7 @@ tcRnExpr :: HscEnv
          -> IO (Messages, Maybe Type)
 -- Type checks the expression and returns its most general type
 tcRnExpr hsc_env rdr_expr
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env $ do {
+  = runTcInteractive hsc_env $ do {
 
     (rn_expr, _fvs) <- rnLExpr rdr_expr ;
     failIfErrsM ;
@@ -1830,10 +1808,15 @@ tcRnExpr hsc_env rdr_expr
 tcRnImportDecls :: HscEnv
                 -> [LImportDecl RdrName]
                 -> IO (Messages, Maybe GlobalRdrEnv)
+-- Find the new chunk of GlobalRdrEnv created by this list of import
+-- decls.  In contract tcRnImports *extends* the TcGblEnv.
 tcRnImportDecls hsc_env import_decls
- =  initTcPrintErrors hsc_env iNTERACTIVE $
-    do { gbl_env <- tcRnImports hsc_env iNTERACTIVE import_decls
+ =  runTcInteractive hsc_env $
+    do { gbl_env <- updGblEnv zap_rdr_env $
+                    tcRnImports hsc_env import_decls
        ; return (tcg_rdr_env gbl_env) }
+  where
+    zap_rdr_env gbl_env = gbl_env { tcg_rdr_env = emptyGlobalRdrEnv }
 \end{code}
 
 tcRnType just finds the kind of a type
@@ -1844,8 +1827,7 @@ tcRnType :: HscEnv
          -> LHsType RdrName
          -> IO (Messages, Maybe (Type, Kind))
 tcRnType hsc_env normalise rdr_type
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env $ 
+  = runTcInteractive hsc_env $
     setXOptM Opt_PolyKinds $   -- See Note [Kind-generalise in tcRnType]
     do { (rn_type, _fvs) <- rnLHsType GHCiCtx rdr_type
        ; failIfErrsM
@@ -1889,8 +1871,7 @@ tcRnDeclsi :: HscEnv
            -> IO (Messages, Maybe TcGblEnv)
 
 tcRnDeclsi hsc_env local_decls =
-    initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env $ do
+  runTcInteractive hsc_env $ do
 
     ((tcg_env, tclcl_env), lie) <-
         captureConstraints $ tc_rn_src_decls emptyModDetails local_decls
@@ -1940,13 +1921,12 @@ tcRnDeclsi hsc_env local_decls =
 -- could not be found.
 getModuleInterface :: HscEnv -> Module -> IO (Messages, Maybe ModIface)
 getModuleInterface hsc_env mod
-  = initTc hsc_env HsSrcFile False iNTERACTIVE $
+  = runTcInteractive hsc_env $
     loadModuleInterface (ptext (sLit "getModuleInterface")) mod
 
 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Messages, Maybe [Name])
 tcRnLookupRdrName hsc_env rdr_name
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env $
+  = runTcInteractive hsc_env $
     lookup_rdr_name rdr_name
 
 lookup_rdr_name :: RdrName -> TcM [Name]
@@ -1981,8 +1961,7 @@ lookup_rdr_name rdr_name = do
 
 tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
 tcRnLookupName hsc_env name
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env $
+  = runTcInteractive hsc_env $
     tcRnLookupName' name
 
 -- To look up a name we have to look in the local environment (tcl_lcl)
@@ -2009,19 +1988,17 @@ tcRnGetInfo :: HscEnv
 --  *and* as a type or class constructor;
 -- hence the call to dataTcOccs, and we return up to two results
 tcRnGetInfo hsc_env name
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env  $ do
-
-        -- Load the interface for all unqualified types and classes
-        -- That way we will find all the instance declarations
-        -- (Packages have not orphan modules, and we assume that
-        --  in the home package all relevant modules are loaded.)
-    loadUnqualIfaces hsc_env (hsc_IC hsc_env)
-
-    thing  <- tcRnLookupName' name
-    fixity <- lookupFixityRn name
-    (cls_insts, fam_insts) <- lookupInsts thing
-    return (thing, fixity, cls_insts, fam_insts)
+  = runTcInteractive hsc_env $
+    do { loadUnqualIfaces hsc_env (hsc_IC hsc_env)
+           -- Load the interface for all unqualified types and classes
+           -- That way we will find all the instance declarations
+           -- (Packages have not orphan modules, and we assume that
+           --  in the home package all relevant modules are loaded.)
+
+       ; thing  <- tcRnLookupName' name
+       ; fixity <- lookupFixityRn name
+       ; (cls_insts, fam_insts) <- lookupInsts thing
+       ; return (thing, fixity, cls_insts, fam_insts) }
 
 lookupInsts :: TyThing -> TcM ([ClsInst],[FamInst])
 lookupInsts (ATyCon tc)
@@ -2057,13 +2034,16 @@ loadUnqualIfaces hsc_env ictxt
   where
     this_pkg = thisPackage (hsc_dflags hsc_env)
 
-    unqual_mods = filter ((/= this_pkg) . modulePackageId)
-                  [ nameModule name
-                  | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt),
-                    let name = gre_name gre,
-                    not (isInternalName name),
-                    isTcOcc (nameOccName name),  -- Types and classes only
-                    unQualOK gre ]               -- In scope unqualified
+    unqual_mods = [ mod
+                  | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)
+                  , let name = gre_name gre
+                  , not (isInternalName name)
+                  , let mod = nameModule name
+                  , not (modulePackageId mod == this_pkg || isInteractiveModule mod)
+                      -- Don't attempt to load an interface for stuff
+                      -- from the command line, or from the home package
+                  , isTcOcc (nameOccName name)   -- Types and classes only
+                  , unQualOK gre ]               -- In scope unqualified
     doc = ptext (sLit "Need interface for module whose export(s) are in scope unqualified")
 \end{code}
 
index d5a9383..c5c1c30 100644 (file)
@@ -199,17 +199,21 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
         return (msgs, final_res)
     }
 
-initTcPrintErrors       -- Used from the interactive loop only
-       :: HscEnv
-       -> Module
-       -> TcM r
-       -> IO (Messages, Maybe r)
 
-initTcPrintErrors env mod todo = initTc env HsSrcFile False mod todo
+initTcInteractive :: HscEnv -> TcM a -> IO (Messages, Maybe a)
+-- Initialise the type checker monad for use in GHCi
+initTcInteractive hsc_env thing_inside
+  = initTc hsc_env HsSrcFile False
+           (icInteractiveModule (hsc_IC hsc_env))
+           thing_inside
 
 initTcForLookup :: HscEnv -> TcM a -> IO a
-initTcForLookup hsc_env tcm
-    = do (msgs, m) <- initTc hsc_env HsSrcFile False iNTERACTIVE tcm
+-- The thing_inside is just going to look up something
+-- in the environment, so we don't need much setup
+initTcForLookup hsc_env thing_inside
+    = do (msgs, m) <- initTc hsc_env HsSrcFile False
+                             (icInteractiveModule (hsc_IC hsc_env))  -- Irrelevant really
+                             thing_inside
          case m of
              Nothing -> throwIO $ mkSrcErr $ snd msgs
              Just x -> return x
@@ -518,7 +522,8 @@ setModule :: Module -> TcRn a -> TcRn a
 setModule mod thing_inside = updGblEnv (\env -> env { tcg_mod = mod }) thing_inside
 
 getIsGHCi :: TcRn Bool
-getIsGHCi = do { mod <- getModule; return (mod == iNTERACTIVE) }
+getIsGHCi = do { mod <- getModule
+               ; return (isInteractiveModule mod) }
 
 getGHCiMonad :: TcRn Name
 getGHCiMonad = do { hsc <- getTopEnv; return (ic_monad $ hsc_IC hsc) }
index 1ad567e..052403c 100644 (file)
@@ -216,6 +216,7 @@ data TcGblEnv
 
         tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module
         tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module
+                                        -- See Note [The interactive package] in HscTypes
 
         tcg_type_env :: TypeEnv,
           -- ^ Global type env for the module we are compiling now.  All
@@ -224,6 +225,9 @@ data TcGblEnv
           --
           -- (Ids defined in this module start in the local envt, though they
           --  move to the global envt during zonking)
+          --
+          -- NB: for what "things in this module" means, see
+          -- Note [The interactive package] in HscTypes
 
         tcg_type_env_var :: TcRef TypeEnv,
                 -- Used only to initialise the interface-file
index 100ed34..b6186b8 100644 (file)
@@ -1110,15 +1110,18 @@ tcLookupTh name
   = do  { (gbl_env, lcl_env) <- getEnvs
         ; case lookupNameEnv (tcl_env lcl_env) name of {
                 Just thing -> return thing;
-                Nothing    -> do
-        { if nameIsLocalOrFrom (tcg_mod gbl_env) name
+                Nothing    ->
+
+          case lookupNameEnv (tcg_type_env gbl_env) name of {
+                Just thing -> return (AGlobal thing);
+                Nothing    ->
+
+          if nameIsLocalOrFrom (tcg_mod gbl_env) name
           then  -- It's defined in this module
-              case lookupNameEnv (tcg_type_env gbl_env) name of
-                Just thing -> return (AGlobal thing)
-                Nothing    -> failWithTc (notInEnv name)
+                failWithTc (notInEnv name)
 
-          else do               -- It's imported
-        { mb_thing <- tcLookupImported_maybe name
+          else
+     do { mb_thing <- tcLookupImported_maybe name
         ; case mb_thing of
             Succeeded thing -> return (AGlobal thing)
             Failed msg      -> failWithTc msg
index adf75bc..01375a3 100644 (file)
@@ -47,6 +47,7 @@ import Coercion
 import CoAxiom
 import VarSet
 import VarEnv
+import Module( isInteractiveModule )
 import Name
 import UniqFM
 import Outputable
@@ -353,6 +354,7 @@ extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm})
     add (FamIE items) _ = FamIE (ins_item:items)
 
 deleteFromFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv
+-- Used only for overriding in GHCi
 deleteFromFamInstEnv inst_env fam_inst@(FamInst {fi_fam = fam_nm})
  = adjustUFM adjust inst_env fam_nm
  where
@@ -361,13 +363,14 @@ deleteFromFamInstEnv inst_env fam_inst@(FamInst {fi_fam = fam_nm})
      = FamIE (filterOut (identicalFamInst fam_inst) items)
 
 identicalFamInst :: FamInst -> FamInst -> Bool
--- Same LHS, *and* the instance is defined in the same module
+-- Same LHS, *and* both instances are on the interactive command line
 -- Used for overriding in GHCi
 identicalFamInst (FamInst { fi_axiom = ax1 }) (FamInst { fi_axiom = ax2 })
-  =  nameModule (coAxiomName ax1) == nameModule (coAxiomName ax2)
-     && coAxiomTyCon ax1 == coAxiomTyCon ax2
-     && brListLength brs1 == brListLength brs2
-     && and (brListZipWith identical_ax_branch brs1 brs2)
+  =  isInteractiveModule (nameModule (coAxiomName ax1))
+  && isInteractiveModule (nameModule (coAxiomName ax2))
+  && coAxiomTyCon ax1 == coAxiomTyCon ax2
+  && brListLength brs1 == brListLength brs2
+  && and (brListZipWith identical_ax_branch brs1 brs2)
   where brs1 = coAxiomBranches ax1
         brs2 = coAxiomBranches ax2
         identical_ax_branch br1 br2
index f357208..9cf8c33 100644 (file)
@@ -53,7 +53,9 @@ module Outputable (
         -- * Controlling the style in which output is printed
         BindingSite(..),
 
-        PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
+        PprStyle, CodeStyle(..), PrintUnqualified,
+        alwaysQualify, alwaysQualifyNames, alwaysQualifyModules,
+        neverQualify, neverQualifyNames, neverQualifyModules,
         QualifyName(..),
         sdocWithDynFlags, sdocWithPlatform,
         getPprStyle, withPprStyle, withPprStyleDoc,
@@ -75,7 +77,7 @@ import {-# SOURCE #-}   DynFlags( DynFlags,
                                   useUnicodeQuotes,
                                   unsafeGlobalDynFlags )
 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
-import {-# SOURCE #-}   Name( Name, nameModule )
+import {-# SOURCE #-}   OccName( OccName )
 import {-# SOURCE #-}   StaticFlags( opt_PprStyle_Debug, opt_NoDebugOutput )
 
 import FastString
@@ -145,13 +147,20 @@ data Depth = AllTheWay
 -- purpose of the pair of functions that gets passed around
 -- when rendering 'SDoc'.
 
+type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
+
 -- | given an /original/ name, this function tells you which module
 -- name it should be qualified with when printing for the user, if
 -- any.  For example, given @Control.Exception.catch@, which is in scope
 -- as @Exception.catch@, this fuction will return @Just "Exception"@.
 -- Note that the return value is a ModuleName, not a Module, because
 -- in source code, names are qualified by ModuleNames.
-type QueryQualifyName = Name -> QualifyName
+type QueryQualifyName = Module -> OccName -> QualifyName
+
+-- | For a given module, we need to know whether to print it with
+-- a package name to disambiguate it.
+type QueryQualifyModule = Module -> Bool
+
 
 -- See Note [Printing original names] in HscTypes
 data QualifyName                        -- given P:M.T
@@ -164,18 +173,11 @@ data QualifyName                        -- given P:M.T
                 -- it is not in scope at all, and M.T is already bound in the
                 -- current scope, so we must refer to it as "P:M.T"
 
-
--- | For a given module, we need to know whether to print it with
--- a package name to disambiguate it.
-type QueryQualifyModule = Module -> Bool
-
-type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
-
 alwaysQualifyNames :: QueryQualifyName
-alwaysQualifyNames n = NameQual (moduleName (nameModule n))
+alwaysQualifyNames m _ = NameQual (moduleName m)
 
 neverQualifyNames :: QueryQualifyName
-neverQualifyNames _ = NameUnqual
+neverQualifyNames _ = NameUnqual
 
 alwaysQualifyModules :: QueryQualifyModule
 alwaysQualifyModules _ = True
@@ -296,8 +298,8 @@ sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform)
 
 \begin{code}
 qualName :: PprStyle -> QueryQualifyName
-qualName (PprUser (qual_name,_) _)  n = qual_name n
-qualName _other                     n = NameQual (moduleName (nameModule n))
+qualName (PprUser (qual_name,_) _)  mod occ = qual_name mod occ
+qualName _other                     mod _   = NameQual (moduleName mod)
 
 qualModule :: PprStyle -> QueryQualifyModule
 qualModule (PprUser (_,qual_mod) _)  m = qual_mod m