Revert "Support for multiple signature files in scope."
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 11 Jun 2015 22:24:27 +0000 (15:24 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 11 Jun 2015 22:37:04 +0000 (15:37 -0700)
This reverts commit a7524eaed33324e2155c47d4a705bef1d70a2b5b.

40 files changed:
compiler/deSugar/DsMonad.hs
compiler/ghci/Linker.hs
compiler/iface/LoadIface.hs
compiler/iface/MkIface.hs
compiler/main/DriverMkDepend.hs
compiler/main/DynamicLoading.hs
compiler/main/Finder.hs
compiler/main/GHC.hs
compiler/main/GhcMake.hs
compiler/main/HscTypes.hs
compiler/main/Packages.hs
docs/users_guide/separate_compilation.xml
ghc/Main.hs
testsuite/.gitignore
testsuite/tests/cabal/sigcabal02/Main.hs [deleted file]
testsuite/tests/cabal/sigcabal02/Makefile [deleted file]
testsuite/tests/cabal/sigcabal02/Setup.hs [deleted file]
testsuite/tests/cabal/sigcabal02/ShouldFail.hs [deleted file]
testsuite/tests/cabal/sigcabal02/all.T [deleted file]
testsuite/tests/cabal/sigcabal02/p/LICENSE [deleted file]
testsuite/tests/cabal/sigcabal02/p/Map.hsig [deleted file]
testsuite/tests/cabal/sigcabal02/p/P.hs [deleted file]
testsuite/tests/cabal/sigcabal02/p/Set.hsig [deleted file]
testsuite/tests/cabal/sigcabal02/p/p.cabal [deleted file]
testsuite/tests/cabal/sigcabal02/q/LICENSE [deleted file]
testsuite/tests/cabal/sigcabal02/q/Map.hsig [deleted file]
testsuite/tests/cabal/sigcabal02/q/Q.hs [deleted file]
testsuite/tests/cabal/sigcabal02/q/q.cabal [deleted file]
testsuite/tests/cabal/sigcabal02/sigcabal02.stderr [deleted file]
testsuite/tests/cabal/sigcabal02/sigcabal02.stdout [deleted file]
testsuite/tests/driver/recomp014/Makefile [deleted file]
testsuite/tests/driver/recomp014/all.T [deleted file]
testsuite/tests/driver/recomp014/recomp014.stdout [deleted file]
testsuite/tests/driver/sigof01/Makefile
testsuite/tests/driver/sigof01/all.T
testsuite/tests/driver/sigof01/sigof01i.script [deleted file]
testsuite/tests/driver/sigof01/sigof01i.stdout [deleted file]
testsuite/tests/driver/sigof01/sigof01i2.script [deleted file]
testsuite/tests/driver/sigof01/sigof01i2.stdout [deleted file]
testsuite/tests/package/package09e.stderr

index ad6a6b1..61beca2 100644 (file)
@@ -184,7 +184,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
                  else do {
                ; result <- liftIO $ findImportedModule hsc_env modname Nothing
                ; case result of
-                   FoundModule h -> loadModule err (fr_mod h)
+                   Found _ mod -> loadModule err mod
                    _           -> pprPgmError "Unable to use Data Parallel Haskell (DPH):" err
                } }
 
index 3e8423c..8c2a07c 100644 (file)
@@ -562,29 +562,23 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
 
         -- 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.
-        --     If the module is actually a signature, there won't be a
-        --     linkable (thus catMaybes)
+        --     compilation) we may need to use maybe_getFileLinkable
       ; let { osuf = objectSuf dflags }
-      ; lnks_needed <- fmap Maybes.catMaybes
-                     $ mapM (get_linkable osuf) mods_needed
+      ; lnks_needed <- mapM (get_linkable osuf) mods_needed
 
       ; return (lnks_needed, pkgs_needed) }
   where
     dflags = hsc_dflags hsc_env
     this_pkg = thisPackage dflags
 
-    -- | Given a list of modules @mods@, recursively discover all external
-    -- package and local module (according to @this_pkg@) dependencies.
-    --
-    -- The 'ModIface' contains the transitive closure of the module dependencies
-    -- within the current package, *except* for boot modules: if we encounter
-    -- a boot module, we have to find its real interface and discover the
-    -- dependencies of that.  Hence we need to traverse the dependency
-    -- tree recursively.  See bug #936, testcase ghci/prog007.
-    follow_deps :: [Module]                     -- modules to follow
-                -> UniqSet ModuleName           -- accum. module dependencies
-                -> UniqSet PackageKey           -- accum. package dependencies
+        -- The ModIface contains the transitive closure of the module dependencies
+        -- within the current package, *except* for boot modules: if we encounter
+        -- a boot module, we have to find its real interface and discover the
+        -- dependencies of that.  Hence we need to traverse the dependency
+        -- tree recursively.  See bug #936, testcase ghci/prog007.
+    follow_deps :: [Module]             -- modules to follow
+                -> UniqSet ModuleName         -- accum. module dependencies
+                -> UniqSet PackageKey          -- accum. package dependencies
                 -> IO ([ModuleName], [PackageKey]) -- result
     follow_deps []     acc_mods acc_pkgs
         = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs)
@@ -607,7 +601,6 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
                     where is_boot (m,True)  = Left m
                           is_boot (m,False) = Right m
 
-            -- Boot module dependencies which must be processed recursively
             boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps
             acc_mods'  = addListToUniqSet acc_mods (moduleName mod : mod_deps)
             acc_pkgs'  = addListToUniqSet acc_pkgs $ map fst pkg_deps
@@ -638,37 +631,30 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
 
     get_linkable osuf mod_name      -- A home-package module
         | Just mod_info <- lookupUFM hpt mod_name
