Commit 10d15f1e authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

Refactoring unit management code

Over the years the unit management code has been modified a lot to keep
up with changes in Cabal (e.g. support for several library components in
the same package), to integrate BackPack, etc. I found it very hard to
understand as the terminology wasn't consistent, was referring to past
concepts, etc.

The terminology is now explained as clearly as I could in the Note
"About Units" and the code is refactored to reflect it.

-------------------

Many names were misleading: UnitId is not an Id but could be a virtual
unit (an indefinite one instantiated on the fly), IndefUnitId
constructor may contain a definite instantiated unit, etc.

   * Rename IndefUnitId into InstantiatedUnit
   * Rename IndefModule into InstantiatedModule
   * Rename UnitId type into Unit
   * Rename IndefiniteUnitId constructor into VirtUnit
   * Rename DefiniteUnitId constructor into RealUnit
   * Rename packageConfigId into mkUnit
   * Rename getPackageDetails into unsafeGetUnitInfo
   * Rename InstalledUnitId into UnitId

Remove references to misleading ComponentId: a ComponentId is just an
indefinite unit-id to be instantiated.

   * Rename ComponentId into IndefUnitId
   * Rename ComponentDetails into UnitPprInfo
   * Fix display of UnitPprInfo with empty version: this is now used for
     units dynamically generated by BackPack

Generalize several types (Module, Unit, etc.) so that they can be used
with different unit identifier types: UnitKey, UnitId, Unit, etc.

   * GenModule: Module, InstantiatedModule and InstalledModule are now
     instances of this type
   * Generalize DefUnitId, IndefUnitId, Unit, InstantiatedUnit,
     PackageDatabase

Replace BackPack fake "hole" UnitId by a proper HoleUnit constructor.

Add basic support for UnitKey. They should be used more in the future to
avoid mixing them up with UnitId as we do now.

Add many comments.

