Commit 0497ee50 authored by niteria's avatar niteria

Make the Ord Module independent of Unique order

The `Ord Module` instance currently uses `Unique`s for comparison.
We don't want to use the `Unique` order because it can introduce nondeterminism.
This switches `Ord ModuleName` and `Ord UnitId` to use lexicographic ordering
making `Ord Module` deterministic transitively.

I've run `nofib` and it doesn't make a measurable difference.

See also Note [ModuleEnv determinism and performance].

Test Plan:
./validate
run nofib: P112

Reviewers: simonpj, simonmar, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2030

GHC Trac Issues: #4012
parent 586d5581
......@@ -87,6 +87,8 @@ import UniqDFM
import FastString
import Binary
import Util
import Data.List
import Data.Ord
import {-# SOURCE #-} Packages
import GHC.PackageDb (BinaryStringRep(..), DbModuleRep(..), DbModule(..))
......@@ -243,11 +245,8 @@ 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 = getUnique nm1 `compare` getUnique nm2
nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
instance Outputable ModuleName where
ppr = pprModuleName
......@@ -395,10 +394,8 @@ 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 = getUnique nm1 `compare` getUnique nm2
nm1 `compare` nm2 = stableUnitIdCmp nm1 nm2
instance Data UnitId where
-- don't traverse?
......@@ -515,65 +512,102 @@ wiredInUnitIds = [ primUnitId,
-}
-- | A map keyed off of 'Module's
newtype ModuleEnv elt = ModuleEnv (Map Module elt)
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)
filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
filterModuleEnv f (ModuleEnv e) =
ModuleEnv (Map.filterWithKey (f . unNDModule) e)
elemModuleEnv :: Module -> ModuleEnv a -> Bool
elemModuleEnv m (ModuleEnv e) = Map.member m e
elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (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)
extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
-> ModuleEnv a
extendModuleEnvWith f (ModuleEnv e) m x =
ModuleEnv (Map.insertWith f (NDModule m) x e)
extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
extendModuleEnvList (ModuleEnv e) xs =
ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
-> ModuleEnv a
extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
extendModuleEnvList_C f (ModuleEnv e) xs =
ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- 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 ms e)
delModuleEnvList (ModuleEnv e) ms =
ModuleEnv (Map.deleteList (map NDModule ms) e)
delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule 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 m e
lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
lookupWithDefaultModuleEnv (ModuleEnv e) x m =
Map.findWithDefault x (NDModule 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 xs)
mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
emptyModuleEnv :: ModuleEnv a
emptyModuleEnv = ModuleEnv Map.empty
moduleEnvKeys :: ModuleEnv a -> [Module]
moduleEnvKeys (ModuleEnv e) = Map.keys e
moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
-- See Note [ModuleEnv performance and determinism]
moduleEnvElts :: ModuleEnv a -> [a]
moduleEnvElts (ModuleEnv e) = Map.elems e
moduleEnvElts e = map snd $ moduleEnvToList e
-- See Note [ModuleEnv performance and determinism]
moduleEnvToList :: ModuleEnv a -> [(Module, a)]
moduleEnvToList (ModuleEnv e) = Map.toList e
moduleEnvToList (ModuleEnv e) =
sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
-- See Note [ModuleEnv performance and determinism]
unitModuleEnv :: Module -> a -> ModuleEnv a
unitModuleEnv m x = ModuleEnv (Map.singleton m x)
unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
isEmptyModuleEnv :: ModuleEnv a -> Bool
isEmptyModuleEnv (ModuleEnv e) = Map.null e
......
......@@ -4,6 +4,6 @@ test('sigof01',
['$MAKE -s --no-print-directory sigof01'])
test('sigof01m',
[ clean_cmd('rm -rf tmp_sigof01m'), normalise_slashes ],
[ expect_broken(12189), clean_cmd('rm -rf tmp_sigof01m'), normalise_slashes ],
run_command,
['$MAKE -s --no-print-directory sigof01m'])
[1 of 4] Compiling OverloadedRecFldsFail10_A ( OverloadedRecFldsFail10_A.hs, OverloadedRecFldsFail10_A.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 )
[2 of 4] Compiling OverloadedRecFldsFail10_B ( OverloadedRecFldsFail10_B.hs, OverloadedRecFldsFail10_B.o )
[3 of 4] Compiling OverloadedRecFldsFail10_C ( OverloadedRecFldsFail10_C.hs, OverloadedRecFldsFail10_C.o )
[4 of 4] Compiling Main ( overloadedrecfldsfail10.hs, overloadedrecfldsfail10.o )
overloadedrecfldsfail10.hs:6:20: error:
......
......@@ -13,7 +13,7 @@ T11071.hs:21:12: error:
T11071.hs:22:12: error:
Not in scope: ‘M'.foobar’
Neither ‘Data.IntMap’, ‘Data.Map’ nor ‘System.IO’ exports ‘foobar’.
Neither ‘System.IO’, ‘Data.IntMap’ nor ‘Data.Map’ exports ‘foobar’.
T11071.hs:23:12: error:
Not in scope: ‘Data.List.sort’
......
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.IntMap’ (T11071a.hs:4:1-21)
‘Data.List’ (T11071a.hs:3:1-24)
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)
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
[1 of 5] Compiling T6018Bfail ( T6018Bfail.hs, T6018Bfail.o )
[2 of 5] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o )
[3 of 5] Compiling T6018Cfail ( T6018Cfail.hs, T6018Cfail.o )
[2 of 5] Compiling T6018Cfail ( T6018Cfail.hs, T6018Cfail.o )
[3 of 5] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o )
[4 of 5] Compiling T6018Afail ( T6018Afail.hs, T6018Afail.o )
[5 of 5] Compiling T6018fail ( T6018fail.hs, T6018fail.o )
......
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: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)
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)
(deferred type error)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment