diff options
Diffstat (limited to 'compiler/GHC/Unit')
| -rw-r--r-- | compiler/GHC/Unit/Info.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/Unit/Module/Name.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Unit/State.hs | 13 | ||||
| -rw-r--r-- | compiler/GHC/Unit/Types.hs | 8 |
4 files changed, 14 insertions, 17 deletions
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs index 034b61e145..abb2122ef0 100644 --- a/compiler/GHC/Unit/Info.hs +++ b/compiler/GHC/Unit/Info.hs @@ -86,15 +86,11 @@ mapUnitInfo f = mapGenericUnitInfo id -- module name (fmap (mapGenUnit f)) -- instantiating modules --- TODO: there's no need for these to be FastString, as we don't need the uniq --- feature, but ghc doesn't currently have convenient support for any --- other compact string types, e.g. plain ByteString or Text. - -newtype PackageId = PackageId FastString deriving (Eq, Ord) +newtype PackageId = PackageId FastString deriving (Eq) newtype PackageName = PackageName { unPackageName :: FastString } - deriving (Eq, Ord) + deriving (Eq) instance Uniquable PackageId where getUnique (PackageId n) = getUnique n diff --git a/compiler/GHC/Unit/Module/Name.hs b/compiler/GHC/Unit/Module/Name.hs index ad09fa7549..76c40f6a87 100644 --- a/compiler/GHC/Unit/Module/Name.hs +++ b/compiler/GHC/Unit/Module/Name.hs @@ -59,7 +59,7 @@ instance NFData ModuleName where stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering -- ^ Compares module names lexically, rather than by their 'Unique's -stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2 +stableModuleNameCmp n1 n2 = moduleNameFS n1 `lexicalCompareFS` moduleNameFS n2 pprModuleName :: ModuleName -> SDoc pprModuleName (ModuleName nm) = diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index 6e3a53310c..c95c9e4031 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -415,7 +415,7 @@ data UnitState = UnitState { -- | A mapping of 'PackageName' to 'IndefUnitId'. This is used when -- users refer to packages in Backpack includes. - packageNameMap :: Map PackageName IndefUnitId, + packageNameMap :: UniqFM PackageName IndefUnitId, -- | A mapping from database unit keys to wired in unit ids. wireMap :: Map UnitId UnitId, @@ -460,7 +460,7 @@ emptyUnitState :: UnitState emptyUnitState = UnitState { unitInfoMap = Map.empty, preloadClosure = emptyUniqSet, - packageNameMap = Map.empty, + packageNameMap = emptyUFM, wireMap = Map.empty, unwireMap = Map.empty, preloadUnits = [], @@ -533,7 +533,7 @@ unsafeLookupUnitId state uid = case lookupUnitId state uid of -- | Find the unit we know about with the given package name (e.g. @foo@), if any -- (NB: there might be a locally defined unit name which overrides this) lookupPackageName :: UnitState -> PackageName -> Maybe IndefUnitId -lookupPackageName pkgstate n = Map.lookup n (packageNameMap pkgstate) +lookupPackageName pkgstate n = lookupUFM (packageNameMap pkgstate) n -- | Search for units with a given package ID (e.g. \"foo-0.1\") searchPackageId :: UnitState -> PackageId -> [UnitInfo] @@ -1587,10 +1587,9 @@ mkUnitState ctx printer cfg = do -- likely to actually happen. return (updateVisibilityMap wired_map plugin_vis_map2) - let pkgname_map = foldl' add Map.empty pkgs2 - where add pn_map p - = Map.insert (unitPackageName p) (unitInstanceOf p) pn_map - + let pkgname_map = listToUFM [ (unitPackageName p, unitInstanceOf p) + | p <- pkgs2 + ] -- The explicitUnits accurately reflects the set of units we have turned -- on; as such, it also is the only way one can come up with requirements. -- The requirement context is directly based off of this: we simply diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs index f80a3b5b9d..aa725b429c 100644 --- a/compiler/GHC/Unit/Types.hs +++ b/compiler/GHC/Unit/Types.hs @@ -290,7 +290,7 @@ instance Eq (GenInstantiatedUnit unit) where u1 == u2 = instUnitKey u1 == instUnitKey u2 instance Ord (GenInstantiatedUnit unit) where - u1 `compare` u2 = instUnitFS u1 `compare` instUnitFS u2 + u1 `compare` u2 = instUnitFS u1 `uniqCompareFS` instUnitFS u2 instance Binary InstantiatedUnit where put_ bh indef = do @@ -328,7 +328,7 @@ instance NFData Unit where -- | Compares unit ids lexically, rather than by their 'Unique's stableUnitCmp :: Unit -> Unit -> Ordering -stableUnitCmp p1 p2 = unitFS p1 `compare` unitFS p2 +stableUnitCmp p1 p2 = unitFS p1 `lexicalCompareFS` unitFS p2 instance Outputable Unit where ppr pk = pprUnit pk @@ -504,7 +504,9 @@ instance Eq UnitId where uid1 == uid2 = getUnique uid1 == getUnique uid2 instance Ord UnitId where - u1 `compare` u2 = unitIdFS u1 `compare` unitIdFS u2 + -- we compare lexically to avoid non-deterministic output when sets of + -- unit-ids are printed (dependencies, etc.) + u1 `compare` u2 = unitIdFS u1 `lexicalCompareFS` unitIdFS u2 instance Uniquable UnitId where getUnique = getUnique . unitIdFS |