Commit f9687caf authored by Edward Z. Yang's avatar Edward Z. Yang

Library names, with Cabal submodule update

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: default avatarEdward 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
parent 5ff4dadd
This diff is collapsed.
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -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.
......
......@@ -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
......
Subproject commit 03530bf99d96f8e8ab00cd18a18222eeba064734
Subproject commit f47732a50d4bd103c5660c2fbcd77cbce8c521b5
......@@ -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
......
......@@ -4,6 +4,6 @@ else:
cleanup = ''
test('sigcabal01',
normal,
expect_broken(10622),
run_command,
['$MAKE -s --no-print-directory sigcabal01 ' + cleanup])
......@@ -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
......
......@@ -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
......
......@@ -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 ====================
......@@ -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,
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment