import SrcLoc
import qualified Maybes
import UniqSet
+import FiniteMap
import Constants
import FastString
import Config ( cProjectVersion )
linkPackages' :: DynFlags -> [PackageId] -> PersistentLinkerState
-> IO PersistentLinkerState
linkPackages' dflags new_pks pls = do
- let pkg_map = pkgIdMap (pkgState dflags)
-
- pkgs' <- link pkg_map (pkgs_loaded pls) new_pks
-
+ pkgs' <- link (pkgs_loaded pls) new_pks
return $! pls { pkgs_loaded = pkgs' }
where
- link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
- link pkg_map pkgs new_pkgs =
- foldM (link_one pkg_map) pkgs new_pkgs
+ pkg_map = pkgIdMap (pkgState dflags)
+ ipid_map = installedPackageIdMap (pkgState dflags)
+
+ link :: [PackageId] -> [PackageId] -> IO [PackageId]
+ link pkgs new_pkgs =
+ foldM link_one pkgs new_pkgs
- link_one pkg_map pkgs new_pkg
+ link_one pkgs new_pkg
| new_pkg `elem` pkgs -- Already linked
= return pkgs
| Just pkg_cfg <- lookupPackage pkg_map new_pkg
= do { -- Link dependents first
- pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
+ pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
+ lookupFM ipid_map ipid
+ | ipid <- depends pkg_cfg ]
-- Now link the package itself
; linkPackage dflags pkg_cfg
; return (new_pkg : pkgs') }
let dlls = [ dll | DLL dll <- classifieds ]
objs = [ obj | Object obj <- classifieds ]
- maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ")
+ maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
-- See comments with partOfGHCi
when (packageName pkg `notElem` partOfGHCi) $ do
maybePutStr dflags "linking ... "
ok <- resolveObjs
if succeeded ok then maybePutStrLn dflags "done."
- else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
+ else ghcError (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
load_dyn :: [FilePath] -> FilePath -> IO ()
load_dyn dirs dll = do r <- loadDynamic dirs dll