diff options
author | Sasha Bogicevic <sasa.bogicevic@pm.me> | 2021-04-27 17:47:11 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-06 02:31:31 -0400 |
commit | 418295eab741fd420c6f350141c332ef26f9f0a4 (patch) | |
tree | c0404c0de1a52713120a05ae0dd208732f6f5924 | |
parent | c4f4193a13f751380e4cedbc2688a339f69325c9 (diff) | |
download | haskell-418295eab741fd420c6f350141c332ef26f9f0a4.tar.gz |
19486 Nearly all uses of `uniqCompareFS` are dubious and lack a non-determinism justification
-rw-r--r-- | compiler/GHC/Cmm/CLabel.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Iface/Ext/Types.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/TyCl.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Unit/Types.hs | 2 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Lit.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/backpack/should_compile/bkp48.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/backpack/should_compile/bkp51.stderr | 6 |
7 files changed, 17 insertions, 10 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs index 02d3f60ad6..a0c16857cb 100644 --- a/compiler/GHC/Cmm/CLabel.hs +++ b/compiler/GHC/Cmm/CLabel.hs @@ -330,6 +330,8 @@ instance Ord CLabel where compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) = compare a1 a2 `thenCmp` compare b1 b2 `thenCmp` + -- This non-determinism is "safe" in the sense that it only affects object code, + -- which is currently not covered by GHC's determinism guarantees. See #12935. uniqCompareFS c1 c2 `thenCmp` compare d1 d2 compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2 @@ -342,7 +344,7 @@ instance Ord CLabel where compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2 compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) = compare a1 a2 `thenCmp` - uniqCompareFS b1 b2 + lexicalCompareFS b1 b2 compare (StringLitLabel u1) (StringLitLabel u2) = nonDetCmpUnique u1 u2 compare (CC_Label a1) (CC_Label a2) = diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs index 7a7fb4bb00..73a4012f23 100644 --- a/compiler/GHC/Iface/Ext/Types.hs +++ b/compiler/GHC/Iface/Ext/Types.hs @@ -305,7 +305,7 @@ data NodeAnnotation = NodeAnnotation instance Ord NodeAnnotation where compare (NodeAnnotation c0 t0) (NodeAnnotation c1 t1) - = mconcat [uniqCompareFS c0 c1, uniqCompareFS t0 t1] + = mconcat [lexicalCompareFS c0 c1, lexicalCompareFS t0 t1] instance Outputable NodeAnnotation where ppr (NodeAnnotation c t) = ppr (c,t) diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index b2b9f2c106..c645bac3b9 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -4244,6 +4244,11 @@ checkValidTyCon tc data_cons = tyConDataCons tc groups = equivClasses cmp_fld (concatMap get_fields data_cons) + -- This spot seems OK with non-determinism. cmp_fld is used only in equivClasses + -- which produces equivalence classes. + -- The order of these equivalence classes might conceivably (non-deterministically) + -- depend on the result of this comparison, but that just affects the order in which + -- fields are checked for compatibility. It will not affect the compiled binary. cmp_fld (f1,_) (f2,_) = flLabel f1 `uniqCompareFS` flLabel f2 get_fields con = dataConFieldLabels con `zip` repeat con -- dataConFieldLabels may return the empty list, which is fine diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs index 57dcddef6b..5dca26a90f 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 `uniqCompareFS` instUnitFS u2 + u1 `compare` u2 = instUnitFS u1 `lexicalCompareFS` instUnitFS u2 instance Binary InstantiatedUnit where put_ bh indef = do diff --git a/compiler/Language/Haskell/Syntax/Lit.hs b/compiler/Language/Haskell/Syntax/Lit.hs index a025edc4f6..1cdcfe8779 100644 --- a/compiler/Language/Haskell/Syntax/Lit.hs +++ b/compiler/Language/Haskell/Syntax/Lit.hs @@ -164,7 +164,7 @@ instance Ord OverLitVal where compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2 compare (HsFractional _) (HsIntegral _) = GT compare (HsFractional _) (HsIsString _ _) = LT - compare (HsIsString _ s1) (HsIsString _ s2) = s1 `uniqCompareFS` s2 + compare (HsIsString _ s1) (HsIsString _ s2) = s1 `lexicalCompareFS` s2 compare (HsIsString _ _) (HsIntegral _) = GT compare (HsIsString _ _) (HsFractional _) = GT diff --git a/testsuite/tests/backpack/should_compile/bkp48.stderr b/testsuite/tests/backpack/should_compile/bkp48.stderr index e1d0213493..a80bebbb0b 100644 --- a/testsuite/tests/backpack/should_compile/bkp48.stderr +++ b/testsuite/tests/backpack/should_compile/bkp48.stderr @@ -24,6 +24,6 @@ [3 of 3] Instantiating q [2 of 3] Including p[A=i:A] [3 of 3] Including q[A=i:A] - [1 of 3] Instantiating r - [2 of 3] Instantiating p - [3 of 3] Instantiating q + [1 of 3] Instantiating p + [2 of 3] Instantiating q + [3 of 3] Instantiating r diff --git a/testsuite/tests/backpack/should_compile/bkp51.stderr b/testsuite/tests/backpack/should_compile/bkp51.stderr index 9ce49d116b..0762b3c2c8 100644 --- a/testsuite/tests/backpack/should_compile/bkp51.stderr +++ b/testsuite/tests/backpack/should_compile/bkp51.stderr @@ -18,9 +18,9 @@ [3 of 3] Compiling E ( s/E.hs, nothing ) [5 of 6] Processing t [1 of 4] Compiling H[sig] ( t/H.hsig, nothing ) - [2 of 4] Instantiating s - [3 of 4] Instantiating r - [4 of 4] Compiling F ( t/F.hs, nothing ) + [2 of 4] Instantiating r + [3 of 4] Compiling F ( t/F.hs, nothing ) + [4 of 4] Instantiating s [6 of 6] Processing u [1 of 3] Compiling H[sig] ( u/H.hsig, nothing ) [2 of 3] Instantiating q |