summaryrefslogtreecommitdiff
path: root/compiler/GHC/Cmm
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-08-11 13:15:41 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-09-01 12:39:36 -0400
commit4b4fbc58d37d37457144014ef82bdd928de175df (patch)
tree9b49838986f07b5843e13f33ad2f6fd19d83f987 /compiler/GHC/Cmm
parent884245dd29265b7bee12cda8c915da9c916251ce (diff)
downloadhaskell-4b4fbc58d37d37457144014ef82bdd928de175df.tar.gz
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
Diffstat (limited to 'compiler/GHC/Cmm')
-rw-r--r--compiler/GHC/Cmm/CLabel.hs18
1 files changed, 8 insertions, 10 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 5f2eb565c5..2782da2ea4 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -311,19 +311,19 @@ instance Ord CLabel where
compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) =
compare a1 a2 `thenCmp`
compare b1 b2 `thenCmp`
- compare c1 c2 `thenCmp`
+ uniqCompareFS c1 c2 `thenCmp`
compare d1 d2
compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2
compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =
- compare a1 a2 `thenCmp`
+ uniqCompareFS a1 a2 `thenCmp`
compare b1 b2 `thenCmp`
compare c1 c2 `thenCmp`
compare d1 d2
compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2
compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =
compare a1 a2 `thenCmp`
- compare b1 b2
+ uniqCompareFS b1 b2
compare (StringLitLabel u1) (StringLitLabel u2) =
nonDetCmpUnique u1 u2
compare (CC_Label a1) (CC_Label a2) =
@@ -451,13 +451,11 @@ data RtsLabelInfo
| RtsApInfoTable Bool{-updatable-} Int{-arity-} -- ^ AP thunks
| RtsApEntry Bool{-updatable-} Int{-arity-}
- | RtsPrimOp PrimOp
- | RtsApFast FastString -- ^ _fast versions of generic apply
+ | RtsPrimOp PrimOp
+ | RtsApFast NonDetFastString -- ^ _fast versions of generic apply
| RtsSlowFastTickyCtr String
- deriving (Eq, Ord)
- -- NOTE: Eq on PtrString compares the pointer only, so this isn't
- -- a real equality.
+ deriving (Eq,Ord)
-- | What type of Cmm label we're dealing with.
@@ -708,7 +706,7 @@ mkCCLabel cc = CC_Label cc
mkCCSLabel ccs = CCS_Label ccs
mkRtsApFastLabel :: FastString -> CLabel
-mkRtsApFastLabel str = RtsLabel (RtsApFast str)
+mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str))
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
@@ -1308,7 +1306,7 @@ pprCLabel_common platform = \case
(LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u
- (RtsLabel (RtsApFast str)) -> ftext str <> text "_fast"
+ (RtsLabel (RtsApFast (NonDetFastString str))) -> ftext str <> text "_fast"
(RtsLabel (RtsSelectorInfoTable upd_reqd offset)) ->
hcat [text "stg_sel_", text (show offset),