diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-15 08:44:11 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-15 12:30:26 +0100 |
commit | 70a458938c36849f78c6efc65a088289ebc4e293 (patch) | |
tree | 3bd4061fabff48dd940958c8f718434d3b51a0de | |
parent | 753c5b24304fa1dd1af774be268794baef820f75 (diff) | |
download | haskell-70a458938c36849f78c6efc65a088289ebc4e293.tar.gz |
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.
-rw-r--r-- | compiler/basicTypes/Module.hs | 84 | ||||
-rw-r--r-- | testsuite/tests/driver/sigof01/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/rename/should_fail/T11071.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/rename/should_fail/T11071a.stderr | 32 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T6018fail.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_run/T7861.stderr | 22 |
7 files changed, 58 insertions, 92 deletions
diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index 132ce762cf..74b15bcd3a 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 61a012d264..077263a17f 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 9be384b500..9d8e8bd6c3 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 0e77fae7de..2feeadd040 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 853a79d3d7..9db69ae578 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 e5bf51cf09..3bd6b40a82 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 e9ee5e91a7..e0aac9a558 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) |