[commit: ghc] wip/cabal-head-updates: Update to Cabal head, update ghc-pkg to use new module re-export types (efb4375)

git at git.haskell.org git at git.haskell.org
Fri Aug 29 14:08:31 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/cabal-head-updates
Link       : http://ghc.haskell.org/trac/ghc/changeset/efb43758065f5311a51b12a6f8126c008aade5a7/ghc

>---------------------------------------------------------------

commit efb43758065f5311a51b12a6f8126c008aade5a7
Author: Duncan Coutts <duncan at well-typed.com>
Date:   Fri Aug 29 13:53:52 2014 +0100

    Update to Cabal head, update ghc-pkg to use new module re-export types
    
    The main change is that Cabal changed the representation of module
    re-exports to distinguish reexports in source .cabal files versus
    re-exports in installed package registraion files.
    
    Cabal now also does the resolution of re-exports to specific installed
    packages itself, so ghc-pkg no longer has to do this. This is a cleaner
    design overall because re-export resolution can fail so it is better to
    do it during package configuration rather than package registration.
    It also simplifies the re-export representation that ghc-pkg has to use.


>---------------------------------------------------------------

efb43758065f5311a51b12a6f8126c008aade5a7
 libraries/Cabal         |  2 +-
 utils/ghc-cabal/Main.hs | 12 +++-----
 utils/ghc-pkg/Main.hs   | 82 +++++++++++++------------------------------------
 3 files changed, 28 insertions(+), 68 deletions(-)

diff --git a/libraries/Cabal b/libraries/Cabal
index 8d59dc9..2ce3838 160000
--- a/libraries/Cabal
+++ b/libraries/Cabal
@@ -1 +1 @@
-Subproject commit 8d59dc9fba584a9fdb810f4d84f7f3ccb089dd08
+Subproject commit 2ce3838f97f66f03e952333f8c23129f00ebf6cb
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index 47eb1de..fc97111 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -346,13 +346,11 @@ generate directory distdir dll0Modules config_args
       withLibLBI pd lbi $ \lib clbi ->
           do cwd <- getCurrentDirectory
              let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
-             let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
-                                        pd lib lbi clbi
-                 final_ipi = installedPkgInfo {
-                                 Installed.installedPackageId = ipid,
-                                 Installed.haddockHTMLs = []
-                             }
-                 content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
+             let installedPkgInfo = (inplaceInstalledPackageInfo cwd distdir
+                                        pd ipid lib lbi clbi)
+                                        { Installed.haddockHTMLs = [] }
+                 content = Installed.showInstalledPackageInfo installedPkgInfo
+                        ++ "\n"
              writeFileAtomic (distdir </> "inplace-pkg-config") (BS.pack $ toUTF8 content)
 
       let
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index ac958da..4d4f8e9 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -20,8 +20,7 @@ import Distribution.InstalledPackageInfo as Cabal
 import Distribution.License
 import Distribution.Compat.ReadP hiding (get)
 import Distribution.ParseUtils
-import Distribution.ModuleExport
-import Distribution.Package hiding (depends)
+import Distribution.Package hiding (depends, installedPackageId)
 import Distribution.Text
 import Distribution.Version
 import Distribution.Simple.Utils (fromUTF8, toUTF8)
@@ -38,8 +37,6 @@ import System.Console.GetOpt
 import qualified Control.Exception as Exception
 import Data.Maybe
 
-import qualified Data.Set as Set
-
 import Data.Char ( isSpace, toLower )
 import Data.Ord (comparing)
 import Control.Applicative (Applicative(..))
@@ -899,9 +896,6 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance
   validatePackageConfig pkg_expanded verbosity truncated_stack
                         auto_ghci_libs multi_instance update force
 
-  -- postprocess the package
-  pkg' <- resolveReexports truncated_stack pkg
-
   let 
      -- In the normal mode, we only allow one version of each package, so we
      -- remove all instances with the same source package id as the one we're
@@ -912,7 +906,7 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance
                  p <- packages db_to_operate_on,
                  sourcePackageId p == sourcePackageId pkg ]
   --
-  changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on
+  changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on
 
 parsePackageInfo
         :: String
