summaryrefslogtreecommitdiff
path: root/compiler/backpack
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-01-15 17:48:30 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-01-31 02:46:15 -0500
commit29c701c154cafa4844cf3c1bd4a93cacfa6b1ee1 (patch)
tree88a060f43c73306463510b53607c1fd9460bd84b /compiler/backpack
parentbf38a20eefcaaaac404a1818c3eff8273dc67dd9 (diff)
downloadhaskell-29c701c154cafa4844cf3c1bd4a93cacfa6b1ee1.tar.gz
Refactor package related code
The package terminology is a bit of a mess. Cabal packages contain components. Instances of these components when built with some flags/options/dependencies are called units. Units are registered into package databases and their metadata are called PackageConfig. GHC only knows about package databases containing units. It is a sad mismatch not fixed by this patch (we would have to rename parameters such as `package-id <unit-id>` which would affect users). This patch however fixes the following internal names: - Renames PackageConfig into UnitInfo. - Rename systemPackageConfig into globalPackageDatabase[Path] - Rename PkgConfXX into PkgDbXX - Rename pkgIdMap into unitIdMap - Rename ModuleToPkgDbAll into ModuleNameProvidersMap - Rename lookupPackage into lookupUnit - Add comments on DynFlags package related fields It also introduces a new `PackageDatabase` datatype instead of explicitly passing the following tuple: `(FilePath,[PackageConfig])`. The `pkgDatabase` field in `DynFlags` now contains the unit info for each unit of each package database exactly as they have been read from disk. Previously the command-line flag `-distrust-all-packages` would modify these unit info. Now this flag only affects the "dynamic" consolidated package state found in `pkgState` field. It makes sense because `initPackages` could be called first with this `distrust-all-packages` flag set and then again (using ghc-api) without and it should work (package databases are not read again from disk when `initPackages` is called the second time). Bump haddock submodule
Diffstat (limited to 'compiler/backpack')
-rw-r--r--compiler/backpack/BkpSyn.hs2
-rw-r--r--compiler/backpack/DriverBkp.hs29
2 files changed, 15 insertions, 16 deletions
diff --git a/compiler/backpack/BkpSyn.hs b/compiler/backpack/BkpSyn.hs
index ce14018883..fcc0160899 100644
--- a/compiler/backpack/BkpSyn.hs
+++ b/compiler/backpack/BkpSyn.hs
@@ -23,7 +23,7 @@ import GHC.Hs
import SrcLoc
import Outputable
import Module
-import PackageConfig
+import UnitInfo
{-
************************************************************************
diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index 0afef71bb7..e8fdba5bd3 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -190,7 +190,7 @@ withBkpSession cid insts deps session_type do_this = do
importPaths = [],
-- Synthesized the flags
packageFlags = packageFlags dflags ++ map (\(uid0, rn) ->
- let uid = unwireUnitId dflags (improveUnitId (getPackageConfigMap dflags) $ renameHoleUnitId dflags (listToUFM insts) uid0)
+ let uid = unwireUnitId dflags (improveUnitId (getUnitInfoMap dflags) $ renameHoleUnitId dflags (listToUFM insts) uid0)
in ExposePackage
(showSDoc dflags
(text "-unit-id" <+> ppr uid <+> ppr rn))
@@ -271,7 +271,7 @@ buildUnit session cid insts lunit = do
dflags <- getDynFlags
-- IMPROVE IT
- let deps = map (improveUnitId (getPackageConfigMap dflags)) deps0
+ let deps = map (improveUnitId (getUnitInfoMap dflags)) deps0
mb_old_eps <- case session of
TcSession -> fmap Just getEpsGhc
@@ -375,20 +375,19 @@ compileExe lunit = do
ok <- load' LoadAllTargets (Just msg) mod_graph
when (failed ok) (liftIO $ exitWith (ExitFailure 1))
-addPackage :: GhcMonad m => PackageConfig -> m ()
+-- | Register a new virtual package database containing a single unit
+addPackage :: GhcMonad m => UnitInfo -> m ()
addPackage pkg = do
- dflags0 <- GHC.getSessionDynFlags
- case pkgDatabase dflags0 of
+ dflags <- GHC.getSessionDynFlags
+ case pkgDatabase dflags of
Nothing -> panic "addPackage: called too early"
- Just pkgs -> do let dflags = dflags0 { pkgDatabase =
- Just (pkgs ++ [("(in memory " ++ showSDoc dflags0 (ppr (unitId pkg)) ++ ")", [pkg])]) }
- _ <- GHC.setSessionDynFlags dflags
- -- By this time, the global ref has probably already
- -- been forced, in which case doing this isn't actually
- -- going to do you any good.
- -- dflags <- GHC.getSessionDynFlags
- -- liftIO $ setUnsafeGlobalDynFlags dflags
- return ()
+ Just dbs -> do
+ let newdb = PackageDatabase
+ { packageDatabasePath = "(in memory " ++ showSDoc dflags (ppr (unitId pkg)) ++ ")"
+ , packageDatabaseUnits = [pkg]
+ }
+ _ <- GHC.setSessionDynFlags (dflags { pkgDatabase = Just (dbs ++ [newdb]) })
+ return ()
-- Precondition: UnitId is NOT InstalledUnitId
compileInclude :: Int -> (Int, UnitId) -> BkpM ()
@@ -397,7 +396,7 @@ compileInclude n (i, uid) = do
let dflags = hsc_dflags hsc_env
msgInclude (i, n) uid
-- Check if we've compiled it already
- case lookupPackage dflags uid of
+ case lookupUnit dflags uid of
Nothing -> do
case splitUnitIdInsts uid of
(_, Just indef) ->