Commit c2870d7e authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Make DefUnitId abstract, to avoid accidents.



Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent bd3040bd
......@@ -120,7 +120,7 @@ instance Text OpenUnitId where
-- | Get the 'ComponentId' of an 'OpenUnitId'.
openUnitIdComponentId :: OpenUnitId -> ComponentId
openUnitIdComponentId (IndefFullUnitId cid _) = cid
openUnitIdComponentId (DefiniteUnitId (DefUnitId uid)) = unitIdComponentId uid
openUnitIdComponentId (DefiniteUnitId def_uid) = unitIdComponentId (unDefUnitId def_uid)
-- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'.
openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName
......@@ -132,7 +132,7 @@ openUnitIdFreeHoles _ = Set.empty
mkOpenUnitId :: UnitId -> OpenModuleSubst -> OpenUnitId
mkOpenUnitId uid insts =
if Set.null (openModuleSubstFreeHoles insts)
then DefiniteUnitId (DefUnitId uid) -- invariant holds!
then DefiniteUnitId (unsafeMkDefUnitId uid) -- invariant holds!
else IndefFullUnitId (unitIdComponentId uid) insts
-----------------------------------------------------------------------
......@@ -141,7 +141,8 @@ mkOpenUnitId uid insts =
-- | Create a 'DefUnitId' from a 'ComponentId' and an instantiation
-- with no holes.
mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId
mkDefUnitId cid insts = DefUnitId (UnitId cid (hashModuleSubst insts)) -- impose invariant!
mkDefUnitId cid insts =
unsafeMkDefUnitId (UnitId cid (hashModuleSubst insts)) -- impose invariant!
-----------------------------------------------------------------------
-- OpenModule
......@@ -231,7 +232,7 @@ openModuleSubstFreeHoles insts = Set.unions (map openModuleFreeHoles (Map.elems
-- 'IndefFullUnitId' be compiled; instead, we just depend on the
-- installed indefinite unit installed at the 'ComponentId'.
abstractUnitId :: OpenUnitId -> UnitId
abstractUnitId (DefiniteUnitId (DefUnitId uid)) = uid
abstractUnitId (DefiniteUnitId def_uid) = unDefUnitId def_uid
abstractUnitId (IndefFullUnitId cid _) = newSimpleUnitId cid
-- | Take a module substitution and hash it into a string suitable for
......
......@@ -25,7 +25,9 @@ module Distribution.Package (
-- * Package keys/installed package IDs (used for linker symbols)
ComponentId, unComponentId, mkComponentId,
UnitId(..),
DefUnitId(..),
DefUnitId,
unsafeMkDefUnitId,
unDefUnitId,
mkUnitId,
newSimpleUnitId,
mkLegacyUnitId,
......@@ -275,6 +277,11 @@ instance Text UnitId where
newtype DefUnitId = DefUnitId { unDefUnitId :: UnitId }
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, Binary, NFData, Text)
-- | Unsafely create a 'DefUnitId' from a 'UnitId'. Your responsibility
-- is to ensure that the 'DefUnitId' invariant holds.
unsafeMkDefUnitId :: UnitId -> DefUnitId
unsafeMkDefUnitId = DefUnitId
-- | Create a unit identity with no associated hash directly
-- from a 'ComponentId'.
newSimpleUnitId :: ComponentId -> UnitId
......
......@@ -477,7 +477,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- Assert DefUnitId invariant!
-- Executable can't be indefinite, so dependencies must
-- be definite packages.
componentIncludes = zip (map (DefiniteUnitId . DefUnitId . fst) deps)
componentIncludes = zip (map (DefiniteUnitId . unsafeMkDefUnitId . fst) deps)
(repeat defaultRenaming)
}
testSuiteLibV09AsLibAndExe _ TestSuite{} _ _ _ _ = error "testSuiteLibV09AsLibAndExe: wrong kind"
......
......@@ -1134,11 +1134,12 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
let -- Use of invariant: DefUnitId indicates that if
-- there is no hash, it must have an empty
-- instnatiation.
lookup_uid (DefUnitId (UnitId sub_cid Nothing))
= FullUnitId sub_cid Map.empty
-- TODO: This case CAN happen if we have pre-existing
-- instantiated things. Fix eventually.
lookup_uid uid = error ("lookup_uid: " ++ display uid)
lookup_uid def_uid =
case unDefUnitId def_uid of
UnitId sub_cid Nothing -> FullUnitId sub_cid Map.empty
-- TODO: This case CAN happen if we have pre-existing
-- instantiated things. Fix eventually.
uid -> error ("lookup_uid: " ++ display uid)
lc <- toLinkedComponent verbosity lookup_uid (elabPkgSourceId elab0)
(Map.union external_lc_map lc_map) cc
let lc_map' = extendLinkedComponentMap lc lc_map
......
......@@ -32,7 +32,7 @@ import Distribution.Version
, withinRange )
import qualified Distribution.Backpack as Backpack
import Distribution.Package
( newSimpleUnitId, DefUnitId(..), ComponentId, PackageId, mkPackageName
( newSimpleUnitId, unsafeMkDefUnitId, ComponentId, PackageId, mkPackageName
, PackageIdentifier(..), packageVersion, packageName, Dependency(..) )
import Distribution.PackageDescription
( GenericPackageDescription(packageDescription)
......@@ -820,7 +820,7 @@ getExternalSetupMethod verbosity options pkg bt = do
else cabalDep
addRenaming (ipid, _) =
-- Assert 'DefUnitId' invariant
(Backpack.DefiniteUnitId (DefUnitId (newSimpleUnitId ipid)), defaultRenaming)
(Backpack.DefiniteUnitId (unsafeMkDefUnitId (newSimpleUnitId ipid)), defaultRenaming)
cppMacrosFile = setupDir </> "setup_macros.h"
ghcOptions = mempty {
-- Respect -v0, but don't crank up verbosity on GHC if
......
Supports Markdown
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