-        = adjust_linkable (hm_iface mod_info)
-            (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
+        = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
         | otherwise
         = do    -- It's not in the HPT because we are in one shot mode,
                 -- so use the Finder to get a ModLocation...
-                -- ezyang: I don't actually know how to trigger this codepath,
-                -- seeing as this is GHCi logic. Template Haskell, maybe?
              mb_stuff <- findHomeModule hsc_env mod_name
              case mb_stuff of
-                  FoundExact loc mod -> found loc mod
+                  Found loc mod -> found loc mod
                   _ -> no_obj mod_name
         where
             found loc mod = do {
                 -- ...and then find the linkable for it
                mb_lnk <- findObjectLinkableMaybe mod loc ;
-               iface <- initIfaceCheck hsc_env $
-                            loadUserInterface False (text "getLinkDeps2") mod ;
                case mb_lnk of {
                   Nothing  -> no_obj mod ;
-                  Just lnk -> adjust_linkable iface lnk
+                  Just lnk -> adjust_linkable lnk
               }}
 
-            adjust_linkable iface lnk
-                -- Signatures have no linkables! Don't return one.
-                | Just _ <- mi_sig_of iface = return Nothing
+            adjust_linkable lnk
                 | Just new_osuf <- replace_osuf = do
                         new_uls <- mapM (adjust_ul new_osuf)
                                         (linkableUnlinked lnk)
-                        return (Just lnk{ linkableUnlinked=new_uls })
+                        return lnk{ linkableUnlinked=new_uls }
                 | otherwise =
-                        return (Just lnk)
+                        return lnk
 
             adjust_ul new_osuf (DotO file) = do
                 MASSERT(osuf `isSuffixOf` file)
index defaa91..c88ad14 100644 (file)
@@ -297,17 +297,12 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
   -- interface; it will call the Finder again, but the ModLocation will be
   -- cached from the first search.
   = do { hsc_env <- getTopEnv
+       -- ToDo: findImportedModule should return a list of interfaces
        ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
        ; case res of
-           FoundModule (FoundHs { fr_mod = mod })
-            -> fmap (fmap (:[]))
-             . initIfaceTcRn
-             $ loadInterface doc mod (ImportByUser want_boot)
-           FoundSigs mods _backing
-            -> initIfaceTcRn $ do
-               ms <- forM mods $ \(FoundHs { fr_mod = mod }) ->
-                          loadInterface doc mod (ImportByUser want_boot)
-               return (sequence ms)
+           Found _ mod -> fmap (fmap (:[]))
+                        . initIfaceTcRn
+                        $ loadInterface doc mod (ImportByUser want_boot)
            err         -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
 
 -- | Load interface directly for a fully qualified 'Module'.  (This is a fairly
@@ -772,7 +767,7 @@ findAndReadIface doc_str mod hi_boot_file
                hsc_env <- getTopEnv
                mb_found <- liftIO (findExactModule hsc_env mod)
                case mb_found of
-                   FoundExact loc mod -> do
+                   Found loc mod -> do
 
                        -- Found file, so read it
                        let file_path = addBootSuffix_maybe hi_boot_file
@@ -789,8 +784,7 @@ findAndReadIface doc_str mod hi_boot_file
                        traceIf (ptext (sLit "...not found"))
                        dflags <- getDynFlags
                        return (Failed (cannotFindInterface dflags
-                                           (moduleName mod)
-                                           (convFindExactResult err)))
+                                           (moduleName mod) err))
     where read_file file_path = do
               traceIf (ptext (sLit "readIFace") <+> text file_path)
               read_result <- readIface mod file_path
index e897daa..c1a9d25 100644 (file)
@@ -1335,20 +1335,9 @@ checkDependencies hsc_env summary iface
      find_res <- liftIO $ findImportedModule hsc_env mod (fmap snd pkg)
      let reason = moduleNameString mod ++ " changed"
      case find_res of
-        FoundModule h -> check_mod reason (fr_mod h)
-        FoundSigs hs _backing -> check_mods reason (map fr_mod hs)
-        _otherwise  -> return (RecompBecause reason)
-
-   check_mods _ [] = return UpToDate
-   check_mods reason (m:ms) = do
-        r <- check_mod reason m
-        case r of
-            UpToDate -> check_mods reason ms
-            _otherwise -> return r
-
-   check_mod reason mod
+        Found _ mod
           | pkg == this_pkg
-            = if moduleName mod `notElem` map fst prev_dep_mods
+           -> if moduleName mod `notElem` map fst prev_dep_mods
                  then do traceHiDiffs $
                            text "imported module " <> quotes (ppr mod) <>
                            text " not among previous dependencies"
@@ -1356,7 +1345,7 @@ checkDependencies hsc_env summary iface
                  else
                          return UpToDate
           | otherwise
-            = if pkg `notElem` (map fst prev_dep_pkgs)
+           -> if pkg `notElem` (map fst prev_dep_pkgs)
                  then do traceHiDiffs $
                            text "imported module " <> quotes (ppr mod) <>
                            text " is from package " <> quotes (ppr pkg) <>
@@ -1365,6 +1354,7 @@ checkDependencies hsc_env summary iface
                  else
                          return UpToDate
            where pkg = modulePackageKey mod
+        _otherwise  -> return (RecompBecause reason)
 
 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
               -> IfG RecompileRequired
index c51feeb..310007d 100644 (file)
@@ -248,7 +248,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
                 -- we've done it once during downsweep
           r <- findImportedModule hsc_env imp pkg
         ; case r of
-            FoundModule (FoundHs { fr_loc = loc })
+            Found loc _
                 -- Home package: just depend on the .hi or hi-boot file
                 | isJust (ml_hs_file loc) || include_pkg_deps
                 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
@@ -257,9 +257,6 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
                 | otherwise
                 -> return Nothing
 
-            -- TODO: FoundSignature.  For now, we assume home package
-            -- "signature" dependencies look like FoundModule.
-
             fail ->
                 let dflags = hsc_dflags hsc_env
                 in throwOneError $ mkPlainErrMsg dflags srcloc $
index 3b62717..0d72bec 100644 (file)
@@ -203,15 +203,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
     -- First find the package the module resides in by searching exposed packages and home modules
     found_module <- findImportedModule hsc_env mod_name Nothing
     case found_module of
-        FoundModule h -> check_mod (fr_mod h)
-        FoundSigs hs _backing  -> check_mods (map fr_mod hs) -- (not tested)
-        err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
-  where
-    dflags = hsc_dflags hsc_env
-    meth = "lookupRdrNameInModule"
-    doc = ptext (sLit $ "contains a name used in an invocation of " ++ meth)
-
-    check_mod mod = do
+        Found _ mod -> do
             -- Find the exports of the module
             (_, mb_iface) <- initTcInteractive hsc_env $
                              initIfaceTcRn $
@@ -229,13 +221,10 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
                         _     -> panic "lookupRdrNameInModule"
 
                 Nothing -> throwCmdLineErrorS dflags $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name]
-
-    check_mods [] = return Nothing
-    check_mods (m:ms) = do
-        r <- check_mod m
-        case r of
-            Nothing -> check_mods ms
-            Just _ -> return r
+        err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
+  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 d8aef57..00ba038 100644 (file)
@@ -9,7 +9,6 @@
 module Finder (
     flushFinderCaches,
     FindResult(..),
-    convFindExactResult, -- move to HscTypes?
     findImportedModule,
     findExactModule,
     findHomeModule,
@@ -46,7 +45,8 @@ import System.Directory
 import System.FilePath
 import Control.Monad
 import Data.Time
-import Data.List        ( foldl', partition )
+import Data.List        ( foldl' )
+
 
 type FileExt = String   -- Filename extension
 type BaseName = String  -- Basename of file
@@ -75,7 +75,7 @@ flushFinderCaches hsc_env =
         is_ext mod _ | modulePackageKey mod /= this_pkg = True
                      | otherwise = False
 
-addToFinderCache :: IORef FinderCache -> Module -> FindExactResult -> IO ()
+addToFinderCache :: IORef FinderCache -> Module -> FindResult -> IO ()
 addToFinderCache ref key val =
   atomicModifyIORef' ref $ \c -> (extendModuleEnv c key val, ())
 
@@ -83,7 +83,7 @@ removeFromFinderCache :: IORef FinderCache -> Module -> IO ()
 removeFromFinderCache ref key =
   atomicModifyIORef' ref $ \c -> (delModuleEnv c key, ())
 
-lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindExactResult)
+lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindResult)
 lookupFinderCache ref key = do
    c <- readIORef ref
    return $! lookupModuleEnv c key
@@ -104,7 +104,7 @@ findImportedModule hsc_env mod_name mb_pkg =
         Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
                  | otherwise           -> pkg_import
   where
-    home_import   = convFindExactResult `fmap` findHomeModule hsc_env mod_name
+    home_import   = findHomeModule hsc_env mod_name
 
     pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg
 
@@ -118,7 +118,7 @@ findImportedModule hsc_env mod_name mb_pkg =
 -- reading the interface for a module mentioned by another interface,
 -- for example (a "system import").
 
-findExactModule :: HscEnv -> Module -> IO FindExactResult
+findExactModule :: HscEnv -> Module -> IO FindResult
 findExactModule hsc_env mod =
     let dflags = hsc_dflags hsc_env
     in if modulePackageKey mod == thisPackage dflags
@@ -152,45 +152,17 @@ orIfNotFound this or_this = do
 -- been done.  Otherwise, do the lookup (with the IO action) and save
 -- the result in the finder cache and the module location cache (if it
 -- was successful.)
-homeSearchCache :: HscEnv
-                -> ModuleName
-                -> IO FindExactResult
-                -> IO FindExactResult
+homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
 homeSearchCache hsc_env mod_name do_this = do
   let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
   modLocationCache hsc_env mod do_this
 
--- | Converts a 'FindExactResult' into a 'FindResult' in the obvious way.
-convFindExactResult :: FindExactResult -> FindResult
-convFindExactResult (FoundExact loc m) = FoundModule (FoundHs loc m)
-convFindExactResult (NoPackageExact pk) = NoPackage pk
-convFindExactResult NotFoundExact { fer_paths = paths, fer_pkg = pkg } =
-    NotFound {
-        fr_paths = paths, fr_pkg = pkg,
-        fr_pkgs_hidden = [], fr_mods_hidden = [], fr_suggestions = []
-    }
-
-foundExact :: FindExactResult -> Bool
-foundExact FoundExact{} = True
-foundExact _ = False
-
 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
                          -> IO FindResult
 findExposedPackageModule hsc_env mod_name mb_pkg
   = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of
-     LookupFound (m, _) -> do
-       fmap convFindExactResult (findPackageModule hsc_env m)
-     LookupFoundSigs ms backing -> do
-       locs <- mapM (findPackageModule hsc_env . fst) ms
-       let (ok, missing) = partition foundExact locs
-       case missing of
-        -- At the moment, we return the errors one at a time.  It might be
-        -- better if we collected them up and reported them all, but
-        -- FindResult doesn't have enough information to support this.
-        -- In any case, this REALLY shouldn't happen (it means there are
-        -- broken packages in the database.)
-        (m:_) -> return (convFindExactResult m)
-        _ -> return (FoundSigs [FoundHs l m | FoundExact l m <- ok] backing)
+     LookupFound m pkg_conf ->
+       findPackageModule_ hsc_env m pkg_conf
      LookupMultiple rs ->
        return (FoundMultiple rs)
      LookupHidden pkg_hiddens mod_hiddens ->
@@ -204,7 +176,7 @@ findExposedPackageModule hsc_env mod_name mb_pkg
                        , fr_mods_hidden = []
                        , fr_suggestions = suggest })
 
-modLocationCache :: HscEnv -> Module -> IO FindExactResult -> IO FindExactResult
+modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
 modLocationCache hsc_env mod do_this = do
   m <- lookupFinderCache (hsc_FC hsc_env) mod
   case m of
@@ -217,7 +189,7 @@ modLocationCache hsc_env mod do_this = do
 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
 addHomeModuleToFinder hsc_env mod_name loc = do
   let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
-  addToFinderCache (hsc_FC hsc_env) mod (FoundExact loc mod)
+  addToFinderCache (hsc_FC hsc_env) mod (Found loc mod)
   return mod
 
 uncacheModule :: HscEnv -> ModuleName -> IO ()
@@ -244,7 +216,7 @@ uncacheModule hsc_env mod = do
 --
 --  4. Some special-case code in GHCi (ToDo: Figure out why that needs to
 --  call this.)
-findHomeModule :: HscEnv -> ModuleName -> IO FindExactResult
+findHomeModule :: HscEnv -> ModuleName -> IO FindResult
 findHomeModule hsc_env mod_name =
    homeSearchCache hsc_env mod_name $
    let
@@ -275,19 +247,19 @@ findHomeModule hsc_env mod_name =
   -- This is important only when compiling the base package (where GHC.Prim
   -- is a home module).
   if mod == gHC_PRIM
-        then return (FoundExact (error "GHC.Prim ModLocation") mod)
+        then return (Found (error "GHC.Prim ModLocation") mod)
         else searchPathExts home_path mod exts
 
 
 -- | Search for a module in external packages only.
-findPackageModule :: HscEnv -> Module -> IO FindExactResult
+findPackageModule :: HscEnv -> Module -> IO FindResult
 findPackageModule hsc_env mod = do
   let
         dflags = hsc_dflags hsc_env
         pkg_id = modulePackageKey mod
   --
   case lookupPackage dflags pkg_id of
-     Nothing -> return (NoPackageExact pkg_id)
+     Nothing -> return (NoPackage pkg_id)
      Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
 
 -- | Look up the interface file associated with module @mod@.  This function
@@ -297,14 +269,14 @@ findPackageModule hsc_env mod = do
 -- the 'PackageConfig' must be consistent with the package key in the 'Module'.
 -- The redundancy is to avoid an extra lookup in the package state
 -- for the appropriate config.
-findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindExactResult
+findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
 findPackageModule_ hsc_env mod pkg_conf =
   ASSERT( modulePackageKey mod == packageConfigId pkg_conf )
   modLocationCache hsc_env mod $
 
   -- special case for GHC.Prim; we won't find it in the filesystem.
   if mod == gHC_PRIM
-        then return (FoundExact (error "GHC.Prim ModLocation") mod)
+        then return (Found (error "GHC.Prim ModLocation") mod)
         else
 
   let
@@ -327,7 +299,7 @@ findPackageModule_ hsc_env mod pkg_conf =
           -- don't bother looking for it.
           let basename = moduleNameSlashes (moduleName mod)
           loc <- mk_hi_loc one basename
-          return (FoundExact loc mod)
+          return (Found loc mod)
     _otherwise ->
           searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
 
@@ -342,7 +314,7 @@ searchPathExts
         FilePath -> BaseName -> IO ModLocation  -- action
        )
      ]
-  -> IO FindExactResult
+  -> IO FindResult
 
 searchPathExts paths mod exts
    = do result <- search to_search
@@ -368,13 +340,15 @@ searchPathExts paths mod exts
                       file = base <.> ext
                 ]
 
-    search [] = return (NotFoundExact {fer_paths = map fst to_search
-                                      ,fer_pkg   = Just (modulePackageKey mod)})
+    search [] = return (NotFound { fr_paths = map fst to_search
+                                 , fr_pkg   = Just (modulePackageKey mod)
+                                 , fr_mods_hidden = [], fr_pkgs_hidden = []
+                                 , fr_suggestions = [] })
 
     search ((file, mk_result) : rest) = do
       b <- doesFileExist file
       if b
-        then do { loc <- mk_result; return (FoundExact loc mod) }
+        then do { loc <- mk_result; return (Found loc mod) }
         else search rest
 
 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
@@ -597,8 +571,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
                    vcat (map mod_hidden mod_hiddens) $$
                    tried_these files
 
-            _ -> pprPanic "cantFindErr"
-                   (ptext cannot_find <+> quotes (ppr mod_name))
+            _ -> panic "cantFindErr"
 
     build_tag = buildTag dflags
 
index d6aa227..39af5fa 100644 (file)
@@ -1377,20 +1377,6 @@ showRichTokenStream ts = go startLoc ts ""
 -- | Takes a 'ModuleName' and possibly a 'PackageKey', and consults the
 -- filesystem and package database to find the corresponding 'Module', 
 -- using the algorithm that is used for an @import@ declaration.
---
--- However, there is a twist for local modules, see #2682.
---
--- The full algorithm:
--- IF it's a package qualified import for a REMOTE package (not @this_pkg@ or
--- this), do a normal lookup.
--- OTHERWISE see if it is ALREADY loaded, and use it if it is.
--- OTHERWISE do a normal lookup, but reject the result if the found result
--- is from the LOCAL package (@this_pkg@).
---
--- For signatures, we return the BACKING implementation to keep the API
--- consistent with what we had before. (ToDo: create a new GHC API which
--- can deal with signatures.)
---
 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
   let 
@@ -1401,23 +1387,17 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
     Just pkg | fsToPackageKey pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
       res <- findImportedModule hsc_env mod_name maybe_pkg
       case res of
-        FoundModule h -> return (fr_mod h)
-        FoundSigs _ backing -> return backing
+        Found _ m -> return m
         err       -> throwOneError $ noModError dflags noSrcSpan mod_name err
     _otherwise -> do
       home <- lookupLoadedHomeModule mod_name
       case home of
-        -- TODO: This COULD be a signature
         Just m  -> return m
         Nothing -> liftIO $ do
            res <- findImportedModule hsc_env mod_name maybe_pkg
            case res of
-             FoundModule (FoundHs { fr_mod = m, fr_loc = loc })
-                | modulePackageKey m /= this_pkg -> return m
-                | otherwise -> modNotLoadedError dflags m loc
-             FoundSigs (FoundHs { fr_loc = loc, fr_mod = m }:_) backing
-                | modulePackageKey m /= this_pkg -> return backing
-                | otherwise -> modNotLoadedError dflags m loc
+             Found loc m | modulePackageKey m /= this_pkg -> return m
+                         | otherwise -> modNotLoadedError dflags m loc
              err -> throwOneError $ noModError dflags noSrcSpan mod_name err
 
 modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a
@@ -1438,13 +1418,11 @@ 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
-    -- TODO: This COULD be a signature
     Just m  -> return m
     Nothing -> liftIO $ do
       res <- findExposedPackageModule hsc_env mod_name Nothing
       case res of
-        FoundModule (FoundHs { fr_mod = m }) -> return m
-        FoundSigs _ backing -> return backing
+        Found _ m -> return m
         err       -> throwOneError $ noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
 
 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
index 89cab9e..2d1d9eb 100644 (file)
@@ -1815,10 +1815,7 @@ findSummaryBySourceFile summaries file
         [] -> Nothing
         (x:_) -> Just x
 