Update Haddock submodule
parent ea717aa4
......@@ -159,11 +159,11 @@ module GHC (
-- * Abstract syntax elements
-- ** Packages
UnitId,
-- ** Units
Unit,
-- ** Modules
Module, mkModule, pprModule, moduleName, moduleUnitId,
Module, mkModule, pprModule, moduleName, moduleUnit,
ModuleName, mkModuleName, moduleNameString,
-- ** Names
......@@ -594,7 +594,7 @@ checkBrokenTablesNextToCode' dflags
-- flags. If you are not doing linking or doing static linking, you
-- can ignore the list of packages returned.
--
setSessionDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]
setSessionDynFlags :: GhcMonad m => DynFlags -> m [UnitId]
setSessionDynFlags dflags = do
dflags' <- checkNewDynFlags dflags
dflags'' <- liftIO $ interpretPackageEnv dflags'
......@@ -643,7 +643,7 @@ setSessionDynFlags dflags = do
-- | Sets the program 'DynFlags'. Note: this invalidates the internal
-- cached module graph, causing more work to be done the next time
-- 'load' is called.
setProgramDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]
setProgramDynFlags :: GhcMonad m => DynFlags -> m [UnitId]
setProgramDynFlags dflags = setProgramDynFlags_ True dflags
-- | Set the action taken when the compiler produces a message. This
......@@ -655,7 +655,7 @@ setLogAction action = do
void $ setProgramDynFlags_ False $
dflags' { log_action = action }
setProgramDynFlags_ :: GhcMonad m => Bool -> DynFlags -> m [InstalledUnitId]
setProgramDynFlags_ :: GhcMonad m => Bool -> DynFlags -> m [UnitId]
setProgramDynFlags_ invalidate_needed dflags = do
dflags' <- checkNewDynFlags dflags
dflags_prev <- getProgramDynFlags
......@@ -1357,7 +1357,7 @@ packageDbModules only_exposed = do
[ mkModule pid modname
| p <- pkgs
, not only_exposed || exposed p
, let pid = packageConfigId p
, let pid = mkUnit p
, modname <- exposedModules p
++ map exportName (reexportedModules p) ]
-}
......@@ -1489,7 +1489,7 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
this_pkg = thisPackage dflags
--
case maybe_pkg of
Just pkg | fsToUnitId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
Just pkg | fsToUnit pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
res <- findImportedModule hsc_env mod_name maybe_pkg
case res of
Found _ m -> return m
......@@ -1501,7 +1501,7 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
Nothing -> liftIO $ do
res <- findImportedModule hsc_env mod_name maybe_pkg
case res of
Found loc m | moduleUnitId m /= this_pkg -> return m
Found loc m | moduleUnit m /= this_pkg -> return m
| otherwise -> modNotLoadedError dflags m loc
err -> throwOneError $ noModError dflags noSrcSpan mod_name err
......@@ -1545,7 +1545,7 @@ isModuleTrusted m = withSession $ \hsc_env ->
liftIO $ hscCheckSafe hsc_env m noSrcSpan
-- | Return if a module is trusted and the pkgs it depends on to be trusted.
moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set InstalledUnitId)
moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId)
moduleTrustReqs m = withSession $ \hsc_env ->
liftIO $ hscGetSafe hsc_env m noSrcSpan
......
......@@ -44,7 +44,7 @@ import GHC.Types.Basic ( Arity, Fixity(..), FixityDirection(..), Boxity(..),
import GHC.Types.SrcLoc ( wiredInSrcSpan )
import GHC.Types.ForeignCall ( CLabelString )
import GHC.Types.Unique ( Unique, mkPrimOpIdUnique, mkPrimOpWrapperUnique )
import GHC.Types.Module ( UnitId )
import GHC.Types.Module ( Unit )
import GHC.Utils.Outputable
import GHC.Data.FastString
......@@ -704,7 +704,7 @@ pprPrimOp other_op = pprOccName (primOpOcc other_op)
************************************************************************
-}
data PrimCall = PrimCall CLabelString UnitId
data PrimCall = PrimCall CLabelString Unit
instance Outputable PrimCall where
ppr (PrimCall lbl pkgId)
......
......@@ -164,7 +164,7 @@ nameToCLabel n suffix = mkFastString label
where
encodeZ = zString . zEncodeFS
(Module pkgKey modName) = ASSERT( isExternalName n ) nameModule n
packagePart = encodeZ (unitIdFS pkgKey)
packagePart = encodeZ (unitFS pkgKey)
modulePart = encodeZ (moduleNameFS modName)
occPart = encodeZ (occNameFS (nameOccName n))
......
......@@ -187,7 +187,7 @@ data CLabel
-- | A label from a .cmm file that is not associated with a .hs level Id.
| CmmLabel
UnitId -- what package the label belongs to.
Unit -- what package the label belongs to.
FastString -- identifier giving the prefix of the label
CmmLabelInfo -- encodes the suffix of the label
......@@ -354,7 +354,7 @@ instance Ord CLabel where
data ForeignLabelSource
-- | Label is in a named package
= ForeignLabelInPackage UnitId
= ForeignLabelInPackage Unit
-- | Label is in some external, system package that doesn't also
-- contain compiled Haskell code, and is not associated with any .hi files.
......@@ -553,7 +553,7 @@ mkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo
-----
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel
:: UnitId -> FastString -> CLabel
:: Unit -> FastString -> CLabel
mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo
mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry
......@@ -1082,7 +1082,7 @@ labelDynamic config this_mod lbl =
externalDynamicRefs = ncgExternalDynamicRefs config
platform = ncgPlatform config
os = platformOS platform
this_pkg = moduleUnitId this_mod
this_pkg = moduleUnit this_mod
-----------------------------------------------------------------------------
......
......@@ -585,7 +585,7 @@ importName
-- A label imported with an explicit packageId.
| STRING NAME
{ ($2, mkCmmCodeLabel (fsToUnitId (mkFastString $1)) $2) }
{ ($2, mkCmmCodeLabel (fsToUnit (mkFastString $1)) $2) }
names :: { [FastString] }
......@@ -1163,7 +1163,7 @@ profilingInfo dflags desc_str ty_str
then NoProfilingInfo
else ProfilingInfo (BS8.pack desc_str) (BS8.pack ty_str)
staticClosure :: UnitId -> FastString -> FastString -> [CmmLit] -> CmmParse ()
staticClosure :: Unit -> FastString -> FastString -> [CmmLit] -> CmmParse ()
staticClosure pkg cl_label info payload
= do dflags <- getDynFlags
let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
......
......@@ -9,12 +9,12 @@ where
import GHC.Prelude
import GHC.Platform
import GHC.Cmm.Type (Width(..))
import GHC.Types.Module
import GHC.Unit.Module
-- | Native code generator configuration
data NCGConfig = NCGConfig
{ ncgPlatform :: !Platform -- ^ Target platform
, ncgUnitId :: UnitId -- ^ Target unit ID
, ncgUnitId :: Unit -- ^ Target unit ID
, ncgProcAlignment :: !(Maybe Int) -- ^ Mandatory proc alignment
, ncgDebugLevel :: !Int -- ^ Debug level
, ncgExternalDynamicRefs :: !Bool -- ^ Generate code to link against dynamic libraries
......
......@@ -1391,7 +1391,7 @@ dataConRepArgTys (MkData { dcRep = rep
dataConIdentity :: DataCon -> ByteString
-- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
dataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat
[ BSB.byteString $ bytesFS (unitIdFS (moduleUnitId mod))
[ BSB.byteString $ bytesFS (unitFS (moduleUnit mod))
, BSB.int8 $ fromIntegral (ord ':')
, BSB.byteString $ bytesFS (moduleNameFS (moduleName mod))
, BSB.int8 $ fromIntegral (ord '.')
......
......@@ -25,7 +25,7 @@ import GHC.Driver.Backpack.Syntax
import GHC.Parser.Annotation
import GHC hiding (Failed, Succeeded)
import GHC.Driver.Packages
import GHC.Driver.Packages hiding (packageNameMap)
import GHC.Parser
import GHC.Parser.Lexer
import GHC.Driver.Monad
......@@ -96,14 +96,14 @@ doBackpack [src_filename] = do
innerBkpM $ do
let (cid, insts) = computeUnitId lunit
if null insts
then if cid == ComponentId (fsLit "main") Nothing
then if cid == Indefinite (UnitId (fsLit "main")) Nothing
then compileExe lunit
else compileUnit cid []
else typecheckUnit cid insts
doBackpack _ =
throwGhcException (CmdLineError "--backpack can only process a single file")
computeUnitId :: LHsUnit HsComponentId -> (ComponentId, [(ModuleName, Module)])
computeUnitId :: LHsUnit HsComponentId -> (IndefUnitId, [(ModuleName, Module)])
computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])
where
cid = hsComponentId (unLoc (hsunitName unit))
......@@ -112,7 +112,7 @@ computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])
get_reqs (DeclD HsSrcFile _ _) = emptyUniqDSet
get_reqs (DeclD HsBootFile _ _) = emptyUniqDSet
get_reqs (IncludeD (IncludeDecl (L _ hsuid) _ _)) =
unitIdFreeHoles (convertHsUnitId hsuid)
unitFreeModuleHoles (convertHsComponentId hsuid)
-- | Tiny enum for all types of Backpack operations we may do.
data SessionType
......@@ -129,17 +129,17 @@ data SessionType
-- | Create a temporary Session to do some sort of type checking or
-- compilation.
withBkpSession :: ComponentId
withBkpSession :: IndefUnitId
-> [(ModuleName, Module)]
-> [(UnitId, ModRenaming)]
-> [(Unit, ModRenaming)]
-> SessionType -- what kind of session are we doing
-> BkpM a -- actual action to run
-> BkpM a
withBkpSession cid insts deps session_type do_this = do
dflags <- getDynFlags
let (ComponentId cid_fs _) = cid
let cid_fs = unitIdFS (indefUnit cid)
is_primary = False
uid_str = unpackFS (hashUnitId cid insts)
uid_str = unpackFS (mkInstantiatedUnitHash cid insts)
cid_str = unpackFS cid_fs
-- There are multiple units in a single Backpack file, so we
-- need to separate out the results in those cases. Right now,
......@@ -174,12 +174,12 @@ withBkpSession cid insts deps session_type do_this = do
_ -> hscTarget dflags,
thisUnitIdInsts_ = Just insts,
thisComponentId_ = Just cid,
thisInstalledUnitId =
thisUnitId =
case session_type of
TcSession -> newInstalledUnitId cid Nothing
TcSession -> newUnitId cid Nothing
-- No hash passed if no instances
_ | null insts -> newInstalledUnitId cid Nothing
| otherwise -> newInstalledUnitId cid (Just (hashUnitId cid insts)),
_ | null insts -> newUnitId cid Nothing
| otherwise -> newUnitId cid (Just (mkInstantiatedUnitHash cid insts)),
-- Setup all of the output directories according to our hierarchy
objectDir = Just (outdir objectDir),
hiDir = Just (outdir hiDir),
......@@ -192,7 +192,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 (getUnitInfoMap dflags) $ renameHoleUnitId dflags (listToUFM insts) uid0)
let uid = unwireUnit dflags (improveUnit (getUnitInfoMap dflags) $ renameHoleUnit dflags (listToUFM insts) uid0)
in ExposePackage
(showSDoc dflags
(text "-unit-id" <+> ppr uid <+> ppr rn))
......@@ -204,41 +204,41 @@ withBkpSession cid insts deps session_type do_this = do
_ <- setSessionDynFlags dflags
do_this
withBkpExeSession :: [(UnitId, ModRenaming)] -> BkpM a -> BkpM a
withBkpExeSession :: [(Unit, ModRenaming)] -> BkpM a -> BkpM a
withBkpExeSession deps do_this = do
withBkpSession (ComponentId (fsLit "main") Nothing) [] deps ExeSession do_this
withBkpSession (Indefinite (UnitId (fsLit "main")) Nothing) [] deps ExeSession do_this
getSource :: ComponentId -> BkpM (LHsUnit HsComponentId)
getSource :: IndefUnitId -> BkpM (LHsUnit HsComponentId)
getSource cid = do
bkp_env <- getBkpEnv
case Map.lookup cid (bkp_table bkp_env) of
Nothing -> pprPanic "missing needed dependency" (ppr cid)
Just lunit -> return lunit
typecheckUnit :: ComponentId -> [(ModuleName, Module)] -> BkpM ()
typecheckUnit :: IndefUnitId -> [(ModuleName, Module)] -> BkpM ()
typecheckUnit cid insts = do
lunit <- getSource cid
buildUnit TcSession cid insts lunit
compileUnit :: ComponentId -> [(ModuleName, Module)] -> BkpM ()
compileUnit :: IndefUnitId -> [(ModuleName, Module)] -> BkpM ()
compileUnit cid insts = do
-- Let everyone know we're building this unit ID
msgUnitId (newUnitId cid insts)
-- Let everyone know we're building this unit
msgUnitId (mkVirtUnit cid insts)
lunit <- getSource cid
buildUnit CompSession cid insts lunit
-- | Compute the dependencies with instantiations of a syntactic
-- HsUnit; e.g., wherever you see @dependency p[A=<A>]@ in a
-- unit file, return the 'UnitId' corresponding to @p[A=<A>]@.
-- unit file, return the 'Unit' corresponding to @p[A=<A>]@.
-- The @include_sigs@ parameter controls whether or not we also
-- include @dependency signature@ declarations in this calculation.
--
-- Invariant: this NEVER returns InstalledUnitId.
hsunitDeps :: Bool {- include sigs -} -> HsUnit HsComponentId -> [(UnitId, ModRenaming)]
-- Invariant: this NEVER returns UnitId.
hsunitDeps :: Bool {- include sigs -} -> HsUnit HsComponentId -> [(Unit, ModRenaming)]
hsunitDeps include_sigs unit = concatMap get_dep (hsunitBody unit)
where
get_dep (L _ (IncludeD (IncludeDecl (L _ hsuid) mb_lrn is_sig)))
| include_sigs || not is_sig = [(convertHsUnitId hsuid, go mb_lrn)]
| include_sigs || not is_sig = [(convertHsComponentId hsuid, go mb_lrn)]
| otherwise = []
where
go Nothing = ModRenaming True []
......@@ -248,7 +248,7 @@ hsunitDeps include_sigs unit = concatMap get_dep (hsunitBody unit)
convRn (L _ (Renaming (L _ from) (Just (L _ to)))) = (from, to)
get_dep _ = []
buildUnit :: SessionType -> ComponentId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()
buildUnit :: SessionType -> IndefUnitId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()
buildUnit session cid insts lunit = do
-- NB: include signature dependencies ONLY when typechecking.
-- If we're compiling, it's not necessary to recursively
......@@ -260,7 +260,7 @@ buildUnit session cid insts lunit = do
-- The compilation dependencies are just the appropriately filled
-- in unit IDs which must be compiled before we can compile.
let hsubst = listToUFM insts
deps0 = map (renameHoleUnitId dflags hsubst) raw_deps
deps0 = map (renameHoleUnit dflags hsubst) raw_deps
-- Build dependencies OR make sure they make sense. BUT NOTE,
-- we can only check the ones that are fully filled; the rest
......@@ -273,7 +273,7 @@ buildUnit session cid insts lunit = do
dflags <- getDynFlags
-- IMPROVE IT
let deps = map (improveUnitId (getUnitInfoMap dflags)) deps0
let deps = map (improveUnit (getUnitInfoMap dflags)) deps0
mb_old_eps <- case session of
TcSession -> fmap Just getEpsGhc
......@@ -304,7 +304,7 @@ buildUnit session cid insts lunit = do
getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
obj_files = concatMap getOfiles linkables
let compat_fs = (case cid of ComponentId fs _ -> fs)
let compat_fs = unitIdFS (indefUnit cid)
compat_pn = PackageName compat_fs
return GenericUnitInfo {
......@@ -312,8 +312,8 @@ buildUnit session cid insts lunit = do
unitAbiHash = "",
unitPackageId = PackageId compat_fs,
unitPackageName = compat_pn,
unitPackageVersion = makeVersion [0],
unitId = toInstalledUnitId (thisPackage dflags),
unitPackageVersion = makeVersion [],
unitId = toUnitId (thisPackage dflags),
unitComponentName = Nothing,
unitInstanceOf = cid,
unitInstantiations = insts,
......@@ -327,8 +327,8 @@ buildUnit session cid insts lunit = do
-- really used for anything, so we leave it
-- blank for now.
TcSession -> []
_ -> map (toInstalledUnitId . unwireUnitId dflags)
$ deps ++ [ moduleUnitId mod
_ -> map (toUnitId . unwireUnit dflags)
$ deps ++ [ moduleUnit mod
| (_, mod) <- insts
, not (isHoleModule mod) ],
unitAbiDepends = [],
......@@ -391,21 +391,18 @@ addPackage pkg = do
_ <- GHC.setSessionDynFlags (dflags { pkgDatabase = Just (dbs ++ [newdb]) })
return ()
-- Precondition: UnitId is NOT InstalledUnitId
compileInclude :: Int -> (Int, UnitId) -> BkpM ()
compileInclude :: Int -> (Int, Unit) -> BkpM ()
compileInclude n (i, uid) = do
hsc_env <- getSession
let dflags = hsc_dflags hsc_env
msgInclude (i, n) uid
-- Check if we've compiled it already
case lookupUnit dflags uid of
Nothing -> do
case splitUnitIdInsts uid of
(_, Just indef) ->
innerBkpM $ compileUnit (indefUnitIdComponentId indef)
(indefUnitIdInsts indef)
_ -> return ()
Just _ -> return ()
case uid of
HoleUnit -> return ()
RealUnit _ -> return ()
VirtUnit i -> case lookupUnit dflags uid of
Nothing -> innerBkpM $ compileUnit (instUnitInstanceOf i) (instUnitInsts i)
Just _ -> return ()
-- ----------------------------------------------------------------------------
-- Backpack monad
......@@ -423,7 +420,7 @@ data BkpEnv
-- | The filename of the bkp file we're compiling
bkp_filename :: FilePath,
-- | Table of source units which we know how to compile
bkp_table :: Map ComponentId (LHsUnit HsComponentId),
bkp_table :: Map IndefUnitId (LHsUnit HsComponentId),
-- | When a package we are compiling includes another package
-- which has not been compiled, we bump the level and compile
-- that.
......@@ -535,7 +532,7 @@ msgTopPackage (i,n) (HsComponentId (PackageName fs_pn) _) = do
$ showModuleIndex (i, n) ++ "Processing " ++ unpackFS fs_pn
-- | Message when we instantiate a Backpack unit.
msgUnitId :: UnitId -> BkpM ()
msgUnitId :: Unit -> BkpM ()
msgUnitId pk = do
dflags <- getDynFlags
level <- getBkpLevel
......@@ -545,7 +542,7 @@ msgUnitId pk = do
(ppr pk)
-- | Message when we include a Backpack unit.
msgInclude :: (Int,Int) -> UnitId -> BkpM ()
msgInclude :: (Int,Int) -> Unit -> BkpM ()
msgInclude (i,n) uid = do
dflags <- getDynFlags
level <- getBkpLevel
......@@ -563,7 +560,7 @@ type PackageNameMap a = Map PackageName a
-- to use this for anything
unitDefines :: PackageState -> LHsUnit PackageName -> (PackageName, HsComponentId)
unitDefines pkgstate (L _ HsUnit{ hsunitName = L _ pn@(PackageName fs) })
= (pn, HsComponentId pn (mkComponentId pkgstate fs))
= (pn, HsComponentId pn (mkIndefUnitId pkgstate fs))
packageNameMap :: PackageState -> [LHsUnit PackageName] -> PackageNameMap HsComponentId
packageNameMap pkgstate units = Map.fromList (map (unitDefines pkgstate) units)
......@@ -609,16 +606,16 @@ renameHsUnits pkgstate m units = map (fmap renameHsUnit) units
renameHsModuleId (HsModuleVar lm) = HsModuleVar lm
renameHsModuleId (HsModuleId luid lm) = HsModuleId (fmap renameHsUnitId luid) lm
convertHsUnitId :: HsUnitId HsComponentId -> UnitId
convertHsUnitId (HsUnitId (L _ hscid) subst)
= newUnitId (hsComponentId hscid) (map (convertHsModuleSubst . unLoc) subst)
convertHsComponentId :: HsUnitId HsComponentId -> Unit
convertHsComponentId (HsUnitId (L _ hscid) subst)
= mkVirtUnit (hsComponentId hscid) (map (convertHsModuleSubst . unLoc) subst)
convertHsModuleSubst :: HsModuleSubst HsComponentId -> (ModuleName, Module)
convertHsModuleSubst (L _ modname, L _ m) = (modname, convertHsModuleId m)
convertHsModuleId :: HsModuleId HsComponentId -> Module
convertHsModuleId (HsModuleVar (L _ modname)) = mkHoleModule modname
convertHsModuleId (HsModuleId (L _ hsuid) (L _ modname)) = mkModule (convertHsUnitId hsuid) modname
convertHsModuleId (HsModuleId (L _ hsuid) (L _ modname)) = mkModule (convertHsComponentId hsuid) modname
......@@ -824,8 +821,7 @@ hsModuleToModSummary pn hsc_src modname
-- | Create a new, externally provided hashed unit id from
-- a hash.
newInstalledUnitId :: ComponentId -> Maybe FastString -> InstalledUnitId
newInstalledUnitId (ComponentId cid_fs _) (Just fs)
= InstalledUnitId (cid_fs `appendFS` mkFastString "+" `appendFS` fs)
newInstalledUnitId (ComponentId cid_fs _) Nothing
= InstalledUnitId cid_fs
newUnitId :: IndefUnitId -> Maybe FastString -> UnitId
newUnitId uid mhash = case mhash of
Nothing -> indefUnit uid
Just hash -> UnitId (unitIdFS (indefUnit uid) `appendFS` mkFastString "+" `appendFS` hash)
......@@ -35,7 +35,7 @@ import GHC.Unit.Info
data HsComponentId = HsComponentId {
hsPackageName :: PackageName,
hsComponentId :: ComponentId
hsComponentId :: IndefUnitId
}
instance Outputable HsComponentId where
......
......@@ -60,7 +60,7 @@ codeOutput :: DynFlags
-> ForeignStubs
-> [(ForeignSrcLang, FilePath)]
-- ^ additional files to be compiled with with the C compiler
-> [InstalledUnitId]
-> [UnitId]
-> Stream IO RawCmmGroup a -- Compiled C--
-> IO (FilePath,
(Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),
......@@ -120,7 +120,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
outputC :: DynFlags
-> FilePath
-> Stream IO RawCmmGroup a
-> [InstalledUnitId]
-> [UnitId]
-> IO a
outputC dflags filenm cmm_stream packages
......@@ -133,7 +133,7 @@ outputC dflags filenm cmm_stream packages
-- * -#include options from the cmdline and OPTIONS pragmas
-- * the _stub.h file, if there is one.
--
let rts = getPackageDetails dflags rtsUnitId
let rts = unsafeGetUnitInfo dflags rtsUnitId
let cc_injects = unlines (map mk_include (unitIncludes rts))
mk_include h_file =
......@@ -142,7 +142,7 @@ outputC dflags filenm cmm_stream packages
'<':_ -> "#include "++h_file
_ -> "#include \""++h_file++"\""
let pkg_names = map installedUnitIdString packages
let pkg_names = map unitIdString packages
doOutput filenm $ \ h -> do
hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
......@@ -225,7 +225,7 @@ outputForeignStubs dflags mod location stubs
-- we need the #includes from the rts package for the stub files
let rts_includes =
let rts_pkg = getPackageDetails dflags rtsUnitId in
let rts_pkg = unsafeGetUnitInfo dflags rtsUnitId in
concatMap mk_include (unitIncludes rts_pkg)
mk_include i = "#include \"" ++ i ++ "\"\n"
......
......@@ -5,6 +5,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
module GHC.Driver.Finder (
flushFinderCaches,
......@@ -76,7 +77,7 @@ flushFinderCaches hsc_env =
where
this_pkg = thisPackage (hsc_dflags hsc_env)
fc_ref = hsc_FC hsc_env
is_ext mod _ | not (installedModuleUnitId mod `installedUnitIdEq` this_pkg) = True
is_ext mod _ | not (moduleUnit mod `unitIdEq` this_pkg) = True
| otherwise = False
addToFinderCache :: IORef FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
......@@ -135,8 +136,8 @@ findPluginModule hsc_env mod_name =
findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findExactModule hsc_env mod =
let dflags = hsc_dflags hsc_env
in if installedModuleUnitId mod `installedUnitIdEq` thisPackage dflags
then findInstalledHomeModule hsc_env (installedModuleName mod)
in if moduleUnit mod `unitIdEq` thisPackage dflags
then findInstalledHomeModule hsc_env (moduleName mod)
else findPackageModule hsc_env mod
-- -----------------------------------------------------------------------------
......@@ -194,7 +195,7 @@ findExposedPluginPackageModule hsc_env mod_name
findLookupResult :: HscEnv -> LookupResult -> IO FindResult
findLookupResult hsc_env r = case r of
LookupFound m pkg_conf -> do
let im = fst (splitModuleInsts m)
let im = fst (getModuleInstantiation m)
r' <- findPackageModule_ hsc_env im pkg_conf
case r' of
-- TODO: ghc -M is unlikely to do the right thing
......@@ -202,8 +203,8 @@ findLookupResult hsc_env r = case r of
-- instantiated; you probably also need all of the
-- implicit locations from the instances
InstalledFound loc _ -> return (Found loc m)
InstalledNoPackage _ -> return (NoPackage (moduleUnitId m))
InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnitId m)
InstalledNoPackage _ -> return (NoPackage (moduleUnit m))
InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m)
, fr_pkgs_hidden = []
, fr_mods_hidden = []
, fr_unusables = []
......@@ -212,13 +213,13 @@ findLookupResult hsc_env r = case r of
return (FoundMultiple rs)
LookupHidden pkg_hiddens mod_hiddens ->
return (NotFound{ fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = map (moduleUnitId.fst) pkg_hiddens
, fr_mods_hidden = map (moduleUnitId.fst) mod_hiddens
, fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens
, fr_mods_hidden = map (moduleUnit.fst) mod_hiddens
, fr_unusables = []
, fr_suggestions = [] })
LookupUnusable unusable ->
let unusables' = map get_unusable unusable
get_unusable (m, ModUnusable r) = (moduleUnitId m, r)
get_unusable (m, ModUnusable r) = (moduleUnit m, r)
get_unusable (_, r) =
pprPanic "findLookupResult: unexpected origin" (ppr r)
in return (NotFound{ fr_paths = [], fr_pkg = Nothing
......@@ -245,8 +246,8 @@ modLocationCache hsc_env mod do_this = do
mkHomeInstalledModule :: DynFlags -> ModuleName -> InstalledModule
mkHomeInstalledModule dflags mod_name =
let iuid = thisInstalledUnitId dflags
in InstalledModule iuid mod_name
let iuid = thisUnitId dflags
in Module iuid mod_name
-- This returns a module because it's more convenient for users
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
......@@ -339,7 +340,7 @@ findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findPackageModule hsc_env mod = do
let
dflags = hsc_dflags hsc_env
pkg_id = installedModuleUnitId mod
pkg_id = moduleUnit mod
pkgstate = pkgState dflags
--
case lookupInstalledPackage pkgstate pkg_id of
......@@ -355,7 +356,7 @@ findPackageModule hsc_env mod = do
-- for the appropriate config.
findPackageModule_ :: HscEnv -> InstalledModule -> UnitInfo -> IO InstalledFindResult
findPackageModule_ hsc_env mod pkg_conf =
ASSERT2( installedModuleUnitId mod == installedUnitInfoId pkg_conf, ppr (installedModuleUnitId mod) <+> ppr (installedUnitInfoId pkg_conf) )
ASSERT2(