Revert "Make the Ord Module independent of Unique order"

This reverts commit 0497ee504cc9ac5d6babee9b98bf779b3fc50b98.

Reason: See Trac #12191.  I'm reverting pending Bartosz's
investigation of what went wrong.

7 files changed, 58 insertions, 92 deletions

diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs
index 132ce76..74b15bc 100644
--- a/compiler/basicTypes/Module.hs
+++ b/compiler/basicTypes/Module.hs
@@ -87,8 +87,6 @@ import UniqDFM
 import FastString
 import Binary
 import Util
-import Data.List
-import Data.Ord
 import {-# SOURCE #-} Packages
 import GHC.PackageDb (BinaryStringRep(..), DbModuleRep(..), DbModule(..))
 
@@ -245,8 +243,11 @@ instance Uniquable ModuleName where
 instance Eq ModuleName where
   nm1 == nm2 = getUnique nm1 == getUnique nm2
 
+-- Warning: gives an ordering relation based on the uniques of the
+-- FastStrings which are the (encoded) module names.  This is _not_
+-- a lexicographical ordering.
 instance Ord ModuleName where
-  nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
+  nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 
 instance Outputable ModuleName where
   ppr = pprModuleName
@@ -394,8 +395,10 @@ newtype UnitId = PId FastString deriving Eq
 instance Uniquable UnitId where
  getUnique pid = getUnique (unitIdFS pid)
 
+-- Note: *not* a stable lexicographic ordering, a faster unique-based
+-- ordering.
 instance Ord UnitId where
-  nm1 `compare` nm2 = stableUnitIdCmp nm1 nm2
+  nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 
 instance Data UnitId where
   -- don't traverse?
@@ -512,102 +515,65 @@ wiredInUnitIds = [ primUnitId,
 -}
 
 -- | A map keyed off of 'Module's
-newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)
-{-
-Note [ModuleEnv performance and determinism]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-To prevent accidental reintroduction of nondeterminism the Ord instance
-for Module was changed to not depend on Unique ordering and to use the
-lexicographic order. This is potentially expensive, but when measured
-there was no difference in performance.
-
-To be on the safe side and not pessimize ModuleEnv uses nondeterministic
-ordering on Module and normalizes by doing the lexicographic sort when
-turning the env to a list.
-See Note [Unique Determinism] for more information about the source of
-nondeterminismand and Note [Deterministic UniqFM] for explanation of why
-it matters for maps.
--}
-
-newtype NDModule = NDModule { unNDModule :: Module }
-  deriving Eq
-  -- A wrapper for Module with faster nondeterministic Ord.
-  -- Don't export, See [ModuleEnv performance and determinism]
-
-instance Ord NDModule where
-  compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =
-    (getUnique p1 `compare` getUnique p2) `thenCmp`
-    (getUnique n1 `compare` getUnique n2)
+newtype ModuleEnv elt = ModuleEnv (Map Module elt)
 
 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
-filterModuleEnv f (ModuleEnv e) =
-  ModuleEnv (Map.filterWithKey (f . unNDModule) e)
+filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
 
 elemModuleEnv :: Module -> ModuleEnv a -> Bool
-elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
+elemModuleEnv m (ModuleEnv e) = Map.member m e
 
 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
-extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)
+extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
 
-extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
-                    -> ModuleEnv a
-extendModuleEnvWith f (ModuleEnv e) m x =
-  ModuleEnv (Map.insertWith f (NDModule m) x e)
+extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
 
 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
-extendModuleEnvList (ModuleEnv e) xs =
-  ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
+extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
 
 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
                       -> ModuleEnv a
-extendModuleEnvList_C f (ModuleEnv e) xs =
-  ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)
+extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
 
 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =
-  ModuleEnv (Map.unionWith f e1 e2)
+plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
 
 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
-delModuleEnvList (ModuleEnv e) ms =
-  ModuleEnv (Map.deleteList (map NDModule ms) e)
+delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
 
 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
-delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)
+delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
 
 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
 
 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
-lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
+lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
 
 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
-lookupWithDefaultModuleEnv (ModuleEnv e) x m =
-  Map.findWithDefault x (NDModule m) e
+lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
 
 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
 
 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
-mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
+mkModuleEnv xs = ModuleEnv (Map.fromList xs)
 
 emptyModuleEnv :: ModuleEnv a
 emptyModuleEnv = ModuleEnv Map.empty
 
 moduleEnvKeys :: ModuleEnv a -> [Module]
-moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
-  -- See Note [ModuleEnv performance and determinism]
+moduleEnvKeys (ModuleEnv e) = Map.keys e
 
 moduleEnvElts :: ModuleEnv a -> [a]
-moduleEnvElts e = map snd $ moduleEnvToList e
-  -- See Note [ModuleEnv performance and determinism]
+moduleEnvElts (ModuleEnv e) = Map.elems e
 
 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
-moduleEnvToList (ModuleEnv e) =
-  sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
-  -- See Note [ModuleEnv performance and determinism]
+moduleEnvToList (ModuleEnv e) = Map.toList e
 
 unitModuleEnv :: Module -> a -> ModuleEnv a
-unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
+unitModuleEnv m x = ModuleEnv (Map.singleton m x)
 
 isEmptyModuleEnv :: ModuleEnv a -> Bool
 isEmptyModuleEnv (ModuleEnv e) = Map.null e
diff --git a/testsuite/tests/driver/sigof01/all.T b/testsuite/tests/driver/sigof01/all.T
index 61a012d..077263a 100644
--- a/testsuite/tests/driver/sigof01/all.T
+++ b/testsuite/tests/driver/sigof01/all.T
@@ -4,6 +4,6 @@ test('sigof01',
      ['$MAKE -s --no-print-directory sigof01'])
 
 test('sigof01m',
-     [ expect_broken(12189), clean_cmd('rm -rf tmp_sigof01m'), normalise_slashes ],
+     [ clean_cmd('rm -rf tmp_sigof01m'), normalise_slashes ],
      run_command,
      ['$MAKE -s --no-print-directory sigof01m'])
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr
index 9be384b..9d8e8bd 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr
@@ -1,6 +1,6 @@
 [1 of 4] Compiling OverloadedRecFldsFail10_A ( OverloadedRecFldsFail10_A.hs, OverloadedRecFldsFail10_A.o )
-[2 of 4] Compiling OverloadedRecFldsFail10_B ( OverloadedRecFldsFail10_B.hs, OverloadedRecFldsFail10_B.o )
-[3 of 4] Compiling OverloadedRecFldsFail10_C ( OverloadedRecFldsFail10_C.hs, OverloadedRecFldsFail10_C.o )
+[2 of 4] Compiling OverloadedRecFldsFail10_C ( OverloadedRecFldsFail10_C.hs, OverloadedRecFldsFail10_C.o )
+[3 of 4] Compiling OverloadedRecFldsFail10_B ( OverloadedRecFldsFail10_B.hs, OverloadedRecFldsFail10_B.o )
 [4 of 4] Compiling Main             ( overloadedrecfldsfail10.hs, overloadedrecfldsfail10.o )
 
 overloadedrecfldsfail10.hs:6:20: error:
diff --git a/testsuite/tests/rename/should_fail/T11071.stderr b/testsuite/tests/rename/should_fail/T11071.stderr
index 0e77fae..2feeadd 100644
--- a/testsuite/tests/rename/should_fail/T11071.stderr
+++ b/testsuite/tests/rename/should_fail/T11071.stderr
@@ -13,7 +13,7 @@ T11071.hs:21:12: error:
 
 T11071.hs:22:12: error:
     Not in scope: ‘M'.foobar’
-    Neither ‘System.IO’, ‘Data.IntMap’ nor ‘Data.Map’ exports ‘foobar’.
+    Neither ‘Data.IntMap’, ‘Data.Map’ nor ‘System.IO’ exports ‘foobar’.
 
 T11071.hs:23:12: error:
     Not in scope: ‘Data.List.sort’
diff --git a/testsuite/tests/rename/should_fail/T11071a.stderr b/testsuite/tests/rename/should_fail/T11071a.stderr
index 853a79d..9db69ae 100644
--- a/testsuite/tests/rename/should_fail/T11071a.stderr
+++ b/testsuite/tests/rename/should_fail/T11071a.stderr
@@ -1,26 +1,26 @@
 
 T11071a.hs:12:12: error:
-    • Variable not in scope: intersperse
-    • Perhaps you want to add ‘intersperse’ to the import list
-      in the import of ‘Data.List’ (T11071a.hs:3:1-24).
+    Variable not in scope: intersperse
+    Perhaps you want to add ‘intersperse’ to the import list
+    in the import of ‘Data.List’ (T11071a.hs:3:1-24).
 
 T11071a.hs:13:12: error:
-    • Variable not in scope: foldl'
-    • Perhaps you meant one of these:
-        ‘foldl’ (imported from Prelude), ‘foldl1’ (imported from Prelude),
-        ‘foldr’ (imported from Prelude)
-      Perhaps you want to add ‘foldl'’ to one of these import lists:
-        ‘Data.List’ (T11071a.hs:3:1-24)
-        ‘Data.IntMap’ (T11071a.hs:4:1-21)
+    Variable not in scope: foldl'
+    Perhaps you meant one of these:
+      ‘foldl’ (imported from Prelude), ‘foldl1’ (imported from Prelude),
+      ‘foldr’ (imported from Prelude)
+    Perhaps you want to add ‘foldl'’ to one of these import lists:
+      ‘Data.IntMap’ (T11071a.hs:4:1-21)
+      ‘Data.List’ (T11071a.hs:3:1-24)
 
 T11071a.hs:14:12: error:
-    • Data constructor not in scope: Down
-    • Perhaps you want to remove ‘Down’ from the explicit hiding list
-      in the import of ‘Data.Ord’ (T11071a.hs:5:1-29).
+    Data constructor not in scope: Down
+    Perhaps you want to remove ‘Down’ from the explicit hiding list
+    in the import of ‘Data.Ord’ (T11071a.hs:5:1-29).
 
 T11071a.hs:15:12: error:
-    • Data constructor not in scope: True
-    • Perhaps you want to remove ‘True’ from the explicit hiding list
-      in the import of ‘Prelude’ (T11071a.hs:6:1-28).
+    Data constructor not in scope: True
+    Perhaps you want to remove ‘True’ from the explicit hiding list
+    in the import of ‘Prelude’ (T11071a.hs:6:1-28).
 
 T11071a.hs:16:12: error: Variable not in scope: foobar
diff --git a/testsuite/tests/typecheck/should_fail/T6018fail.stderr b/testsuite/tests/typecheck/should_fail/T6018fail.stderr
index e5bf51c..3bd6b40 100644
--- a/testsuite/tests/typecheck/should_fail/T6018fail.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6018fail.stderr
@@ -1,6 +1,6 @@
 [1 of 5] Compiling T6018Bfail       ( T6018Bfail.hs, T6018Bfail.o )
-[2 of 5] Compiling T6018Cfail       ( T6018Cfail.hs, T6018Cfail.o )
-[3 of 5] Compiling T6018Dfail       ( T6018Dfail.hs, T6018Dfail.o )
+[2 of 5] Compiling T6018Dfail       ( T6018Dfail.hs, T6018Dfail.o )
+[3 of 5] Compiling T6018Cfail       ( T6018Cfail.hs, T6018Cfail.o )
 [4 of 5] Compiling T6018Afail       ( T6018Afail.hs, T6018Afail.o )
 [5 of 5] Compiling T6018fail        ( T6018fail.hs, T6018fail.o )
 
diff --git a/testsuite/tests/typecheck/should_run/T7861.stderr b/testsuite/tests/typecheck/should_run/T7861.stderr
index e9ee5e9..e0aac9a 100644
--- a/testsuite/tests/typecheck/should_run/T7861.stderr
+++ b/testsuite/tests/typecheck/should_run/T7861.stderr
@@ -1,13 +1,13 @@
 T7861: T7861.hs:10:5: error:
-    • Couldn't match type ‘a’ with ‘[a]’
-      ‘a’ is a rigid type variable bound by
-        the type signature for:
-          f :: forall a. (forall b. a) -> a
-        at T7861.hs:9:1-23
-      Expected type: (forall b. a) -> a
-        Actual type: (forall b. a) -> [a]
-    • In the expression: doA
-      In an equation for ‘f’: f = doA
-    • Relevant bindings include
-        f :: (forall b. a) -> a (bound at T7861.hs:10:1)
+    Couldn't match type ‘a’ with ‘[a]’
+    ‘a’ is a rigid type variable bound by
+      the type signature for:
+        f :: forall a. (forall b. a) -> a
+      at T7861.hs:9:6
+    Expected type: (forall b. a) -> a
+      Actual type: (forall b. a) -> [a]
+    In the expression: doA
+    In an equation for ‘f’: f = doA
+    Relevant bindings include
+      f :: (forall b. a) -> a (bound at T7861.hs:10:1)
 (deferred type error)