Library names, with Cabal submodule update
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Tue, 23 Jun 2015 20:15:17 +0000 (13:15 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 23 Jul 2015 20:35:45 +0000 (13:35 -0700)
A library name is a package name, package version, and hash of the
version names of all textual dependencies (i.e. packages which were included.) A library
name is a coarse approximation of installed package IDs, which are suitable for
inclusion in package keys (you don't want to put an IPID in a package key, since
it means the key will change any time the source changes.)

    - We define ShPackageKey, which is the semantic object which
      is hashed into a PackageKey.  You can use 'newPackageKey'
      to hash a ShPackageKey to a PackageKey

    - Given a PackageKey, we can lookup its ShPackageKey with
      'lookupPackageKey'.  The way we can do this is by consulting
      the 'pkgKeyCache', which records a reverse mapping from
      every hash to the ShPackageKey.  This means that if you
      load in PackageKeys from external sources (e.g. interface
      files), you also need to load in a mapping of PackageKeys
      to their ShPackageKeys so we can populate the cache.

    - We define a 'LibraryName' which encapsulates the full
      depenency resolution that Cabal may have selected; this
      is opaque to GHC but can be used to distinguish different
      versions of a package.

    - Definite packages don't have an interesting PackageKey,
      so we rely on Cabal to pass them to us.

    - We can pretty-print package keys while displaying the
      instantiation, but it's not wired up to anything (e.g.
      the Outputable instance of PackageKey).

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1056

GHC Trac Issues: #10566

13 files changed:
compiler/backpack/ShPackageKey.hs [new file with mode: 0644]
compiler/ghc.cabal.in
compiler/main/DynFlags.hs
compiler/main/PackageConfig.hs
compiler/main/Packages.hs
docs/users_guide/packages.xml
libraries/Cabal
testsuite/tests/cabal/sigcabal01/Makefile
testsuite/tests/cabal/sigcabal01/all.T
testsuite/tests/cabal/sigcabal02/Makefile
testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
testsuite/tests/th/TH_Roles2.stderr
utils/ghc-cabal/Main.hs

diff --git a/compiler/backpack/ShPackageKey.hs b/compiler/backpack/ShPackageKey.hs
new file mode 100644 (file)
index 0000000..9fc44ae
--- /dev/null
@@ -0,0 +1,280 @@
+{-# LANGUAGE CPP #-}
+module ShPackageKey(
+    ShFreeHoles,
+    calcModuleFreeHoles,
+
+    newPackageKey,
+    newPackageKeyWithScope,
+    lookupPackageKey,
+
+    generalizeHoleModule,
+    canonicalizeModule,
+
+    pprPackageKey
+) where
+
+#include "HsVersions.h"
+
+import Module
+import Packages
+import FastString
+import UniqFM
+import UniqSet
+import Outputable
+import Util
+import DynFlags
+
+import System.IO.Unsafe ( unsafePerformIO )
+import Control.Monad
+import Numeric
+import Data.IORef
+import GHC.Fingerprint
+import Data.Word
+import qualified Data.Char as Char
+import Data.List
+import Data.Function
+
+-- NB: didn't put this in Module, that seems a bit too low in the
+-- hierarchy, need to refer to DynFlags
+
+{-
+************************************************************************
+*                                                                      *
+                        Package Keys
+*                                                                      *
+************************************************************************
+-}
+
+-- Note: [PackageKey cache]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~
+-- The built-in PackageKey type (used by Module, Name, etc)
+-- records the instantiation of the package as an MD5 hash
+-- which is not reversible without some extra information.
+-- However, the shape merging process requires us to be able
+-- to substitute Module occurrences /inside/ the package key.
+--
+-- Thus, we maintain the invariant: for every PackageKey
+-- in our system, either:
+--
+--      1. It is in the installed package database (lookupPackage)
+--         so we can lookup the recorded instantiatedWith
+--      2. We've recorded the associated mapping in the
+--         PackageKeyCache.
+--
+-- A PackageKey can be expanded into a ShPackageKey which has
+-- the instance mapping.  In the mapping, we don't bother
+-- expanding a 'Module'; depending on 'shPackageKeyFreeHoles',
+-- it may not be necessary to do a substitution (you only
+-- need to drill down when substituing HOLE:H if H is in scope.
+
+-- Note: [Module name in scope set]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Similar to InScopeSet, ShFreeHoles is an optimization that
+-- allows us to avoid expanding a PackageKey into an ShPackageKey
+-- if there isn't actually anything in the module expression that
+-- we can substitute.
+
+-- | Given a Name or Module, the 'ShFreeHoles' contains the set
+-- of free variables, i.e. HOLE:A modules, which may be substituted.
+-- If this set is empty no substitutions are possible.
+type ShFreeHoles = UniqSet ModuleName
+
+-- | Calculate the free holes of a 'Module'.
+calcModuleFreeHoles :: DynFlags -> Module -> IO ShFreeHoles
+calcModuleFreeHoles dflags m
+    | modulePackageKey m == holePackageKey = return (unitUniqSet (moduleName m))
+    | otherwise = do
+        shpk <- lookupPackageKey dflags (modulePackageKey m)
+        return $ case shpk of
+            ShDefinitePackageKey{} -> emptyUniqSet
+            ShPackageKey{ shPackageKeyFreeHoles = in_scope } -> in_scope
+
+-- | Calculate the free holes of the hole map @[('ModuleName', 'Module')]@.
+calcInstsFreeHoles :: DynFlags -> [(ModuleName, Module)] -> IO ShFreeHoles
+calcInstsFreeHoles dflags insts =
+    fmap unionManyUniqSets (mapM (calcModuleFreeHoles dflags . snd) insts)
+
+-- | Given a 'UnitName', a 'LibraryName', and sorted mapping of holes to
+-- their implementations, compute the 'PackageKey' associated with it, as well
+-- as the recursively computed 'ShFreeHoles' of holes that may be substituted.
+newPackageKeyWithScope :: DynFlags
+                       -> UnitName
+                       -> LibraryName
+                       -> [(ModuleName, Module)]
+                       -> IO (PackageKey, ShFreeHoles)
+newPackageKeyWithScope dflags pn vh insts = do
+    fhs <- calcInstsFreeHoles dflags insts
+    pk <- newPackageKey' dflags (ShPackageKey pn vh insts fhs)
+    return (pk, fhs)
+
+-- | Given a 'UnitName' and sorted mapping of holes to
+-- their implementations, compute the 'PackageKey' associated with it.
+-- (Analogous to 'newGlobalBinder').
+newPackageKey :: DynFlags
+              -> UnitName
+              -> LibraryName
+              -> [(ModuleName, Module)]
+              -> IO PackageKey
+newPackageKey dflags pn vh insts = do
+    (pk, _) <- newPackageKeyWithScope dflags pn vh insts
+    return pk
+
+-- | Given a 'ShPackageKey', compute the 'PackageKey' associated with it.
+-- This function doesn't calculate the 'ShFreeHoles', because it is
+-- provided with 'ShPackageKey'.
+newPackageKey' :: DynFlags -> ShPackageKey -> IO PackageKey
+newPackageKey' _ (ShDefinitePackageKey pk) = return pk
+newPackageKey' dflags
+               shpk@(ShPackageKey pn vh insts fhs) = do
+    ASSERTM( fmap (==fhs) (calcInstsFreeHoles dflags insts) )
+    let pk = mkPackageKey pn vh insts
+        pkt_var = pkgKeyCache dflags
+    pk_cache <- readIORef pkt_var
+    let consistent pk_cache = maybe True (==shpk) (lookupUFM pk_cache pk)
+    MASSERT( consistent pk_cache )
+    when (not (elemUFM pk pk_cache)) $
+        atomicModifyIORef' pkt_var (\pk_cache ->
+            -- Could race, but it's guaranteed to be the same
+            ASSERT( consistent pk_cache ) (addToUFM pk_cache pk shpk, ()))
+    return pk
+
+-- | Given a 'PackageKey', reverse lookup the 'ShPackageKey' associated
+-- with it.  This only gives useful information for keys which are
+-- created using 'newPackageKey' or the associated functions, or that are
+-- already in the installed package database, since we generally cannot reverse
+-- MD5 hashes.
+lookupPackageKey :: DynFlags
+                 -> PackageKey
+                 -> IO ShPackageKey
+lookupPackageKey dflags pk
+  | pk `elem` wiredInPackageKeys
+     || pk == mainPackageKey
+     || pk == holePackageKey
+  = return (ShDefinitePackageKey pk)
+  | otherwise = do
+    let pkt_var = pkgKeyCache dflags
+    pk_cache <- readIORef pkt_var
+    case lookupUFM pk_cache pk of
+        Just r -> return r
+        _ -> return (ShDefinitePackageKey pk)
+
+pprPackageKey :: PackageKey -> SDoc
+pprPackageKey pk = sdocWithDynFlags $ \dflags ->
+    -- name cache is a memotable
+    let shpk = unsafePerformIO (lookupPackageKey dflags pk)
+    in case shpk of
+        shpk@ShPackageKey{} ->
+            ppr (shPackageKeyUnitName shpk) <>
+                parens (hsep
+                    (punctuate comma [ ppUnless (moduleName m == modname)
+                                                (ppr modname <+> text "->")
+                                       <+> ppr m
+                                     | (modname, m) <- shPackageKeyInsts shpk]))
+            <> ifPprDebug (braces (ftext (packageKeyFS pk)))
+        ShDefinitePackageKey pk -> ftext (packageKeyFS pk)
+
+-- NB: newPackageKey and lookupPackageKey are mutually recursive; this
+-- recursion is guaranteed to bottom out because you can't set up cycles
+-- of PackageKeys.
+
+
+{-
+************************************************************************
+*                                                                      *
+                        Package key hashing
+*                                                                      *
+************************************************************************
+-}
+
+-- | Generates a 'PackageKey'.  Don't call this directly; you probably
+-- want to cache the result.
+mkPackageKey :: UnitName
+             -> LibraryName
+             -> [(ModuleName, Module)] -- hole instantiations
+             -> PackageKey
+mkPackageKey (UnitName fsUnitName)
+             (LibraryName fsLibraryName) unsorted_holes =
+    -- NB: don't use concatFS here, it's not much of an improvement
+    fingerprintPackageKey . fingerprintString $
+        unpackFS fsUnitName ++ "\n" ++
+        unpackFS fsLibraryName ++ "\n" ++
+        concat [ moduleNameString m
+                ++ " " ++ packageKeyString (modulePackageKey b)
+                ++ ":" ++ moduleNameString (moduleName b) ++ "\n"
+               | (m, b) <- sortBy (stableModuleNameCmp `on` fst) unsorted_holes]
+
+-- | Generalize a 'Module' into one where all the holes are indefinite.
+-- @p(A -> ...):C@ generalizes to @p(A -> HOLE:A):C@.  Useful when
+-- you need to figure out if you've already type-checked the generalized
+-- version of this module, so you don't have to do the whole rigamarole.
+generalizeHoleModule :: DynFlags -> Module -> IO Module
+generalizeHoleModule dflags m = do
+    pk <- generalizeHolePackageKey dflags (modulePackageKey m)
+    return (mkModule pk (moduleName m))
+
+-- | Generalize a 'PackageKey' into one where all the holes are indefinite.
+-- @p(A -> q():A) generalizes to p(A -> HOLE:A)@.
+generalizeHolePackageKey :: DynFlags -> PackageKey -> IO PackageKey
+generalizeHolePackageKey dflags pk = do
+    shpk <- lookupPackageKey dflags pk
+    case shpk of
+        ShDefinitePackageKey _ -> return pk
+        ShPackageKey { shPackageKeyUnitName = pn,
+                       shPackageKeyLibraryName = vh,
+                       shPackageKeyInsts = insts0 }
+          -> let insts = map (\(x, _) -> (x, mkModule holePackageKey x)) insts0
+             in newPackageKey dflags pn vh insts
+
+-- | Canonicalize a 'Module' so that it uniquely identifies a module.
+-- For example, @p(A -> M):A@ canonicalizes to @M@.  Useful for making
+-- sure the interface you've loaded as the right @mi_module@.
+canonicalizeModule :: DynFlags -> Module -> IO Module
+canonicalizeModule dflags m = do
+    let pk = modulePackageKey m
+    shpk <- lookupPackageKey dflags pk
+    return $ case shpk of
+        ShPackageKey { shPackageKeyInsts = insts }
+            | Just m' <- lookup (moduleName m) insts -> m'
+        _ -> m
+
+{-
+************************************************************************
+*                                                                      *
+                        Base 62
+*                                                                      *
+************************************************************************
+-}
+
+--------------------------------------------------------------------------
+-- Base 62
+
+-- The base-62 code is based off of 'locators'
+-- ((c) Operational Dynamics Consulting, BSD3 licensed)
+
+-- Note: Instead of base-62 encoding a single 128-bit integer
+-- (ceil(21.49) characters), we'll base-62 a pair of 64-bit integers
+-- (2 * ceil(10.75) characters).  Luckily for us, it's the same number of
+-- characters!  In the long term, this should go in GHC.Fingerprint,
+-- but not now...
+
+-- | Size of a 64-bit word when written as a base-62 string
+word64Base62Len :: Int
+word64Base62Len = 11
+
+-- | Converts a 64-bit word into a base-62 string
+toBase62 :: Word64 -> String
+toBase62 w = pad ++ str
+  where
+    pad = replicate len '0'
+    len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)
+    str = showIntAtBase 62 represent w ""
+    represent :: Int -> Char
+    represent x
+        | x < 10 = Char.chr (48 + x)
+        | x < 36 = Char.chr (65 + x - 10)
+        | x < 62 = Char.chr (97 + x - 36)
+        | otherwise = error ("represent (base 62): impossible!")
+
+fingerprintPackageKey :: Fingerprint -> PackageKey
+fingerprintPackageKey (Fingerprint a b)
+    = stringToPackageKey (toBase62 a ++ toBase62 b)
index 536c536..28227f3 100644 (file)
@@ -124,6 +124,7 @@ Library
         cbits/genSym.c
 
     hs-source-dirs:
+        backpack
         basicTypes
         cmm
         codeGen
@@ -500,6 +501,7 @@ Library
         Vectorise
         Hoopl.Dataflow
         Hoopl
+        ShPackageKey
 --        CgInfoTbls used in ghci/DebuggerUtils
 --        CgHeapery  mkVirtHeapOffsets used in ghci
 
index ad604c8..74e9bf3 100644 (file)
@@ -100,6 +100,10 @@ module DynFlags (
         parseDynamicFilePragma,
         parseDynamicFlagsFull,
 
+        -- ** Package key cache
+        PackageKeyCache,
+        ShPackageKey(..),
+
         -- ** Available DynFlags
         allFlags,
         flagsAll,
@@ -177,6 +181,8 @@ import Foreign.C        ( CInt(..) )
 import System.IO.Unsafe ( unsafeDupablePerformIO )
 #endif
 import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
+import UniqFM
+import UniqSet
 
 import System.IO.Unsafe ( unsafePerformIO )
 import Data.IORef
@@ -654,6 +660,29 @@ type SigOf = Map ModuleName Module
 getSigOf :: DynFlags -> ModuleName -> Maybe Module
 getSigOf dflags n = Map.lookup n (sigOf dflags)
 
+-- NameCache updNameCache
+type PackageKeyEnv = UniqFM
+type PackageKeyCache = PackageKeyEnv ShPackageKey
+
+-- | An elaborated representation of a 'PackageKey', which records
+-- all of the components that go into the hashed 'PackageKey'.
+data ShPackageKey
+    = ShPackageKey {
+          shPackageKeyUnitName          :: !UnitName,
+          shPackageKeyLibraryName       :: !LibraryName,
+          shPackageKeyInsts             :: ![(ModuleName, Module)],
+          shPackageKeyFreeHoles         :: UniqSet ModuleName
+      }
+    | ShDefinitePackageKey {
+          shPackageKey :: !PackageKey
+      }
+    deriving Eq
+
+instance Outputable ShPackageKey where
+    ppr (ShPackageKey pn vh insts fh)
+        = ppr pn <+> ppr vh <+> ppr insts <+> parens (ppr fh)
+    ppr (ShDefinitePackageKey pk) = ppr pk
+
 -- | Contains not only a collection of 'GeneralFlag's but also a plethora of
 -- information relating to the compilation of a single file or GHC session
 data DynFlags = DynFlags {
@@ -698,7 +727,10 @@ data DynFlags = DynFlags {
   solverIterations      :: IntWithInf,   -- ^ Number of iterations in the constraints solver
                                          --   Typically only 1 is needed
 
-  thisPackage           :: PackageKey,   -- ^ name of package currently being compiled
+  thisPackage           :: PackageKey,   -- ^ key of package currently being compiled
+  thisLibraryName       :: LibraryName,
+                            -- ^ the version hash which identifies the textual
+                            --   package being compiled.
 
   -- ways
   ways                  :: [Way],       -- ^ Way flags from the command line
@@ -785,6 +817,7 @@ data DynFlags = DynFlags {
   -- Packages.initPackages
   pkgDatabase           :: Maybe [PackageConfig],
   pkgState              :: PackageState,
+  pkgKeyCache           :: {-# UNPACK #-} !(IORef PackageKeyCache),
 
   -- Temporary files
   -- These have to be IORefs, because the defaultCleanupHandler needs to
@@ -1437,6 +1470,7 @@ defaultDynFlags mySettings =
         solverIterations        = treatZeroAsInf mAX_SOLVER_ITERATIONS,
 
         thisPackage             = mainPackageKey,
+        thisLibraryName         = LibraryName nilFS,
 
         objectDir               = Nothing,
         dylibInstallName        = Nothing,
@@ -1482,6 +1516,7 @@ defaultDynFlags mySettings =
         pkgDatabase             = Nothing,
         -- This gets filled in with GHC.setSessionDynFlags
         pkgState                = emptyPackageState,
+        pkgKeyCache             = v_unsafePkgKeyCache,
         ways                    = defaultWays mySettings,
         buildTag                = mkBuildTag (defaultWays mySettings),
         rtsBuildTag             = mkBuildTag (defaultWays mySettings),
@@ -2730,6 +2765,7 @@ package_flags = [
                                       upd (setPackageKey name)
                                       deprecate "Use -this-package-key instead")
   , defGhcFlag "this-package-key"   (hasArg setPackageKey)
+  , defGhcFlag "library-name"       (hasArg setLibraryName)
   , defFlag "package-id"            (HasArg exposePackageId)
   , defFlag "package"               (HasArg exposePackage)
   , defFlag "package-key"           (HasArg exposePackageKey)
@@ -3725,6 +3761,9 @@ exposePackage' p dflags
 setPackageKey :: String -> DynFlags -> DynFlags
 setPackageKey p s =  s{ thisPackage = stringToPackageKey p }
 
+setLibraryName :: String -> DynFlags -> DynFlags
+setLibraryName v s = s{ thisLibraryName = LibraryName (mkFastString v) }
+
 -- -----------------------------------------------------------------------------
 -- | Find the package environment (if one exists)
 --
@@ -4179,6 +4218,8 @@ unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
 setUnsafeGlobalDynFlags :: DynFlags -> IO ()
 setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
 
+GLOBAL_VAR(v_unsafePkgKeyCache, emptyUFM, PackageKeyCache)
+
 -- -----------------------------------------------------------------------------
 -- SSE and AVX
 
index 3c41151..71a84d8 100644 (file)
@@ -12,13 +12,18 @@ module PackageConfig (
         -- * PackageKey
         packageConfigId,
 
+        -- * LibraryName
+        LibraryName(..),
+
         -- * The PackageConfig type: information about a package
         PackageConfig,
         InstalledPackageInfo(..),
         InstalledPackageId(..),
         SourcePackageId(..),
         PackageName(..),
+        UnitName(..),
         Version(..),
+        packageUnitName,
         defaultPackageConfig,
         installedPackageIdString,
         sourcePackageIdString,
@@ -54,6 +59,8 @@ type PackageConfig = InstalledPackageInfo
 newtype InstalledPackageId = InstalledPackageId FastString deriving (Eq, Ord)
 newtype SourcePackageId    = SourcePackageId    FastString deriving (Eq, Ord)
 newtype PackageName        = PackageName        FastString deriving (Eq, Ord)
+newtype UnitName           = UnitName           FastString deriving (Eq, Ord)
+newtype LibraryName        = LibraryName        FastString deriving (Eq, Ord)
 
 instance BinaryStringRep InstalledPackageId where
   fromStringRep = InstalledPackageId . mkFastStringByteString
@@ -67,6 +74,10 @@ instance BinaryStringRep PackageName where
   fromStringRep = PackageName . mkFastStringByteString
   toStringRep (PackageName s) = fastStringToByteString s
 
+instance BinaryStringRep LibraryName where
+  fromStringRep = LibraryName . mkFastStringByteString
+  toStringRep (LibraryName s) = fastStringToByteString s
+
 instance Uniquable InstalledPackageId where
   getUnique (InstalledPackageId n) = getUnique n
 
@@ -79,6 +90,12 @@ instance Uniquable PackageName where
 instance Outputable InstalledPackageId where
   ppr (InstalledPackageId str) = ftext str
 
+instance Outputable UnitName where
+  ppr (UnitName str) = ftext str
+
+instance Outputable LibraryName where
+  ppr (LibraryName str) = ftext str
+
 instance Outputable SourcePackageId where
   ppr (SourcePackageId str) = ftext str
 
@@ -172,3 +189,6 @@ pprPackageConfig InstalledPackageInfo {..} =
 packageConfigId :: PackageConfig -> PackageKey
 packageConfigId = packageKey
 
+packageUnitName :: PackageConfig -> UnitName
+packageUnitName pkg = let PackageName fs = packageName pkg
+                      in UnitName fs
index 16ee352..2082247 100644 (file)
@@ -363,7 +363,7 @@ initPackages dflags = do
                 Nothing -> readPackageConfigs dflags
                 Just db -> return $ setBatchPackageFlags dflags db
   (pkg_state, preload, this_pkg)
-        <- mkPackageState dflags pkg_db [] (thisPackage dflags)
+        <- mkPackageState dflags pkg_db []
   return (dflags{ pkgDatabase = Just pkg_db,
                   pkgState = pkg_state,
                   thisPackage = this_pkg },
@@ -885,15 +885,17 @@ mkPackageState
     :: DynFlags
     -> [PackageConfig]          -- initial database
     -> [PackageKey]              -- preloaded packages
-    -> PackageKey                -- this package
     -> IO (PackageState,
            [PackageKey],         -- new packages to preload
            PackageKey) -- this package, might be modified if the current
                       -- package is a wired-in package.
 
-mkPackageState dflags0 pkgs0 preload0 this_package = do
+mkPackageState dflags0 pkgs0 preload0 = do
   dflags <- interpretPackageEnv dflags0
 
+  -- Compute the package key
+  let this_package = thisPackage dflags
+
 {-
    Plan.
 
index 555c67f..1d3b4b4 100644 (file)
@@ -274,8 +274,22 @@ exposed-modules: Network.BSD,
           <para>Tells GHC the the module being compiled forms part of
             package key <replaceable>foo</replaceable>; internally, these
             keys are used to determine type equality and linker symbols.
-            If this flag is omitted (a very common case) then the
-            default package <literal>main</literal> is assumed.</para>
+            </para>
+        </listitem>
+      </varlistentry>
+
+      <varlistentry>
+        <term><option>-library-name</option> <replaceable>hash</replaceable>
+        <indexterm><primary><option>-library-name</option></primary>
+          </indexterm></term>
+        <listitem>
+          <para>Tells GHC that the source of a Backpack file and
+          its textual dependencies is uniquely identified by
+          <replaceable>hash</replaceable>.  Library names are determined
+          by Cabal; a usual recipe for a library name is that it is
+          the hash source package identifier of a package, as well as the
+          version hashes of all its textual dependencies.  GHC will
+          then use this library name to generate more package keys.</para>
         </listitem>
       </varlistentry>
 
@@ -1237,8 +1251,10 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf
     </itemizedlist>
 
      <para>To compile a module which is to be part of a new package,
-      use the <literal>-this-package-key</literal> option (<xref linkend="using-packages"/>).
-      Failure to use the <literal>-this-package-key</literal> option
+      use the <literal>-package-name</literal> (to identify the name of the package) and
+      <literal>-library-name</literal> (to identify the version and the version
+      hashes of its identities.) options (<xref linkend="using-packages"/>).
+      Failure to use these options
       when compiling a package will probably result in disaster, but
       you will only discover later when you attempt to import modules
       from the package.  At this point GHC will complain that the
index 03530bf..f47732a 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 03530bf99d96f8e8ab00cd18a18222eeba064734
+Subproject commit f47732a50d4bd103c5660c2fbcd77cbce8c521b5
index c284842..73cffd7 100644 (file)
@@ -22,7 +22,7 @@ sigcabal01:
        cd p && $(SETUP) build
        cd p && $(SETUP) copy
        cd p && $(SETUP) register --print-ipid > ../p_strict
-       '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package-id "`cat p_lazy` (P as P.Lazy)" -package-id "`cat p_strict` (P as P.Strict)" --make Main.hs
+       '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package containers -package-id "`cat p_lazy` (P as P.Lazy)" -package-id "`cat p_strict` (P as P.Strict)" --make Main.hs
        ! ./Main
 ifneq "$(CLEANUP)" ""
        $(MAKE) clean
index a797c08..24c50b6 100644 (file)
@@ -4,6 +4,6 @@ else:
    cleanup = ''
 
 test('sigcabal01',
-     normal,
+     expect_broken(10622),
      run_command,
      ['$MAKE -s --no-print-directory sigcabal01 ' + cleanup])
index 152aaea..c45697d 100644 (file)
@@ -21,9 +21,9 @@ sigcabal02:
        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
+       '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package containers -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
+       ! '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package containers -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make ShouldFail.hs
 ifneq "$(CLEANUP)" ""
        $(MAKE) clean
 endif
index 12223e5..a3810ff 100644 (file)
@@ -29,17 +29,17 @@ trusted: safe
 require own pkg trusted: True
 
 M_SafePkg6
-package dependencies: array-0.5.1.0 bytestring-0.10.6.0* deepseq-1.4.1.1 base-4.8.2.0* ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
+package dependencies: bytestring-0.10.6.0* deepseq-1.4.1.1 array-0.5.1.0 base-4.8.2.0* ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
 trusted: trustworthy
 require own pkg trusted: False
 
 M_SafePkg7
-package dependencies: array-0.5.1.0 bytestring-0.10.6.0* deepseq-1.4.1.1 base-4.8.2.0* ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
+package dependencies: bytestring-0.10.6.0* deepseq-1.4.1.1 array-0.5.1.0 base-4.8.2.0* ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
 trusted: safe
 require own pkg trusted: False
 
 M_SafePkg8
-package dependencies: array-0.5.1.0 bytestring-0.10.6.0* deepseq-1.4.1.1 base-4.8.2.0 ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
+package dependencies: bytestring-0.10.6.0* deepseq-1.4.1.1 array-0.5.1.0 base-4.8.2.0 ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
 trusted: trustworthy
 require own pkg trusted: False
 
index 1c0a217..98029ab 100644 (file)
@@ -4,9 +4,9 @@ TYPE CONSTRUCTORS
   data T (a :: k)
 COERCION AXIOMS
 Dependent modules: []
-Dependent packages: [array-0.5.1.0, deepseq-1.4.1.1,
-                     pretty-1.1.2.0, base-4.8.2.0, ghc-prim-0.4.0.0,
-                     integer-gmp-1.0.0.0, template-haskell-2.10.0.0]
+Dependent packages: [pretty-1.1.2.0, deepseq-1.4.1.1,
+                     array-0.5.1.0, base-4.8.2.0, ghc-prim-0.4.0.0, integer-gmp-1.0.0.0,
+                     template-haskell-2.10.0.0]
 
 ==================== Typechecker ====================
 
index ed57fb8..206b676 100644 (file)
@@ -292,21 +292,22 @@ fixupPackageId ipinfos (InstalledPackageId ipi)
 -- On Windows we need to split the ghc package into 2 pieces, or the
 -- DLL that it makes contains too many symbols (#5987). There are
 -- therefore 2 libraries, not just the 1 that Cabal assumes.
-mangleLbi :: FilePath -> FilePath -> LocalBuildInfo -> LocalBuildInfo
-mangleLbi "compiler" "stage2" lbi
+mangleIPI :: FilePath -> FilePath -> LocalBuildInfo
+          -> Installed.InstalledPackageInfo -> Installed.InstalledPackageInfo
+mangleIPI "compiler" "stage2" lbi ipi
  | isWindows =
-    let ccs' = [ (cn, updateComponentLocalBuildInfo clbi, cns)
-               | (cn, clbi, cns) <- componentsConfigs lbi ]
-        updateComponentLocalBuildInfo clbi@(LibComponentLocalBuildInfo {})
-            = let cls' = concat [ [ LibraryName n, LibraryName (n ++ "-0") ]
-                                | LibraryName n <- componentLibraries clbi ]
-              in clbi { componentLibraries = cls' }
-        updateComponentLocalBuildInfo clbi = clbi
-    in lbi { componentsConfigs = ccs' }
+    -- Cabal currently only ever installs ONE Haskell library, c.f.
+    -- the code in Cabal.Distribution.Simple.Register.  If it
+    -- ever starts installing more we'll have to find the
+    -- library that's too big and split that.
+    let [old_hslib] = Installed.hsLibraries ipi
+    in ipi {
+        Installed.hsLibraries = [old_hslib, old_hslib ++ "-0"]
+    }
     where isWindows = case hostPlatform lbi of
                       Platform _ Windows -> True
                       _                  -> False
-mangleLbi _ _ lbi = lbi
+mangleIPI _ _ _ ipi = ipi
 
 generate :: FilePath -> FilePath -> String -> [String] -> IO ()
 generate directory distdir dll0Modules config_args
@@ -318,9 +319,8 @@ generate directory distdir dll0Modules config_args
       withArgs (["configure", "--distdir", distdir] ++ config_args)
                runDefaultMain
 
-      lbi0 <- getPersistBuildConfig distdir
-      let lbi = mangleLbi directory distdir lbi0
-          pd0 = localPkgDescr lbi
+      lbi <- getPersistBuildConfig distdir
+      let pd0 = localPkgDescr lbi
 
       writePersistBuildConfig distdir lbi
 
@@ -345,7 +345,7 @@ generate directory distdir dll0Modules config_args
              let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
              let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
                                         pd ipid lib lbi clbi
-                 final_ipi = installedPkgInfo {
+                 final_ipi = mangleIPI directory distdir lbi $ installedPkgInfo {
                                  Installed.installedPackageId = ipid,
                                  Installed.haddockHTMLs = []
                              }
@@ -405,9 +405,7 @@ generate directory distdir dll0Modules config_args
           dep_ipids = map (display . Installed.installedPackageId) dep_direct
           depLibNames
             | packageKeySupported comp
-                = map (\p -> packageKeyLibraryName
-                                (Installed.sourcePackageId p)
-                                (Installed.packageKey p)) dep_direct
+                = map (display . Installed.libraryName) dep_direct
             | otherwise = deps
           depNames = map (display . packageName) dep_ids
 
@@ -415,9 +413,7 @@ generate directory distdir dll0Modules config_args
           transitiveDeps = map display transitive_dep_ids
           transitiveDepLibNames
             | packageKeySupported comp
-                = map (\p -> packageKeyLibraryName
-                                (Installed.sourcePackageId p)
-                                (Installed.packageKey p)) dep_pkgs
+                = map (display . Installed.libraryName) dep_pkgs
             | otherwise = transitiveDeps
           transitiveDepNames = map (display . packageName) transitive_dep_ids
 
@@ -437,9 +433,10 @@ generate directory distdir dll0Modules config_args
           otherMods = map display (otherModules bi)
           allMods = mods ++ otherMods
       let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
-                variablePrefix ++ "_PACKAGE_KEY = " ++ display (pkgKey lbi),
+                -- TODO: move inside withLibLBI
+                variablePrefix ++ "_PACKAGE_KEY = " ++ display (localPackageKey lbi),
                 -- copied from mkComponentsLocalBuildInfo
-                variablePrefix ++ "_LIB_NAME = " ++ packageKeyLibraryName (package pd) (pkgKey lbi),
+                variablePrefix ++ "_LIB_NAME = " ++ display (localLibraryName lbi),
                 variablePrefix ++ "_MODULES = " ++ unwords mods,
                 variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords otherMods,
                 variablePrefix ++ "_SYNOPSIS =" ++ synopsis pd,