@@ -935,47 +929,6 @@ mungePackageInfo ipi = ipi { packageKey = packageKey' }
           = OldPackageKey (sourcePackageId ipi)
       | otherwise = packageKey ipi
 
--- | Takes the "reexported-modules" field of an InstalledPackageInfo
--- and resolves the references so they point to the original exporter
--- of a module (i.e. the module is in exposed-modules, not
--- reexported-modules).  This is done by maintaining an invariant on
--- the installed package database that a reexported-module field always
--- points to the original exporter.
-resolveReexports :: PackageDBStack
-                 -> InstalledPackageInfo
-                 -> IO InstalledPackageInfo
-resolveReexports db_stack pkg = do
-  let dep_mask = Set.fromList (depends pkg)
-      deps = filter (flip Set.member dep_mask . installedPackageId)
-                    (allPackagesInStack db_stack)
-      matchExposed pkg_dep m = map ((,) (installedPackageId pkg_dep))
-                                   (filter (==m) (exposedModules pkg_dep))
-      worker ModuleExport{ exportOrigPackageName = Just pnm } pkg_dep
-        | pnm /= packageName (sourcePackageId pkg_dep) = []
-      -- Now, either the package matches, *or* we were asked to search the
-      -- true location ourselves.
-      worker ModuleExport{ exportOrigName = m } pkg_dep =
-            matchExposed pkg_dep m ++
-            map (fromMaybe (error $ "Impossible! Missing true location in " ++
-                                    display (installedPackageId pkg_dep))
-                    . exportCachedTrueOrig)
-                (filter ((==m) . exportName) (reexportedModules pkg_dep))
-      self_reexports ModuleExport{ exportOrigPackageName = Just pnm }
-        | pnm /= packageName (sourcePackageId pkg) = []
-      self_reexports ModuleExport{ exportName = m', exportOrigName = m }
-        -- Self-reexport without renaming doesn't make sense
-        | m == m' = []
-        -- *Only* match against exposed modules!
-        | otherwise = matchExposed pkg m
-
-  r <- forM (reexportedModules pkg) $ \me -> do
-    case nub (concatMap (worker me) deps ++ self_reexports me) of
-      [c] -> return me { exportCachedTrueOrig = Just c }
-      [] -> die $ "Couldn't resolve reexport " ++ display me
-      cs -> die $ "Found multiple possible ways to resolve reexport " ++
-                  display me ++ ": " ++ show cs
-  return (pkg { reexportedModules = r })
-
 -- -----------------------------------------------------------------------------
 -- Making changes to a package database
 
@@ -1068,16 +1021,25 @@ convertPackageInfoToCacheFormat pkg =
        GhcPkg.haddockHTMLs       = haddockHTMLs pkg,
        GhcPkg.exposedModules     = exposedModules pkg,
        GhcPkg.hiddenModules      = hiddenModules pkg,
-       GhcPkg.reexportedModules  = [ GhcPkg.ModuleExport m ipid' m'
-                                   | ModuleExport {
-                                       exportName = m,
-                                       exportCachedTrueOrig =
-                                         Just (InstalledPackageId ipid', m')
-                                     } <- reexportedModules pkg
-                                   ],
+       GhcPkg.reexportedModules  = map convertModuleReexport
+                                       (reexportedModules pkg),
        GhcPkg.exposed            = exposed pkg,
        GhcPkg.trusted            = trusted pkg
     }
+  where
+    convertModuleReexport :: ModuleReexport
+                          -> GhcPkg.ModuleExport String ModuleName
+    convertModuleReexport
+        ModuleReexport {
+          moduleReexportName            = m,
+          moduleReexportDefiningPackage = ipid',
+          moduleReexportDefiningName    = m'
+        }
+      = GhcPkg.ModuleExport {
+          exportModuleName         = m,
+          exportOriginalPackageId  = display ipid',
+          exportOriginalModuleName = m'
+        }
 
 instance GhcPkg.BinaryStringRep ModuleName where
   fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack
@@ -2128,10 +2090,10 @@ instance Binary ModuleName where
   put = put . display
   get = fmap ModuleName.fromString get
 
-instance Binary m => Binary (ModuleExport m) where
-  put (ModuleExport a b c d) = do put a; put b; put c; put d
-  get = do a <- get; b <- get; c <- get; d <- get;
-           return (ModuleExport a b c d)
+instance Binary ModuleReexport where
+  put (ModuleReexport a b c) = do put a; put b; put c
+  get = do a <- get; b <- get; c <- get
+           return (ModuleReexport a b c)
 
 instance Binary PackageKey where
   put (PackageKey a b c) = do putWord8 0; put a; put b; put c



More information about the ghc-commits mailing list