From 0b1e55f9de9c2e9f1e70bd8aa9383f4b2682dd9f Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 17 Sep 2009 12:15:10 +0000 Subject: [PATCH] Allow -package-id to override the default package shadowing semantics So that Cabal, if it wants, can use a more general algorithm to find a consistent set of packages to use. --- compiler/main/Packages.lhs | 93 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 80 insertions(+), 13 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 92a5153..077a4eb 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -127,6 +127,8 @@ type PackageConfigMap = UniqFM PackageConfig type InstalledPackageIdMap = FiniteMap InstalledPackageId PackageId +type InstalledPackageIndex = FiniteMap InstalledPackageId PackageConfig + emptyPackageConfigMap :: PackageConfigMap emptyPackageConfigMap = emptyUFM @@ -533,7 +535,7 @@ findBroken pkgs = go [] emptyFM pkgs where new_ipids = addListToFM ipids [ (installedPackageId p, p) | p <- new_avail ] - depsAvailable :: FiniteMap InstalledPackageId PackageConfig + depsAvailable :: InstalledPackageIndex -> PackageConfig -> Either PackageConfig (PackageConfig, [InstalledPackageId]) depsAvailable ipids pkg @@ -545,21 +547,27 @@ findBroken pkgs = go [] emptyFM pkgs -- Eliminate shadowed packages, giving the user some feedback -- later packages in the list should shadow earlier ones with the same --- package name/version. -shadowPackages :: [PackageConfig] -> UnusablePackages -shadowPackages pkgs - = let (_,shadowed) = foldl check (emptyUFM,[]) pkgs +-- package name/version. Additionally, a package may be preferred if +-- it is in the transitive closure of packages selected using -package-id +-- flags. +shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages +shadowPackages pkgs preferred + = let (shadowed,_) = foldl check ([],emptyUFM) pkgs in listToFM shadowed where - check (pkgmap,shadowed) pkg - = (addToUFM pkgmap (packageConfigId pkg) pkg, shadowed') - where - shadowed' + check (shadowed,pkgmap) pkg | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg) - = (installedPackageId oldpkg, ShadowedBy (installedPackageId pkg)) - :shadowed + = let + ipid_new = installedPackageId pkg + ipid_old = installedPackageId oldpkg + in + if ipid_old `elem` preferred + then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap ) + else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' ) | otherwise - = shadowed + = (shadowed, pkgmap') + where + pkgmap' = addToUFM pkgmap (packageConfigId pkg) pkg -- ----------------------------------------------------------------------------- @@ -576,6 +584,20 @@ ignorePackages flags pkgs = listToFM (concatMap doit flags) doit _ = panic "ignorePackages" -- ----------------------------------------------------------------------------- + +depClosure :: InstalledPackageIndex + -> [InstalledPackageId] + -> [InstalledPackageId] +depClosure index ipids = closure emptyFM ipids + where + closure set [] = keysFM set + closure set (ipid : ipids) + | ipid `elemFM` set = closure set ipids + | Just p <- lookupFM index ipid = closure (addToFM set ipid p) + (depends p ++ ipids) + | otherwise = closure set ipids + +-- ----------------------------------------------------------------------------- -- When all the command-line options are in, we can process our package -- settings and populate the package state. @@ -592,13 +614,58 @@ mkPackageState mkPackageState dflags pkgs0 preload0 this_package = do +{- + Plan. + + 1. P = transitive closure of packages selected by -package-id + + 2. Apply shadowing. When there are multiple packages with the same + sourcePackageId, + * if one is in P, use that one + * otherwise, use the one highest in the package stack + [ + rationale: we cannot use two packages with the same sourcePackageId + in the same program, because sourcePackageId is the symbol prefix. + Hence we must select a consistent set of packages to use. We have + a default algorithm for doing this: packages higher in the stack + shadow those lower down. This default algorithm can be overriden + by giving explicit -package-id flags; then we have to take these + preferences into account when selecting which other packages are + made available. + + Our simple algorithm throws away some solutions: there may be other + consistent sets that would satisfy the -package flags, but it's + not GHC's job to be doing constraint solving. + ] + + 3. remove packages selected by -ignore-package + + 4. remove any packages with missing dependencies, or mutually recursive + dependencies. + + 5. report (with -v) any packages that were removed by steps 2-4 + + 6. apply flags to set exposed/hidden on the resulting packages + - if any flag refers to a package which was removed by 2-4, then + we can give an error message explaining why + + 7. hide any packages which are superseded by later exposed packages +-} + let flags = reverse (packageFlags dflags) + + ipid_map = listToFM [ (installedPackageId p, p) | p <- pkgs0 ] + + ipid_selected = depClosure ipid_map [ InstalledPackageId i + | ExposePackageId i <- flags ] + (ignore_flags, other_flags) = partition is_ignore flags is_ignore IgnorePackage{} = True is_ignore _ = False - shadowed = shadowPackages pkgs0 + shadowed = shadowPackages pkgs0 ipid_selected + ignored = ignorePackages ignore_flags pkgs0 pkgs0' = filter (not . (`elemFM` (plusFM shadowed ignored)) . installedPackageId) pkgs0 -- 1.7.10.4