Remove "Ord FastString" instance

FastStrings can be compared in 2 ways: by Unique or lexically. We don't
want to bless one particular way with an "Ord" instance because it leads
to bugs (#18562) or to suboptimal code (e.g. using lexical comparison
while a Unique comparison would suffice).

UTF-8 encoding has the advantage that sorting strings by their encoded
bytes also sorts them by their Unicode code points, without having to
decode the actual code points. BUT GHC uses Modified UTF-8 which
diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid
null bytes in the middle of a String so that the string can still be
null-terminated). This patch adds a new `utf8CompareShortByteString`
function that performs sorting by bytes but that also takes Modified
UTF-8 into account. It is much more performant than decoding the strings
into [Char] to perform comparisons (which we did in the previous patch).

Bump haddock submodule

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