--- | Summarise a module, and pick up source and timestamp.
--- Returns @Nothing@ if the module is excluded via @excl_mods@ or is an
--- external package module (which we don't compile), otherwise returns the
--- new module summary (or an error saying why we couldn't summarise it).
+-- Summarise a module, and pick up source and timestamp.
 summariseModule
           :: HscEnv
           -> NodeMap ModSummary -- Map of old summaries
@@ -1880,10 +1877,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
         uncacheModule hsc_env wanted_mod
         found <- findImportedModule hsc_env wanted_mod Nothing
         case found of
-             -- TODO: When we add -alias support, we can validly find
-             -- multiple signatures in the home package; need to make this
-             -- logic more flexible in that case.
-             FoundModule (FoundHs { fr_loc = location, fr_mod = mod })
+             Found location mod
                 | isJust (ml_hs_file location) ->
                         -- Home package
                          just_found location mod
@@ -1892,15 +1886,6 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                         ASSERT(modulePackageKey mod /= thisPackage dflags)
                         return Nothing
 
-             FoundSigs hs _backing
-                | Just (FoundHs { fr_loc = location, fr_mod = mod })
-                  <- find (isJust . ml_hs_file . fr_loc) hs ->
-                        just_found location mod
-                | otherwise ->
-                        ASSERT(all (\h -> modulePackageKey (fr_mod h)
-                                            /= thisPackage dflags) hs)
-                        return Nothing
-
              err -> return $ Just $ Left $ noModError dflags loc wanted_mod err
                         -- Not found
 
index f834e17..67b0694 100644 (file)
@@ -10,7 +10,7 @@
 module HscTypes (
         -- * compilation state
         HscEnv(..), hscEPS,
-        FinderCache, FindResult(..), FoundHs(..), FindExactResult(..),
+        FinderCache, FindResult(..),
         Target(..), TargetId(..), pprTarget, pprTargetId,
         ModuleGraph, emptyMG,
         HscStatus(..),
@@ -674,30 +674,15 @@ prepareAnnotations hsc_env mb_guts = do
 -- modules along the search path. On @:load@, we flush the entire
 -- contents of this cache.
 --
-type FinderCache = ModuleEnv FindExactResult
-
--- | The result of search for an exact 'Module'.
-data FindExactResult
-    = FoundExact ModLocation Module
-        -- ^ The module/signature was found
-    | NoPackageExact PackageKey
-    | NotFoundExact
-        { fer_paths     :: [FilePath]
-        , fer_pkg       :: Maybe PackageKey
-        }
-
--- | A found module or signature; e.g. anything with an interface file
-data FoundHs = FoundHs { fr_loc :: ModLocation
-                       , fr_mod :: Module
-                       -- , fr_origin :: ModuleOrigin
-                       }
+-- Although the @FinderCache@ range is 'FindResult' for convenience,
+-- in fact it will only ever contain 'Found' or 'NotFound' entries.
+--
+type FinderCache = ModuleEnv FindResult
 
 -- | The result of searching for an imported module.
 data FindResult
-  = FoundModule FoundHs
+  = Found ModLocation Module
         -- ^ The module was found
-  | FoundSigs [FoundHs] Module
-        -- ^ Signatures were found, with some backing implementation
   | NoPackage PackageKey
         -- ^ The requested package was not found
   | FoundMultiple [(Module, ModuleOrigin)]
@@ -2070,15 +2055,6 @@ type IsBootInterface = Bool
 -- Invariant: the dependencies of a module @M@ never includes @M@.
 --
 -- Invariant: none of the lists contain duplicates.
---
--- NB: While this contains information about all modules and packages below
--- this one in the the import *hierarchy*, this may not accurately reflect
--- the full runtime dependencies of the module.  This is because this module may
--- have imported a boot module, in which case we'll only have recorded the
--- dependencies from the hs-boot file, not the actual hs file. (This is
--- unavoidable: usually, the actual hs file will have been compiled *after*
--- we wrote this interface file.)  See #936, and also @getLinkDeps@ in
--- @compiler/ghci/Linker.hs@ for code which cares about this distinction.
 data Dependencies
   = Deps { dep_mods   :: [(ModuleName, IsBootInterface)]
                         -- ^ All home-package modules transitively below this one
index 16ee352..0be5e3f 100644 (file)
@@ -132,10 +132,9 @@ import qualified Data.Set as Set
 -- in a different DLL, by setting the DLL flag.
 
 -- | Given a module name, there may be multiple ways it came into scope,
--- possibly simultaneously.  For a given particular implementation (e.g.
--- original module, or even a signature module), this data type tracks all the
--- possible ways it could have come into scope.  Warning: don't use the record
--- functions, they're partial!
+-- possibly simultaneously.  This data type tracks all the possible ways
+-- it could have come into scope.  Warning: don't use the record functions,
+-- they're partial!
 data ModuleOrigin =
     -- | Module is hidden, and thus never will be available for import.
     -- (But maybe the user didn't realize), so we'll still keep track
@@ -159,7 +158,7 @@ data ModuleOrigin =
       }
 
 instance Outputable ModuleOrigin where
-    ppr ModHidden = text "hidden module" -- NB: cannot be signature
+    ppr ModHidden = text "hidden module"
     ppr (ModOrigin e res rhs f) = sep (punctuate comma (
         (case e of
             Nothing -> []
@@ -176,18 +175,17 @@ instance Outputable ModuleOrigin where
         (if f then [text "package flag"] else [])
         ))
 
--- | Smart constructor for a module which is in @exposed-modules@ or
--- @exposed-signatures@.  Takes as an argument whether or not the defining
--- package is exposed.
-fromExposed :: Bool -> ModuleOrigin
-fromExposed e = ModOrigin (Just e) [] [] False
+-- | Smart constructor for a module which is in @exposed-modules@.  Takes
+-- as an argument whether or not the defining package is exposed.
+fromExposedModules :: Bool -> ModuleOrigin
+fromExposedModules e = ModOrigin (Just e) [] [] False
 
--- | Smart constructor for a module which is in @reexported-modules@
--- or @reexported-signatures@.  Takes as an argument whether or not the
--- reexporting package is expsed, and also its 'PackageConfig'.
-fromReexported :: Bool -> PackageConfig -> ModuleOrigin
-fromReexported True pkg = ModOrigin Nothing [pkg] [] False
-fromReexported False pkg = ModOrigin Nothing [] [pkg] False
+-- | Smart constructor for a module which is in @reexported-modules@.  Takes
+-- as an argument whether or not the reexporting package is expsed, and
+-- also its 'PackageConfig'.
+fromReexportedModules :: Bool -> PackageConfig -> ModuleOrigin
+fromReexportedModules True pkg = ModOrigin Nothing [pkg] [] False
+fromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False
 
 -- | Smart constructor for a module which was bound by a package flag.
 fromFlag :: ModuleOrigin
@@ -229,40 +227,11 @@ type PackageConfigMap = PackageKeyMap PackageConfig
 type VisibilityMap =
     PackageKeyMap (Bool, [(ModuleName, ModuleName)], FastString)
 
--- | Alias for 'Module' indicating we expect the interface in question to
--- be for a signature.
-type Signature = Module
-
--- | Alias for 'ModuleOrigin' indicating we expect it to describe a signature.
-type SignatureOrigin = ModuleOrigin
-
--- | This is the main lookup structure we use to handle imports, which map
--- from 'ModuleName' to 'ModuleDb', which describes all possible implementations
--- which are available under a module name.
-type ModuleNameDb = Map ModuleName ModuleDb
-
--- | This is an auxiliary structure per module name, and it's a map of
--- backing implementations to more information about them.  This is a map
--- so it's easy to tell if we're bringing in an implementation for a name
--- which is already in scope (and thus non-conflicting.)
-type ModuleDb = Map Module ModuleDesc
-
--- | Per backing implementation, there may be multiple signatures available
--- exporting subsets of its interface; we need to track all of them.
-type SignatureDb = Map Signature SignatureOrigin
-
--- | Combined module description for a module: includes 'ModuleOrigin'
--- describing the backing implementation, as well as 'SignatureDb' for any
--- signatures of the module in question.
-data ModuleDesc = MD ModuleOrigin SignatureDb
-
-instance Outputable ModuleDesc where
-    ppr (MD o m) = ppr o <+> parens (ppr m)
-
-instance Monoid ModuleDesc where
-    mempty = MD mempty Map.empty
-    mappend (MD o m) (MD o' m') = MD (o `mappend` o')
-                                     (Map.unionWith mappend m m')
+-- | Map from 'ModuleName' to 'Module' to all the origins of the bindings
+-- in scope.  The 'PackageConf' is not cached, mostly for convenience reasons
+-- (since this is the slow path, we'll just look it up again).
+type ModuleToPkgConfAll =
+    Map ModuleName (Map Module ModuleOrigin)
 
 data PackageState = PackageState {
   -- | A mapping of 'PackageKey' to 'PackageConfig'.  This list is adjusted
@@ -280,7 +249,7 @@ data PackageState = PackageState {
   -- | This is a full map from 'ModuleName' to all modules which may possibly
   -- be providing it.  These providers may be hidden (but we'll still want
   -- to report them in error messages), or it may be an ambiguous import.
-  moduleNameDb         :: ModuleNameDb,
+  moduleToPkgConfAll    :: ModuleToPkgConfAll,
 
   -- | This is a map from 'InstalledPackageId' to 'PackageKey', since GHC
   -- internally deals in package keys but the database may refer to installed
@@ -292,7 +261,7 @@ emptyPackageState :: PackageState
 emptyPackageState = PackageState {
     pkgIdMap = emptyUFM,
     preloadPackages = [],
-    moduleNameDb = Map.empty,
+    moduleToPkgConfAll = Map.empty,
     installedPackageIdMap = Map.empty
     }
 
@@ -1056,7 +1025,7 @@ mkPackageState dflags0 pkgs0 preload0 this_package = do
   let pstate = PackageState{
     preloadPackages     = dep_preload,
     pkgIdMap            = pkg_db,
-    moduleNameDb  = mkModuleNameDb dflags pkg_db ipid_map vis_map,
+    moduleToPkgConfAll  = mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map,
     installedPackageIdMap = ipid_map
     }
   return (pstate, new_dep_preload, this_package)
@@ -1065,70 +1034,62 @@ mkPackageState dflags0 pkgs0 preload0 this_package = do
 -- -----------------------------------------------------------------------------
 -- | Makes the mapping from module to package info
 
-mkModuleNameDb
+mkModuleToPkgConfAll
   :: DynFlags
   -> PackageConfigMap
   -> InstalledPackageIdMap
   -> VisibilityMap
-  -> ModuleNameDb
-mkModuleNameDb dflags pkg_db ipid_map vis_map =
+  -> ModuleToPkgConfAll
+mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map =
     foldl' extend_modmap emptyMap (eltsUFM pkg_db)
  where
   emptyMap = Map.empty
-  sing pk m = Map.singleton (mkModule pk m)
+  sing pk m = Map.singleton (mkModule pk m)
   addListTo = foldl' merge
   merge m (k, v) = Map.insertWith (Map.unionWith mappend) k v m
+  setOrigins m os = fmap (const os) m
   extend_modmap modmap pkg = addListTo modmap theBindings
    where
-    theBindings :: [(ModuleName, ModuleDb)]
+    theBindings :: [(ModuleName, Map Module ModuleOrigin)]
     theBindings | Just (b,rns,_) <- lookupUFM vis_map (packageConfigId pkg)
                               = newBindings b rns
                 | otherwise   = newBindings False []
 
     newBindings :: Bool
                 -> [(ModuleName, ModuleName)]
-                -> [(ModuleName, ModuleDb)]
+                -> [(ModuleName, Map Module ModuleOrigin)]
     newBindings e rns  = es e ++ hiddens ++ map rnBinding rns
 
     rnBinding :: (ModuleName, ModuleName)
-              -> (ModuleName, ModuleDb)
-    rnBinding (orig, new) = (new, fmap applyFlag origEntry)
+              -> (ModuleName, Map Module ModuleOrigin)
+    rnBinding (orig, new) = (new, setOrigins origEntry fromFlag)
      where origEntry = case lookupUFM esmap orig of
             Just r -> r
             Nothing -> throwGhcException (CmdLineError (showSDoc dflags
                         (text "package flag: could not find module name" <+>
                             ppr orig <+> text "in package" <+> ppr pk)))
 
-    applyFlag (MD _ sigs) = MD fromFlag (fmap (const fromFlag) sigs)
-
-    es :: Bool -> [(ModuleName, ModuleDb)]
+    es :: Bool -> [(ModuleName, Map Module ModuleOrigin)]
     es e = do
-     ExposedModule m exposedReexport exposedSignature <- exposed_mods
-     let (pk', m', origin') =
+     -- TODO: signature support
+     ExposedModule m exposedReexport _exposedSignature <- exposed_mods
+     let (pk', m', pkg', origin') =
           case exposedReexport of
-           Nothing -> (pk, m, fromExposed e)
+           Nothing -> (pk, m, pkg, fromExposedModules e)
            Just (OriginalModule ipid' m') ->
-            let (pk', pkg') = ipid_lookup ipid'
-            in (pk', m', fromReexported e pkg')
-     return $ case exposedSignature of
-        Nothing -> (m, sing pk' m' (MD origin' Map.empty))
-        Just (OriginalModule ipid'' m'') ->
-            let (pk'', _) = ipid_lookup ipid''
-            in (m, sing pk'' m'' (MD mempty (sing pk' m' origin')))
+            let pk' = expectJust "mkModuleToPkgConf" (Map.lookup ipid' ipid_map)
+                pkg' = pkg_lookup pk'
+            in (pk', m', pkg', fromReexportedModules e pkg')
+     return (m, sing pk' m' pkg' origin')
 
-
-    esmap :: UniqFM ModuleDb
+    esmap :: UniqFM (Map Module ModuleOrigin)
     esmap = listToUFM (es False) -- parameter here doesn't matter, orig will
                                  -- be overwritten
 
-    hiddens :: [(ModuleName, ModuleDb)]
-    hiddens = [(m, sing pk m (MD ModHidden Map.empty)) | m <- hidden_mods]
+    hiddens = [(m, sing pk m pkg ModHidden) | m <- hidden_mods]
 
     pk = packageConfigId pkg
-    pkg_lookup = expectJust "mkModuleNameDb" . lookupPackage' pkg_db
-    ipid_lookup ipid =
-        let pk = expectJust "mkModuleNameDb" (Map.lookup ipid ipid_map)
-        in (pk, pkg_lookup pk)
+    pkg_lookup = expectJust "mkModuleToPkgConf" . lookupPackage' pkg_db
 
     exposed_mods = exposedModules pkg
     hidden_mods = hiddenModules pkg
@@ -1238,20 +1199,16 @@ lookupModuleInAllPackages :: DynFlags
                           -> [(Module, PackageConfig)]
 lookupModuleInAllPackages dflags m
   = case lookupModuleWithSuggestions dflags m Nothing of
-      LookupFound (m,_) -> [(m,get_pkg m)]
-      LookupMultiple rs -> map (\(m,_) -> (m,get_pkg m)) rs
+      LookupFound a b -> [(a,b)]
+      LookupMultiple rs -> map f rs
+        where f (m,_) = (m, expectJust "lookupModule" (lookupPackage dflags
+                                                         (modulePackageKey m)))
       _ -> []
-      where get_pkg = expectJust "lookupModule" . lookupPackage dflags
-                                                . modulePackageKey
 
 -- | The result of performing a lookup
 data LookupResult =
     -- | Found the module uniquely, nothing else to do
-    LookupFound (Module, ModuleOrigin)
-    -- | We found (possibly multiple) signatures with a unique backing
-    -- implementation: they should be "merged" together.  For good measure,
-    -- the backing implementation is recorded too.
-  | LookupFoundSigs [(Module, ModuleOrigin)] Module
+    LookupFound Module PackageConfig
     -- | Multiple modules with the same name in scope
   | LookupMultiple [(Module, ModuleOrigin)]
     -- | No modules found, but there were some hidden ones with
@@ -1261,39 +1218,6 @@ data LookupResult =
     -- | Nothing found, here are some suggested different names
   | LookupNotFound [ModuleSuggestion] -- suggestions
 
-instance Monoid LookupResult where
-    mempty = LookupNotFound []
-
-    LookupNotFound s1   `mappend` LookupNotFound s2
-        = LookupNotFound (s1 ++ s2)
-    LookupNotFound{}    `mappend` l                 = l
-    l                   `mappend` LookupNotFound{}  = l
-
-    LookupHidden x1 y1  `mappend` LookupHidden x2 y2
-        = LookupHidden (x1 ++ x2) (y1 ++ y2)
-    LookupHidden{}      `mappend` l                 = l
-    l                   `mappend` LookupHidden{}    = l
-
-    LookupFound m1      `mappend` LookupFound m2
-        = ASSERT(fst m1 /= fst m2)             LookupMultiple [m1, m2]
-    LookupFound m       `mappend` LookupMultiple ms
-        = ASSERT(not (any ((==fst m).fst) ms)) LookupMultiple (m:ms)
-    LookupFound m       `mappend` LookupFoundSigs ms check
-        | fst m == check    = LookupFound m
-        | otherwise         = LookupMultiple (m:ms)
-    l1 `mappend` l2@LookupFound{}
-        = l2 `mappend` l1
-
-    LookupMultiple ms1  `mappend` LookupFoundSigs ms2 _
-        = LookupMultiple (ms1 ++ ms2)
-    LookupMultiple ms1  `mappend` LookupMultiple ms2
-        = LookupMultiple (ms1 ++ ms2)
-    l1  `mappend` l2@LookupMultiple{}
-        = l2 `mappend` l1
-
-    LookupFoundSigs ms1 m1 `mappend` LookupFoundSigs ms2 m2
-        = ASSERT(m1 /= m2)                     LookupMultiple (ms1 ++ ms2)
-
 data ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin
                       | SuggestHidden ModuleName Module ModuleOrigin
 
@@ -1302,28 +1226,23 @@ lookupModuleWithSuggestions :: DynFlags
                             -> Maybe FastString
                             -> LookupResult
 lookupModuleWithSuggestions dflags m mb_pn
-  = case Map.lookup m (moduleNameDb pkg_state) of
+  = case Map.lookup m (moduleToPkgConfAll pkg_state) of
         Nothing -> LookupNotFound suggestions
-        Just xs -> mconcat (LookupNotFound suggestions
-                           :map classify (Map.toList xs))
+        Just xs ->
+          case foldl' classify ([],[],[]) (Map.toList xs) of
+            ([], [], []) -> LookupNotFound suggestions
+            (_, _, [(m, _)])             -> LookupFound m (mod_pkg m)
+            (_, _, exposed@(_:_))        -> LookupMultiple exposed
+            (hidden_pkg, hidden_mod, []) -> LookupHidden hidden_pkg hidden_mod
   where
-    classify (m, MD origin0 sigs0) =
+    classify (hidden_pkg, hidden_mod, exposed) (m, origin0) =
       let origin = filterOrigin mb_pn (mod_pkg m) origin0
-          r = (m, origin)
+          x = (m, origin)
       in case origin of
-          ModHidden                -> LookupHidden [] [r]
-          _ | originVisible origin -> LookupFound r
-            | otherwise ->
-                let sigs = do (back_m, back_origin0) <- Map.toList sigs0
-                              let back_origin = filterOrigin mb_pn
-                                                             (mod_pkg back_m)
-                                                             back_origin0
-                              guard (originVisible back_origin)
-                              return (back_m, back_origin)
-                in case sigs of
-                    [] | originEmpty origin -> LookupNotFound []
-                       | otherwise          -> LookupHidden [r] []
-                    _ -> LookupFoundSigs sigs m
+          ModHidden                  -> (hidden_pkg,   x:hidden_mod, exposed)
+          _ | originEmpty origin     -> (hidden_pkg,   hidden_mod,   exposed)
+            | originVisible origin   -> (hidden_pkg,   hidden_mod,   x:exposed)
+            | otherwise              -> (x:hidden_pkg, hidden_mod,   exposed)
 
     pkg_lookup = expectJust "lookupModuleWithSuggestions" . lookupPackage dflags
     pkg_state = pkgState dflags
@@ -1358,18 +1277,17 @@ lookupModuleWithSuggestions dflags m mb_pn
     all_mods :: [(String, ModuleSuggestion)]     -- All modules
     all_mods = sortBy (comparing fst) $
         [ (moduleNameString m, suggestion)
-        | (m, e) <- Map.toList (moduleNameDb (pkgState dflags))
+        | (m, e) <- Map.toList (moduleToPkgConfAll (pkgState dflags))
         , suggestion <- map (getSuggestion m) (Map.toList e)
         ]
-    -- For now, don't suggest implemented signatures
-    getSuggestion name (mod, MD origin _) =
+    getSuggestion name (mod, origin) =
         (if originVisible origin then SuggestVisible else SuggestHidden)
             name mod origin
 
 listVisibleModuleNames :: DynFlags -> [ModuleName]
 listVisibleModuleNames dflags =
-    map fst (filter visible (Map.toList (moduleNameDb (pkgState dflags))))
-  where visible (_, ms) = any (\(MD o _) -> originVisible o) (Map.elems ms)
+    map fst (filter visible (Map.toList (moduleToPkgConfAll (pkgState dflags))))
+  where visible (_, ms) = any originVisible (Map.elems ms)
 
 -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
 -- 'PackageConfig's
@@ -1508,7 +1426,7 @@ pprPackagesSimple = pprPackagesWith pprIPI
 -- | Show the mapping of modules to where they come from.
 pprModuleMap :: DynFlags -> SDoc
 pprModuleMap dflags =
-  vcat (map pprLine (Map.toList (moduleNameDb (pkgState dflags))))
+  vcat (map pprLine (Map.toList (moduleToPkgConfAll (pkgState dflags))))
     where
       pprLine (m,e) = ppr m $$ nest 50 (vcat (map (pprEntry m) (Map.toList e)))
       pprEntry m (m',o)
index f6b2cba..639c7de 100644 (file)
@@ -970,11 +970,6 @@ ghc -c A.hs
       written in a subset of Haskell essentially identical to that of
       <literal>hs-boot</literal> files.</para>
 
-      <para>Signatures can be installed like ordinary module files,
-      and when multiple signatures are brought into scope under the same
-      module name, they are merged together if their backing implementations
-      are the same.</para>
-
       <para>There is one important gotcha with the current implementation:
       currently, instances from backing implementations will "leak" code that
       uses signatures, and explicit instance declarations in signatures are
index 201ee5d..fa266a2 100644 (file)
@@ -834,12 +834,11 @@ abiHash strs = do
          let modname = mkModuleName str
          r <- findImportedModule hsc_env modname Nothing
          case r of
-           FoundModule h -> return [fr_mod h]
-           FoundSigs hs _ -> return (map fr_mod hs)
+           Found _ m -> return m
            _error    -> throwGhcException $ CmdLineError $ showSDoc dflags $
                           cannotFindInterface dflags modname r
 
-  mods <- fmap concat (mapM find_it strs)
+  mods <- mapM find_it strs
 
   let get_iface modl = loadUserInterface False (text "abiHash") modl
   ifaces <- initIfaceCheck hsc_env $ mapM get_iface mods
index ade0024..1716b8f 100644 (file)
@@ -119,12 +119,6 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk
 /tests/cabal/sigcabal01/p_lazy
 /tests/cabal/sigcabal01/p_strict
 /tests/cabal/sigcabal01/containers
-/tests/cabal/sigcabal02/Main
-/tests/cabal/sigcabal02/p_ipid
-/tests/cabal/sigcabal02/q_ipid
-/tests/cabal/sigcabal02/containers
-/tests/cabal/sigcabal02/tmp*
-/tests/cabal/sigcabal02/inst*
 /tests/cabal/local01.package.conf/
 /tests/cabal/local03.package.conf/
 /tests/cabal/local04.package.conf/
diff --git a/testsuite/tests/cabal/sigcabal02/Main.hs b/testsuite/tests/cabal/sigcabal02/Main.hs
deleted file mode 100644 (file)
index 52def3d..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-import Map
-import P
-import Q
-
-main = do
-    x <- foo
-    print (mymember 5 x)
diff --git a/testsuite/tests/cabal/sigcabal02/Makefile b/testsuite/tests/cabal/sigcabal02/Makefile
deleted file mode 100644 (file)
index 152aaea..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
-SETUP=../Setup -v0
-
-# This test is for two Cabal packages exposing the same signature
-
-sigcabal02:
-       $(MAKE) clean
-       '$(GHC_PKG)' field containers id | sed 's/^.*: *//' > containers
-       '$(GHC_PKG)' init tmp.d
-       '$(TEST_HC)' -v0 --make Setup
-       cd p && $(SETUP) clean
-       cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-p' --instantiate-with="Map=Data.Map.Lazy@`cat ../containers`" --instantiate-with="Set=Data.Set@`cat ../containers`" --ghc-pkg-options="--enable-multi-instance"
-       cd p && $(SETUP) build
-       cd p && $(SETUP) copy
-       cd p && $(SETUP) register --print-ipid > ../p_ipid
-       cd q && $(SETUP) clean
-       cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-p' --instantiate-with="Map=Data.Map.Lazy@`cat ../containers`" --ghc-pkg-options="--enable-multi-instance"
-       cd q && $(SETUP) build
-       cd q && $(SETUP) copy
-       cd q && $(SETUP) register --print-ipid > ../q_ipid
-       '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make Main.hs
-       ./Main
-       ! '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make ShouldFail.hs
-ifneq "$(CLEANUP)" ""
-       $(MAKE) clean
-endif
-
-clean :
-       '$(GHC_PKG)' unregister --force p >/dev/null 2>&1 || true
-       '$(GHC_PKG)' unregister --force q >/dev/null 2>&1 || true
-       $(RM) -r tmp.d inst-* *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext)
diff --git a/testsuite/tests/cabal/sigcabal02/Setup.hs b/testsuite/tests/cabal/sigcabal02/Setup.hs
deleted file mode 100644 (file)
index 9a994af..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/testsuite/tests/cabal/sigcabal02/ShouldFail.hs b/testsuite/tests/cabal/sigcabal02/ShouldFail.hs
deleted file mode 100644 (file)
index 98ec49e..0000000
+++ /dev/null
@@ -1 +0,0 @@
-import Set
diff --git a/testsuite/tests/cabal/sigcabal02/all.T b/testsuite/tests/cabal/sigcabal02/all.T
deleted file mode 100644 (file)
index 11eb059..0000000
+++ /dev/null
@@ -1,9 +0,0 @@
-if default_testopts.cleanup != '':
-   cleanup = 'CLEANUP=1'
-else:
-   cleanup = ''
-
-test('sigcabal02',
-     normal,
-     run_command,
-     ['$MAKE -s --no-print-directory sigcabal02 ' + cleanup])
diff --git a/testsuite/tests/cabal/sigcabal02/p/LICENSE b/testsuite/tests/cabal/sigcabal02/p/LICENSE
deleted file mode 100644 (file)
index e69de29..0000000
diff --git a/testsuite/tests/cabal/sigcabal02/p/Map.hsig b/testsuite/tests/cabal/sigcabal02/p/Map.hsig
deleted file mode 100644 (file)
index 359cf64..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE RoleAnnotations #-}
-module Map where
-
-import Set
-
-type role Map nominal representational
-data Map k a
-
-instance (Show k, Show a) => Show (Map k a)
-
-size :: Map k a -> Int
-lookup :: Ord k => k -> Map k a -> Maybe a
-empty :: Map k a
-insert :: Ord k => k -> a -> Map k a -> Map k a
-delete :: Ord k => k -> Map k a -> Map k a
-
-keysSet :: Map k a -> Set k
-fromSet :: (k -> a) -> Set k -> Map k a
diff --git a/testsuite/tests/cabal/sigcabal02/p/P.hs b/testsuite/tests/cabal/sigcabal02/p/P.hs
deleted file mode 100644 (file)
index dec6b41..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-module P where
-
-import qualified Map
-import qualified Set
-
-foo = do
-    let x = Map.insert 0 "foo"
-          . Map.insert (6 :: Int) "foo"
-          $ Map.empty
-    print (Map.lookup 1 x)
-    print (Set.size (Map.keysSet x))
-    return x
diff --git a/testsuite/tests/cabal/sigcabal02/p/Set.hsig b/testsuite/tests/cabal/sigcabal02/p/Set.hsig
deleted file mode 100644 (file)
index 1713133..0000000
+++ /dev/null
@@ -1,13 +0,0 @@
-{-# LANGUAGE RoleAnnotations #-}
-module Set where
-
-type role Set nominal
-data Set a
-
-instance Show a => Show (Set a)
-
-size :: Set a -> Int
-member :: Ord a => a -> Set a -> Bool
-empty :: Set a
-insert :: Ord a => a -> Set a -> Set a
-delete :: Ord a => a -> Set a -> Set a
diff --git a/testsuite/tests/cabal/sigcabal02/p/p.cabal b/testsuite/tests/cabal/sigcabal02/p/p.cabal
deleted file mode 100644 (file)
index bb3b2a4..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-name:                p
-version:             1.0
-license-file:        LICENSE
-author:              Edward Z. Yang
-maintainer:          ezyang@cs.stanford.edu
-build-type:          Simple
-cabal-version:       >=1.20
-
-library
-  exposed-modules:     P
-  exposed-signatures:  Map
-  required-signatures: Set
-  build-depends:       base
-  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/sigcabal02/q/LICENSE b/testsuite/tests/cabal/sigcabal02/q/LICENSE
deleted file mode 100644 (file)
index e69de29..0000000
diff --git a/testsuite/tests/cabal/sigcabal02/q/Map.hsig b/testsuite/tests/cabal/sigcabal02/q/Map.hsig
deleted file mode 100644 (file)
index 40fd0bc..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-{-# LANGUAGE RoleAnnotations #-}
-module Map where
-
-type role Map nominal representational
-data Map k a
-
-member :: Ord k => k -> Map k a -> Bool
diff --git a/testsuite/tests/cabal/sigcabal02/q/Q.hs b/testsuite/tests/cabal/sigcabal02/q/Q.hs
deleted file mode 100644 (file)
index ba55fb9..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-module Q where
-
-import qualified Map
-import Map(Map)
-
-mymember :: Int -> Map Int a -> Bool
-mymember k m = Map.member k m || Map.member (k + 1) m
diff --git a/testsuite/tests/cabal/sigcabal02/q/q.cabal b/testsuite/tests/cabal/sigcabal02/q/q.cabal
deleted file mode 100644 (file)
index 2f99c44..0000000
+++ /dev/null
@@ -1,13 +0,0 @@
-name:                q
-version:             1.0
-license-file:        LICENSE
-author:              Edward Z. Yang
-maintainer:          ezyang@cs.stanford.edu
-build-type:          Simple
-cabal-version:       >=1.20
-
-library
-  exposed-modules:     Q
-  exposed-signatures:  Map
-  build-depends:       base
-  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/sigcabal02/sigcabal02.stderr b/testsuite/tests/cabal/sigcabal02/sigcabal02.stderr
deleted file mode 100644 (file)
index 7c1f092..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-
-ShouldFail.hs:1:8:
-    Could not find module ‘Set’
-    Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/cabal/sigcabal02/sigcabal02.stdout b/testsuite/tests/cabal/sigcabal02/sigcabal02.stdout
deleted file mode 100644 (file)
index 48cb59e..0000000
+++ /dev/null
@@ -1,5 +0,0 @@
-[1 of 1] Compiling Main             ( Main.hs, Main.o )
-Linking Main ...
-Nothing
-2
-True
diff --git a/testsuite/tests/driver/recomp014/Makefile b/testsuite/tests/driver/recomp014/Makefile
deleted file mode 100644 (file)
index e788110..0000000
+++ /dev/null
@@ -1,31 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
-# -fforce-recomp makes lots of driver tests trivially pass, so we
-# filter it out from $(TEST_HC_OPTS).
-TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS))
-
-# Recompilation tests
-
-clean:
-       rm -f *.o *.hi
-
-recomp014: clean
-       echo 'module A where a = False' > A.hs
-       echo 'module A1 where a = False' > A1.hs
-       echo 'module B where a :: Bool' > B.hsig
-       echo 'first run'
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c A.hs
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c A1.hs
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c B.hsig -sig-of "B is main:A"
-       echo 'import B; main = print a' > C.hs
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs
-       echo 'second run'
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c B.hsig -sig-of "B is main:A1"
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) A1.o C.o -o recomp014
-       ./recomp014
-
-.PHONY: clean recomp014
diff --git a/testsuite/tests/driver/recomp014/all.T b/testsuite/tests/driver/recomp014/all.T
deleted file mode 100644 (file)
index affccd2..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-test('recomp014',
-     [ clean_cmd('$MAKE -s clean') ],
-     run_command,
-     ['$MAKE -s --no-print-directory recomp014'])
diff --git a/testsuite/tests/driver/recomp014/recomp014.stdout b/testsuite/tests/driver/recomp014/recomp014.stdout
deleted file mode 100644 (file)
index 7d54071..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-first run
-compilation IS NOT required
-second run
-False
index 629d4b6..84dfc33 100644 (file)
@@ -21,9 +21,3 @@ sigof01m:
        mkdir tmp_sigof01m
        '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -outputdir tmp_sigof01m --make Main.hs -sig-of "B is main:A" -o tmp_sigof01m/Main
        tmp_sigof01m/Main
-
-sigof01i:
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --interactive -v0 -ignore-dot-ghci Main.hs -sig-of "B is main:A" < sigof01i.script
-
-sigof01i2:
-       '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --interactive -v0 -ignore-dot-ghci -sig-of "B is main:A" < sigof01i2.script
index 50418b9..d0cdc3c 100644 (file)
@@ -7,13 +7,3 @@ test('sigof01m',
      [ clean_cmd('rm -rf tmp_sigof01m') ],
      run_command,
      ['$MAKE -s --no-print-directory sigof01m'])
-
-test('sigof01i',
-     normal,
-     run_command,
-     ['$MAKE -s --no-print-directory sigof01i'])
-
-test('sigof01i2',
-     normal,
-     run_command,
-     ['$MAKE -s --no-print-directory sigof01i2'])
diff --git a/testsuite/tests/driver/sigof01/sigof01i.script b/testsuite/tests/driver/sigof01/sigof01i.script
deleted file mode 100644 (file)
index ba2906d..0000000
+++ /dev/null
@@ -1 +0,0 @@
-main
diff --git a/testsuite/tests/driver/sigof01/sigof01i.stdout b/testsuite/tests/driver/sigof01/sigof01i.stdout
deleted file mode 100644 (file)
index bb614cd..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-False
-T
-True
diff --git a/testsuite/tests/driver/sigof01/sigof01i2.script b/testsuite/tests/driver/sigof01/sigof01i2.script
deleted file mode 100644 (file)
index 3a91e37..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-:load B
-:browse B
-:issafe
diff --git a/testsuite/tests/driver/sigof01/sigof01i2.stdout b/testsuite/tests/driver/sigof01/sigof01i2.stdout
deleted file mode 100644 (file)
index ac15dcf..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-class Foo a where
-  foo :: a -> a
-data T = A.T
-mkT :: T
-x :: Bool
-Trust type is (Module: Safe, Package: trusted)
-Package Trust: Off
-B is trusted!
index 70c6f22..9cd00a2 100644 (file)
@@ -1,5 +1,5 @@
 
 package09e.hs:2:1:
     Ambiguous interface for ‘M’:
-      it is bound as Data.Map by a package flag
       it is bound as Data.Set by a package flag
+      it is bound as Data.Map by a package flag