[Git][ghc/ghc][wip/andreask/typedUniqFM] Make UniqFM typed on it's key
Andreas Klebinger
gitlab at gitlab.haskell.org
Tue Jun 23 13:07:29 UTC 2020
Andreas Klebinger pushed to branch wip/andreask/typedUniqFM at Glasgow Haskell Compiler / GHC
Commits:
41b03224 by Andreas Klebinger at 2020-06-23T15:07:12+02:00
Make UniqFM typed on it's key
- - - - -
21 changed files:
- compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
- compiler/GHC/Data/FastString/Env.hs
- compiler/GHC/Data/Graph/Base.hs
- compiler/GHC/Data/Graph/Color.hs
- compiler/GHC/Data/Graph/Directed.hs
- compiler/GHC/Data/Graph/Ops.hs
- compiler/GHC/Data/TrieMap.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/Name.hs-boot
- compiler/GHC/Types/Name/Env.hs
- compiler/GHC/Types/Name/Occurrence.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/DSet.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Unique/Set.hs
- compiler/GHC/Types/Var/Env.hs
- compiler/GHC/Types/Var/Set.hs
- compiler/GHC/Unit/Module/Env.hs
- compiler/GHC/Utils/Binary.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
=====================================
@@ -35,7 +35,7 @@ data StackMap
stackMapNextFreeSlot :: !Int
-- | Assignment of vregs to stack slots.
- , stackMapAssignment :: UniqFM StackSlot }
+ , stackMapAssignment :: UniqFM Unique StackSlot }
-- | An empty stack map, with all slots available.
=====================================
compiler/GHC/Data/FastString/Env.hs
=====================================
@@ -40,7 +40,7 @@ import GHC.Data.FastString
-- deterministic and why it matters. Use DFastStringEnv if the set eventually
-- gets converted into a list or folded over in a way where the order
-- changes the generated code.
-type FastStringEnv a = UniqFM a -- Domain is FastString
+type FastStringEnv a = UniqFM FastString a -- Domain is FastString
emptyFsEnv :: FastStringEnv a
mkFsEnv :: [(FastString,a)] -> FastStringEnv a
@@ -85,7 +85,7 @@ lookupFsEnv_NF env n = expectJust "lookupFsEnv_NF" (lookupFsEnv env n)
-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why we need
-- DFastStringEnv.
-type DFastStringEnv a = UniqDFM a -- Domain is FastString
+type DFastStringEnv a = UniqDFM FastString a -- Domain is FastString
emptyDFsEnv :: DFastStringEnv a
emptyDFsEnv = emptyUDFM
=====================================
compiler/GHC/Data/Graph/Base.hs
=====================================
@@ -45,7 +45,7 @@ type Triv k cls color
data Graph k cls color
= Graph {
-- | All active nodes in the graph.
- graphMap :: UniqFM (Node k cls color) }
+ graphMap :: UniqFM k (Node k cls color) }
-- | An empty graph.
@@ -57,7 +57,7 @@ initGraph
-- | Modify the finite map holding the nodes in the graph.
graphMapModify
- :: (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
+ :: (UniqFM k (Node k cls color) -> UniqFM k (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify f graph
=====================================
compiler/GHC/Data/Graph/Color.hs
=====================================
@@ -4,6 +4,7 @@
--
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module GHC.Data.Graph.Color (
module GHC.Data.Graph.Base,
@@ -37,19 +38,20 @@ import Data.List
-- the stack (ie in reverse order) and assigning them colors different to their neighbors.
--
colorGraph
- :: ( Uniquable k, Uniquable cls, Uniquable color
+ :: forall k cls color.
+ ( Uniquable k, Uniquable cls, Uniquable color
, Eq cls, Ord k
, Outputable k, Outputable cls, Outputable color)
=> Bool -- ^ whether to do iterative coalescing
-> Int -- ^ how many times we've tried to color this graph so far.
- -> UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
+ -> UniqFM cls (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
-> Triv k cls color -- ^ fn to decide whether a node is trivially colorable.
-> (Graph k cls color -> k) -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
-> Graph k cls color -- ^ the graph to color.
-> ( Graph k cls color -- the colored graph.
, UniqSet k -- the set of nodes that we couldn't find a color for.
- , UniqFM k ) -- map of regs (r1 -> r2) that were coalesced
+ , UniqFM k k ) -- map of regs (r1 -> r2) that were coalesced
-- r1 should be replaced by r2 in the source
colorGraph iterative spinCount colors triv spill graph0
@@ -71,7 +73,7 @@ colorGraph iterative spinCount colors triv spill graph0
-- run the scanner to slurp out all the trivially colorable nodes
-- (and do coalescing if iterative coalescing is enabled)
- (ksTriv, ksProblems, kksCoalesce2)
+ (ksTriv, ksProblems, kksCoalesce2 :: [(k,k)])
= colorScan iterative triv spill graph_coalesced
-- If iterative coalescing is enabled, the scanner will coalesce the graph as does its business.
@@ -111,8 +113,8 @@ colorGraph iterative spinCount colors triv spill graph0
else ( graph_prob
, mkUniqSet ksNoColor -- the nodes that didn't color (spills)
, if iterative
- then (listToUFM kksCoalesce2)
- else (listToUFM kksCoalesce1))
+ then (listToUFM $ kksCoalesce2)
+ else (listToUFM $ kksCoalesce1))
-- | Scan through the conflict graph separating out trivially colorable and
@@ -253,9 +255,10 @@ colorScan_spill iterative triv spill graph
-- | Try to assign a color to all these nodes.
assignColors
- :: ( Uniquable k, Uniquable cls, Uniquable color
+ :: forall k cls color.
+ ( Uniquable k, Uniquable cls, Uniquable color
, Outputable cls)
- => UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
+ => UniqFM cls (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
-> Graph k cls color -- ^ the graph
-> [k] -- ^ nodes to assign a color to.
-> ( Graph k cls color -- the colored graph
@@ -264,7 +267,13 @@ assignColors
assignColors colors graph ks
= assignColors' colors graph [] ks
- where assignColors' _ graph prob []
+ where assignColors' :: UniqFM cls (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
+ -> Graph k cls color -- ^ the graph
+ -> [k] -- ^ nodes to assign a color to.
+ -> [k] -- ^ Assigned nodes?
+ -> ( Graph k cls color -- the colored graph
+ , [k])
+ assignColors' _ graph prob []
= (graph, prob)
assignColors' colors graph prob (k:ks)
@@ -293,7 +302,7 @@ assignColors colors graph ks
selectColor
:: ( Uniquable k, Uniquable cls, Uniquable color
, Outputable cls)
- => UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
+ => UniqFM cls (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
-> Graph k cls color -- ^ the graph
-> k -- ^ key of the node to select a color for.
-> Maybe color
=====================================
compiler/GHC/Data/Graph/Directed.hs
=====================================
@@ -507,8 +507,8 @@ classifyEdges root getSucc edges =
endFrom = getTime ends from
endTo = getTime ends to
- addTimes :: (Time, UniqFM Time, UniqFM Time) -> key
- -> (Time, UniqFM Time, UniqFM Time)
+ addTimes :: (Time, UniqFM key Time, UniqFM key Time) -> key
+ -> (Time, UniqFM key Time, UniqFM key Time)
addTimes (time,starts,ends) n
--Dont reenter nodes
| elemUFM n starts
=====================================
compiler/GHC/Data/Graph/Ops.hs
=====================================
@@ -218,8 +218,8 @@ addConflicts conflicts getClass
addConflictSet1 :: Uniquable k
=> k -> (k -> cls) -> UniqSet k
- -> UniqFM (Node k cls color)
- -> UniqFM (Node k cls color)
+ -> UniqFM k (Node k cls color)
+ -> UniqFM k (Node k cls color)
addConflictSet1 u getClass set
= case delOneFromUniqSet set u of
set' -> adjustWithDefaultUFM
@@ -645,15 +645,15 @@ checkNode graph node
slurpNodeConflictCount
:: Graph k cls color
- -> UniqFM (Int, Int) -- ^ (conflict neighbours, num nodes with that many conflicts)
+ -> UniqFM k (Int, Int) -- ^ (conflict neighbours, num nodes with that many conflicts)
slurpNodeConflictCount graph
- = addListToUFM_C
+ = addListToUFM_C_Directly
(\(c1, n1) (_, n2) -> (c1, n1 + n2))
emptyUFM
$ map (\node
-> let count = sizeUniqSet $ nodeConflicts node
- in (count, (count, 1)))
+ in (getUnique count, (count, 1)))
$ nonDetEltsUFM
-- See Note [Unique Determinism and code generation]
$ graphMap graph
@@ -676,7 +676,7 @@ setColor u color
adjustWithDefaultUFM
:: Uniquable k
=> (a -> a) -> a -> k
- -> UniqFM a -> UniqFM a
+ -> UniqFM k a -> UniqFM k a
adjustWithDefaultUFM f def k map
= addToUFM_C
@@ -689,7 +689,7 @@ adjustWithDefaultUFM f def k map
adjustUFM_C
:: Uniquable k
=> (a -> a)
- -> k -> UniqFM a -> UniqFM a
+ -> k -> UniqFM k a -> UniqFM k a
adjustUFM_C f k map
= case lookupUFM map k of
=====================================
compiler/GHC/Data/TrieMap.hs
=====================================
@@ -202,8 +202,8 @@ See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details on how
deterministic.
-}
-instance TrieMap UniqDFM where
- type Key UniqDFM = Unique
+instance TrieMap (UniqDFM Unique) where
+ type Key (UniqDFM Unique) = Unique
emptyTM = emptyUDFM
lookupTM k m = lookupUDFM m k
alterTM k f m = alterUDFM f m k
=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -262,7 +262,7 @@ putWithUserData log_action bh payload = do
-- Write the dictionary itself
dict_next <- readFastMutInt dict_next_ref
dict_map <- readIORef dict_map_ref
- putDictionary bh dict_next dict_map
+ putDictionary bh dict_next dict_map :: _
log_action (text "writeBinIface:" <+> int dict_next
<+> text "dict entries")
=====================================
compiler/GHC/Runtime/Interpreter/Types.hs
=====================================
@@ -53,7 +53,7 @@ data IServConfig = IServConfig
data IServInstance = IServInstance
{ iservPipe :: !Pipe
, iservProcess :: !ProcessHandle
- , iservLookupSymbolCache :: !(UniqFM (Ptr ()))
+ , iservLookupSymbolCache :: !(UniqFM Int (Ptr ()))
, iservPendingFrees :: ![HValueRef]
-- ^ Values that need to be freed before the next command is sent.
-- Threads can append values to this list asynchronously (by modifying the
=====================================
compiler/GHC/Types/Literal.hs
=====================================
@@ -63,6 +63,7 @@ import GHC.Types.Basic
import GHC.Utils.Binary
import GHC.Settings.Constants
import GHC.Platform
+import GHC.Types.Name
import GHC.Types.Unique.FM
import GHC.Utils.Misc
@@ -643,9 +644,11 @@ absentLiteralOf :: TyCon -> Maybe Literal
-- Rubbish literals are handled in GHC.Core.Opt.WorkWrap.Utils, because
-- 1. Looking at the TyCon is not enough, we need the actual type
-- 2. This would need to return a type application to a literal
-absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
+absentLiteralOf tc = lookupUFM absent_lits (getUnique $ tyConName tc)
-absent_lits :: UniqFM Literal
+-- TODO: This should be a map from TyCon -> Literal. But I don't want
+-- to make semantic changes while I refactor UniqFM
+absent_lits :: UniqFM Unique Literal
absent_lits = listToUFM [ (addrPrimTyConKey, LitNullAddr)
, (charPrimTyConKey, LitChar 'x')
, (intPrimTyConKey, mkLitIntUnchecked 0)
=====================================
compiler/GHC/Types/Name.hs-boot
=====================================
@@ -3,3 +3,4 @@ module GHC.Types.Name where
import GHC.Prelude ()
data Name
+data ModuleName
=====================================
compiler/GHC/Types/Name/Env.hs
=====================================
@@ -93,7 +93,7 @@ depAnal get_defs get_uses nodes
-}
-- | Name Environment
-type NameEnv a = UniqFM a -- Domain is Name
+type NameEnv a = UniqFM Name a -- Domain is Name
emptyNameEnv :: NameEnv a
isEmptyNameEnv :: NameEnv a -> Bool
@@ -152,7 +152,7 @@ lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
--
-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why
-- we need DNameEnv.
-type DNameEnv a = UniqDFM a
+type DNameEnv a = UniqDFM Name a
emptyDNameEnv :: DNameEnv a
emptyDNameEnv = emptyUDFM
=====================================
compiler/GHC/Types/Name/Occurrence.hs
=====================================
@@ -387,7 +387,7 @@ instance Uniquable OccName where
getUnique (OccName TvName fs) = mkTvOccUnique fs
getUnique (OccName TcClsName fs) = mkTcOccUnique fs
-newtype OccEnv a = A (UniqFM a)
+newtype OccEnv a = A (UniqFM OccName a)
deriving Data
emptyOccEnv :: OccEnv a
@@ -829,7 +829,7 @@ This is #12382.
-}
-type TidyOccEnv = UniqFM Int -- The in-scope OccNames
+type TidyOccEnv = UniqFM FastString Int -- The in-scope OccNames
-- See Note [TidyOccEnv]
emptyTidyOccEnv :: TidyOccEnv
=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -128,7 +128,7 @@ instance Eq val => Eq (TaggedVal val) where
(TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2
-- | Type of unique deterministic finite maps
-data UniqDFM ele =
+data UniqDFM key ele =
UDFM
!(M.IntMap (TaggedVal ele)) -- A map where keys are Unique's values and
-- values are tagged with insertion time.
@@ -139,27 +139,27 @@ data UniqDFM ele =
deriving (Data, Functor)
-- | Deterministic, in O(n log n).
-instance Foldable UniqDFM where
+instance Foldable (UniqDFM key) where
foldr = foldUDFM
-- | Deterministic, in O(n log n).
-instance Traversable UniqDFM where
+instance Traversable (UniqDFM key) where
traverse f = fmap listToUDFM_Directly
. traverse (\(u,a) -> (u,) <$> f a)
. udfmToList
-emptyUDFM :: UniqDFM elt
+emptyUDFM :: UniqDFM key elt
emptyUDFM = UDFM M.empty 0
-unitUDFM :: Uniquable key => key -> elt -> UniqDFM elt
+unitUDFM :: Uniquable key => key -> elt -> UniqDFM key elt
unitUDFM k v = UDFM (M.singleton (getKey $ getUnique k) (TaggedVal v 0)) 1
-- The new binding always goes to the right of existing ones
-addToUDFM :: Uniquable key => UniqDFM elt -> key -> elt -> UniqDFM elt
+addToUDFM :: Uniquable key => UniqDFM key elt -> key -> elt -> UniqDFM key elt
addToUDFM m k v = addToUDFM_Directly m (getUnique k) v
-- The new binding always goes to the right of existing ones
-addToUDFM_Directly :: UniqDFM elt -> Unique -> elt -> UniqDFM elt
+addToUDFM_Directly :: UniqDFM key elt -> Unique -> elt -> UniqDFM key elt
addToUDFM_Directly (UDFM m i) u v
= UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)
where
@@ -170,9 +170,9 @@ addToUDFM_Directly (UDFM m i) u v
addToUDFM_Directly_C
:: (elt -> elt -> elt) -- old -> new -> result
- -> UniqDFM elt
+ -> UniqDFM key elt
-> Unique -> elt
- -> UniqDFM elt
+ -> UniqDFM key elt
addToUDFM_Directly_C f (UDFM m i) u v
= UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)
where
@@ -184,25 +184,25 @@ addToUDFM_Directly_C f (UDFM m i) u v
addToUDFM_C
:: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
- -> UniqDFM elt -- old
+ -> UniqDFM key elt -- old
-> key -> elt -- new
- -> UniqDFM elt -- result
+ -> UniqDFM key elt -- result
addToUDFM_C f m k v = addToUDFM_Directly_C f m (getUnique k) v
-addListToUDFM :: Uniquable key => UniqDFM elt -> [(key,elt)] -> UniqDFM elt
+addListToUDFM :: Uniquable key => UniqDFM key elt -> [(key,elt)] -> UniqDFM key elt
addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v)
-addListToUDFM_Directly :: UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt
+addListToUDFM_Directly :: UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt
addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v)
addListToUDFM_Directly_C
- :: (elt -> elt -> elt) -> UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt
+ :: (elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt
addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_Directly_C f m k v)
-delFromUDFM :: Uniquable key => UniqDFM elt -> key -> UniqDFM elt
+delFromUDFM :: Uniquable key => UniqDFM key elt -> key -> UniqDFM key elt
delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i
-plusUDFM_C :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+plusUDFM_C :: (elt -> elt -> elt) -> UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
plusUDFM_C f udfml@(UDFM _ i) udfmr@(UDFM _ j)
-- we will use the upper bound on the tag as a proxy for the set size,
-- to insert the smaller one into the bigger one
@@ -242,124 +242,124 @@ plusUDFM_C f udfml@(UDFM _ i) udfmr@(UDFM _ j)
-- insertion order and O(m * min(n+m, W)) to insert them into the bigger
-- set.
-plusUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+plusUDFM :: UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
plusUDFM udfml@(UDFM _ i) udfmr@(UDFM _ j)
-- we will use the upper bound on the tag as a proxy for the set size,
-- to insert the smaller one into the bigger one
| i > j = insertUDFMIntoLeft udfml udfmr
| otherwise = insertUDFMIntoLeft udfmr udfml
-insertUDFMIntoLeft :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+insertUDFMIntoLeft :: UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
insertUDFMIntoLeft udfml udfmr = addListToUDFM_Directly udfml $ udfmToList udfmr
insertUDFMIntoLeft_C
- :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+ :: (elt -> elt -> elt) -> UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
insertUDFMIntoLeft_C f udfml udfmr =
addListToUDFM_Directly_C f udfml $ udfmToList udfmr
-lookupUDFM :: Uniquable key => UniqDFM elt -> key -> Maybe elt
+lookupUDFM :: Uniquable key => UniqDFM key elt -> key -> Maybe elt
lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m
-lookupUDFM_Directly :: UniqDFM elt -> Unique -> Maybe elt
+lookupUDFM_Directly :: UniqDFM key elt -> Unique -> Maybe elt
lookupUDFM_Directly (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey k) m
-elemUDFM :: Uniquable key => key -> UniqDFM elt -> Bool
+elemUDFM :: Uniquable key => key -> UniqDFM key elt -> Bool
elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m
-- | Performs a deterministic fold over the UniqDFM.
-- It's O(n log n) while the corresponding function on `UniqFM` is O(n).
-foldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
+foldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a
foldUDFM k z m = foldr k z (eltsUDFM m)
-- | Performs a nondeterministic strict fold over the UniqDFM.
-- It's O(n), same as the corresponding function on `UniqFM`.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetStrictFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
+nonDetStrictFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a
nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m
where
k' acc (TaggedVal v _) = k v acc
-eltsUDFM :: UniqDFM elt -> [elt]
+eltsUDFM :: UniqDFM key elt -> [elt]
eltsUDFM (UDFM m _i) =
map taggedFst $ sortBy (compare `on` taggedSnd) $ M.elems m
-filterUDFM :: (elt -> Bool) -> UniqDFM elt -> UniqDFM elt
+filterUDFM :: (elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i
-filterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM elt -> UniqDFM elt
+filterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
filterUDFM_Directly p (UDFM m i) = UDFM (M.filterWithKey p' m) i
where
p' k (TaggedVal v _) = p (getUnique k) v
-- | Converts `UniqDFM` to a list, with elements in deterministic order.
-- It's O(n log n) while the corresponding function on `UniqFM` is O(n).
-udfmToList :: UniqDFM elt -> [(Unique, elt)]
+udfmToList :: UniqDFM key elt -> [(Unique, elt)]
udfmToList (UDFM m _i) =
[ (getUnique k, taggedFst v)
| (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ]
-- Determines whether two 'UniqDFM's contain the same keys.
-equalKeysUDFM :: UniqDFM a -> UniqDFM b -> Bool
+equalKeysUDFM :: UniqDFM key a -> UniqDFM key b -> Bool
equalKeysUDFM (UDFM m1 _) (UDFM m2 _) = liftEq (\_ _ -> True) m1 m2
-isNullUDFM :: UniqDFM elt -> Bool
+isNullUDFM :: UniqDFM key elt -> Bool
isNullUDFM (UDFM m _) = M.null m
-sizeUDFM :: UniqDFM elt -> Int
+sizeUDFM :: UniqDFM key elt -> Int
sizeUDFM (UDFM m _i) = M.size m
-intersectUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+intersectUDFM :: UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
intersectUDFM (UDFM x i) (UDFM y _j) = UDFM (M.intersection x y) i
-- M.intersection is left biased, that means the result will only have
-- a subset of elements from the left set, so `i` is a good upper bound.
-udfmIntersectUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1
+udfmIntersectUFM :: UniqDFM key elt1 -> UniqFM key elt2 -> UniqDFM key elt1
udfmIntersectUFM (UDFM x i) y = UDFM (M.intersection x (ufmToIntMap y)) i
-- M.intersection is left biased, that means the result will only have
-- a subset of elements from the left set, so `i` is a good upper bound.
-disjointUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
+disjointUDFM :: UniqDFM key elt -> UniqDFM key elt -> Bool
disjointUDFM (UDFM x _i) (UDFM y _j) = M.disjoint x y
-disjointUdfmUfm :: UniqDFM elt -> UniqFM elt2 -> Bool
+disjointUdfmUfm :: UniqDFM key elt -> UniqFM key elt2 -> Bool
disjointUdfmUfm (UDFM x _i) y = M.disjoint x (ufmToIntMap y)
-minusUDFM :: UniqDFM elt1 -> UniqDFM elt2 -> UniqDFM elt1
+minusUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> UniqDFM key elt1
minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i
-- M.difference returns a subset of a left set, so `i` is a good upper
-- bound.
-udfmMinusUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1
+udfmMinusUFM :: UniqDFM key elt1 -> UniqFM key elt2 -> UniqDFM key elt1
udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i
-- M.difference returns a subset of a left set, so `i` is a good upper
-- bound.
-ufmMinusUDFM :: UniqFM elt1 -> UniqDFM elt2 -> UniqFM elt1
+ufmMinusUDFM :: UniqFM key elt1 -> UniqDFM key elt2 -> UniqFM key elt1
ufmMinusUDFM x (UDFM y _i) = unsafeIntMapToUFM (M.difference (ufmToIntMap x) y)
-- | Partition UniqDFM into two UniqDFMs according to the predicate
-partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)
+partitionUDFM :: (elt -> Bool) -> UniqDFM key elt -> (UniqDFM key elt, UniqDFM key elt)
partitionUDFM p (UDFM m i) =
case M.partition (p . taggedFst) m of
(left, right) -> (UDFM left i, UDFM right i)
-- | Delete a list of elements from a UniqDFM
-delListFromUDFM :: Uniquable key => UniqDFM elt -> [key] -> UniqDFM elt
+delListFromUDFM :: Uniquable key => UniqDFM key elt -> [key] -> UniqDFM key elt
delListFromUDFM = foldl' delFromUDFM
-- | This allows for lossy conversion from UniqDFM to UniqFM
-udfmToUfm :: UniqDFM elt -> UniqFM elt
+udfmToUfm :: UniqDFM key elt -> UniqFM key elt
udfmToUfm (UDFM m _i) = unsafeIntMapToUFM (M.map taggedFst m)
-listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt
+listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM key elt
listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM
-listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt
+listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM key elt
listToUDFM_Directly = foldl' (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM
-- | Apply a function to a particular element
-adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt
+adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM key elt -> key -> UniqDFM key elt
adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i
-- | The expression (alterUDFM f k map) alters value x at k, or absence
@@ -369,9 +369,9 @@ adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i
alterUDFM
:: Uniquable key
=> (Maybe elt -> Maybe elt) -- How to adjust
- -> UniqDFM elt -- old
+ -> UniqDFM key elt -- old
-> key -- new
- -> UniqDFM elt -- result
+ -> UniqDFM key elt -- result
alterUDFM f (UDFM m i) k =
UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1)
where
@@ -381,39 +381,39 @@ alterUDFM f (UDFM m i) k =
inject (Just v) = Just $ TaggedVal v i
-- | Map a function over every value in a UniqDFM
-mapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2
+mapUDFM :: (elt1 -> elt2) -> UniqDFM key elt1 -> UniqDFM key elt2
mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i
-anyUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool
+anyUDFM :: (elt -> Bool) -> UniqDFM key elt -> Bool
anyUDFM p (UDFM m _i) = M.foldr ((||) . p . taggedFst) False m
-allUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool
+allUDFM :: (elt -> Bool) -> UniqDFM key elt -> Bool
allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m
-instance Semi.Semigroup (UniqDFM a) where
+instance Semi.Semigroup (UniqDFM key a) where
(<>) = plusUDFM
-instance Monoid (UniqDFM a) where
+instance Monoid (UniqDFM key a) where
mempty = emptyUDFM
mappend = (Semi.<>)
-- This should not be used in committed code, provided for convenience to
-- make ad-hoc conversions when developing
-alwaysUnsafeUfmToUdfm :: UniqFM elt -> UniqDFM elt
+alwaysUnsafeUfmToUdfm :: UniqFM key elt -> UniqDFM key elt
alwaysUnsafeUfmToUdfm = listToUDFM_Directly . nonDetUFMToList
-- Output-ery
-instance Outputable a => Outputable (UniqDFM a) where
+instance Outputable a => Outputable (UniqDFM key a) where
ppr ufm = pprUniqDFM ppr ufm
-pprUniqDFM :: (a -> SDoc) -> UniqDFM a -> SDoc
+pprUniqDFM :: (a -> SDoc) -> UniqDFM key a -> SDoc
pprUniqDFM ppr_elt ufm
= brackets $ fsep $ punctuate comma $
[ ppr uq <+> text ":->" <+> ppr_elt elt
| (uq, elt) <- udfmToList ufm ]
-pprUDFM :: UniqDFM a -- ^ The things to be pretty printed
+pprUDFM :: UniqDFM key a -- ^ The things to be pretty printed
-> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
-> SDoc -- ^ 'SDoc' where the things have been pretty
-- printed
=====================================
compiler/GHC/Types/Unique/DSet.hs
=====================================
@@ -52,7 +52,7 @@ import qualified Data.Semigroup as Semi
-- Beyond preserving invariants, we may also want to 'override' typeclass
-- instances.
-newtype UniqDSet a = UniqDSet {getUniqDSet' :: UniqDFM a}
+newtype UniqDSet a = UniqDSet {getUniqDSet' :: UniqDFM a a}
deriving (Data, Semi.Semigroup, Monoid)
emptyUniqDSet :: UniqDSet a
@@ -87,14 +87,14 @@ unionManyUniqDSets (x:xs) = foldl' unionUniqDSets x xs
minusUniqDSet :: UniqDSet a -> UniqDSet a -> UniqDSet a
minusUniqDSet (UniqDSet s) (UniqDSet t) = UniqDSet (minusUDFM s t)
-uniqDSetMinusUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a
+uniqDSetMinusUniqSet :: UniqDSet a -> UniqSet a -> UniqDSet a
uniqDSetMinusUniqSet xs ys
= UniqDSet (udfmMinusUFM (getUniqDSet xs) (getUniqSet ys))
intersectUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a
intersectUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (intersectUDFM s t)
-uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a
+uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet a -> UniqDSet a
uniqDSetIntersectUniqSet xs ys
= UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys))
@@ -134,7 +134,7 @@ mapUniqDSet f = mkUniqDSet . map f . uniqDSetToList
instance Eq (UniqDSet a) where
UniqDSet a == UniqDSet b = equalKeysUDFM a b
-getUniqDSet :: UniqDSet a -> UniqDFM a
+getUniqDSet :: UniqDSet a -> UniqDFM a a
getUniqDSet = getUniqDSet'
instance Outputable a => Outputable (UniqDSet a) where
=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -22,6 +22,7 @@ of arguments of combining function.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
module GHC.Types.Unique.FM (
@@ -37,7 +38,7 @@ module GHC.Types.Unique.FM (
listToUFM_Directly,
listToUFM_C,
addToUFM,addToUFM_C,addToUFM_Acc,
- addListToUFM,addListToUFM_C,
+ addListToUFM,addListToUFM_C, addListToUFM_C_Directly,
addToUFM_Directly,
addListToUFM_Directly,
adjustUFM, alterUFM,
@@ -84,111 +85,129 @@ import qualified Data.Semigroup as Semi
import Data.Functor.Classes (Eq1 (..))
-newtype UniqFM ele = UFM (M.IntMap ele)
+newtype UniqFM key ele = UFM (M.IntMap ele)
deriving (Data, Eq, Functor)
-- Nondeterministic Foldable and Traversable instances are accessible through
-- use of the 'NonDetUniqFM' wrapper.
-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
-emptyUFM :: UniqFM elt
+emptyUFM :: UniqFM key elt
emptyUFM = UFM M.empty
-isNullUFM :: UniqFM elt -> Bool
+isNullUFM :: UniqFM key elt -> Bool
isNullUFM (UFM m) = M.null m
-unitUFM :: Uniquable key => key -> elt -> UniqFM elt
+unitUFM :: Uniquable key => key -> elt -> UniqFM key elt
unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
-- when you've got the Unique already
-unitDirectlyUFM :: Unique -> elt -> UniqFM elt
+unitDirectlyUFM :: Unique -> elt -> UniqFM key elt
unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
-listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
+listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt
listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM
-listToUFM_Directly :: [(Unique, elt)] -> UniqFM elt
+listToUFM_Directly :: [(Unique, elt)] -> UniqFM key elt
listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
listToUFM_C
:: Uniquable key
=> (elt -> elt -> elt)
-> [(key, elt)]
- -> UniqFM elt
+ -> UniqFM key elt
listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM
-addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
+addToUFM :: Uniquable key => UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
-addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
+addListToUFM :: Uniquable key => UniqFM key elt -> [(key,elt)] -> UniqFM key elt
addListToUFM = foldl' (\m (k, v) -> addToUFM m k v)
-addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
+addListToUFM_Directly :: UniqFM key elt -> [(Unique,elt)] -> UniqFM key elt
addListToUFM_Directly = foldl' (\m (k, v) -> addToUFM_Directly m k v)
-addToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt
+addToUFM_Directly :: UniqFM key elt -> Unique -> elt -> UniqFM key elt
addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)
addToUFM_C
:: Uniquable key
=> (elt -> elt -> elt) -- old -> new -> result
- -> UniqFM elt -- old
+ -> UniqFM key elt -- old
-> key -> elt -- new
- -> UniqFM elt -- result
+ -> UniqFM key elt -- result
-- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
addToUFM_C f (UFM m) k v =
UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
+addToUFM_C_Directly
+ :: (elt -> elt -> elt) -- old -> new -> result
+ -> UniqFM key elt -- old
+ -> Unique -> elt -- new
+ -> UniqFM key elt -- result
+-- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
+addToUFM_C_Directly f (UFM m) k v =
+ UFM (M.insertWith (flip f) (getKey k) v m)
+
addToUFM_Acc
:: Uniquable key
=> (elt -> elts -> elts) -- Add to existing
-> (elt -> elts) -- New element
- -> UniqFM elts -- old
+ -> UniqFM key elts -- old
-> key -> elt -- new
- -> UniqFM elts -- result
+ -> UniqFM key elts -- result
addToUFM_Acc exi new (UFM m) k v =
UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
alterUFM
:: Uniquable key
=> (Maybe elt -> Maybe elt) -- How to adjust
- -> UniqFM elt -- old
+ -> UniqFM key elt -- old
-> key -- new
- -> UniqFM elt -- result
+ -> UniqFM key elt -- result
alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)
+-- | Add elements to the map, combining existing values with inserted ones using
+-- the given function.
addListToUFM_C
:: Uniquable key
=> (elt -> elt -> elt)
- -> UniqFM elt -> [(key,elt)]
- -> UniqFM elt
+ -> UniqFM key elt -> [(key,elt)]
+ -> UniqFM key elt
addListToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v)
-adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt
+addListToUFM_C_Directly :: (elt -> elt -> elt)
+ -> UniqFM key elt
+ -> [(Unique,elt)]
+ -> UniqFM key elt
+addListToUFM_C_Directly f = foldl' (\m (k, v) -> addToUFM_C_Directly f m k v)
+
+
+adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM key elt -> key -> UniqFM key elt
adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)
-adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt
+adjustUFM_Directly :: (elt -> elt) -> UniqFM key elt -> Unique -> UniqFM key elt
adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
-delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
+delFromUFM :: Uniquable key => UniqFM key elt -> key -> UniqFM key elt
delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
-delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
+delListFromUFM :: Uniquable key => UniqFM key elt -> [key] -> UniqFM key elt
delListFromUFM = foldl' delFromUFM
-delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt
+delListFromUFM_Directly :: UniqFM key elt -> [Unique] -> UniqFM key elt
delListFromUFM_Directly = foldl' delFromUFM_Directly
-delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
+delFromUFM_Directly :: UniqFM key elt -> Unique -> UniqFM key elt
delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
-- Bindings in right argument shadow those in the left
-plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
+plusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt
-- M.union is left-biased, plusUFM should be right-biased.
plusUFM (UFM x) (UFM y) = UFM (M.union y x)
-- Note (M.union y x), with arguments flipped
-- M.union is left-biased, plusUFM should be right-biased.
-plusUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt
+plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
-- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
@@ -204,11 +223,11 @@ plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
-- @
plusUFM_CD
:: (elta -> eltb -> eltc)
- -> UniqFM elta -- map X
+ -> UniqFM key elta -- map X
-> elta -- default for X
- -> UniqFM eltb -- map Y
+ -> UniqFM key eltb -- map Y
-> eltb -- default for Y
- -> UniqFM eltc
+ -> UniqFM key eltc
plusUFM_CD f (UFM xm) dx (UFM ym) dy
= UFM $ M.mergeWithKey
(\_ x y -> Just (x `f` y))
@@ -225,9 +244,9 @@ plusUFM_CD f (UFM xm) dx (UFM ym) dy
-- (mapUFM Just m2) Nothing`.
plusUFM_CD2
:: (Maybe elta -> Maybe eltb -> eltc)
- -> UniqFM elta -- map X
- -> UniqFM eltb -- map Y
- -> UniqFM eltc
+ -> UniqFM key elta -- map X
+ -> UniqFM key eltb -- map Y
+ -> UniqFM key eltc
plusUFM_CD2 f (UFM xm) (UFM ym)
= UFM $ M.mergeWithKey
(\_ x y -> Just (Just x `f` Just y))
@@ -236,7 +255,7 @@ plusUFM_CD2 f (UFM xm) (UFM ym)
xm ym
plusMaybeUFM_C :: (elt -> elt -> Maybe elt)
- -> UniqFM elt -> UniqFM elt -> UniqFM elt
+ -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusMaybeUFM_C f (UFM xm) (UFM ym)
= UFM $ M.mergeWithKey
(\_ x y -> x `f` y)
@@ -244,80 +263,80 @@ plusMaybeUFM_C f (UFM xm) (UFM ym)
id
xm ym
-plusUFMList :: [UniqFM elt] -> UniqFM elt
+plusUFMList :: [UniqFM key elt] -> UniqFM key elt
plusUFMList = foldl' plusUFM emptyUFM
-minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
+minusUFM :: UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
-intersectUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
+intersectUFM :: UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
intersectUFM_C
:: (elt1 -> elt2 -> elt3)
- -> UniqFM elt1
- -> UniqFM elt2
- -> UniqFM elt3
+ -> UniqFM key elt1
+ -> UniqFM key elt2
+ -> UniqFM key elt3
intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
-disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
+disjointUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
disjointUFM (UFM x) (UFM y) = M.disjoint x y
-foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+foldUFM :: (elt -> a -> a) -> a -> UniqFM key elt -> a
foldUFM k z (UFM m) = M.foldr k z m
-mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
+mapUFM :: (elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2
mapUFM f (UFM m) = UFM (M.map f m)
-mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
+mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2
mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
-filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
+filterUFM :: (elt -> Bool) -> UniqFM key elt -> UniqFM key elt
filterUFM p (UFM m) = UFM (M.filter p m)
-filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
+filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM key elt -> UniqFM key elt
filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
-partitionUFM :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt)
+partitionUFM :: (elt -> Bool) -> UniqFM key elt -> (UniqFM key elt, UniqFM key elt)
partitionUFM p (UFM m) =
case M.partition p m of
(left, right) -> (UFM left, UFM right)
-sizeUFM :: UniqFM elt -> Int
+sizeUFM :: UniqFM key elt -> Int
sizeUFM (UFM m) = M.size m
-elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
+elemUFM :: Uniquable key => key -> UniqFM key elt -> Bool
elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
-elemUFM_Directly :: Unique -> UniqFM elt -> Bool
+elemUFM_Directly :: Unique -> UniqFM key elt -> Bool
elemUFM_Directly u (UFM m) = M.member (getKey u) m
-lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
+lookupUFM :: Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
-- when you've got the Unique already
-lookupUFM_Directly :: UniqFM elt -> Unique -> Maybe elt
+lookupUFM_Directly :: UniqFM key elt -> Unique -> Maybe elt
lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
-lookupWithDefaultUFM :: Uniquable key => UniqFM elt -> elt -> key -> elt
+lookupWithDefaultUFM :: Uniquable key => UniqFM key elt -> elt -> key -> elt
lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
-lookupWithDefaultUFM_Directly :: UniqFM elt -> elt -> Unique -> elt
+lookupWithDefaultUFM_Directly :: UniqFM key elt -> elt -> Unique -> elt
lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
-eltsUFM :: UniqFM elt -> [elt]
+eltsUFM :: UniqFM key elt -> [elt]
eltsUFM (UFM m) = M.elems m
-ufmToSet_Directly :: UniqFM elt -> S.IntSet
+ufmToSet_Directly :: UniqFM key elt -> S.IntSet
ufmToSet_Directly (UFM m) = M.keysSet m
-anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool
+anyUFM :: (elt -> Bool) -> UniqFM key elt -> Bool
anyUFM p (UFM m) = M.foldr ((||) . p) False m
-allUFM :: (elt -> Bool) -> UniqFM elt -> Bool
+allUFM :: (elt -> Bool) -> UniqFM key elt -> Bool
allUFM p (UFM m) = M.foldr ((&&) . p) True m
-seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> ()
+seqEltsUFM :: ([elt] -> ()) -> UniqFM key elt -> ()
seqEltsUFM seqList = seqList . nonDetEltsUFM
-- It's OK to use nonDetEltsUFM here because the type guarantees that
-- the only interesting thing this function can do is to force the
@@ -326,31 +345,31 @@ seqEltsUFM seqList = seqList . nonDetEltsUFM
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetEltsUFM :: UniqFM elt -> [elt]
+nonDetEltsUFM :: UniqFM key elt -> [elt]
nonDetEltsUFM (UFM m) = M.elems m
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetKeysUFM :: UniqFM elt -> [Unique]
+nonDetKeysUFM :: UniqFM key elt -> [Unique]
nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetStrictFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetStrictFoldUFM :: (elt -> a -> a) -> a -> UniqFM key elt -> a
nonDetStrictFoldUFM k z (UFM m) = M.foldl' (flip k) z m
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetStrictFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetStrictFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM key elt -> a
nonDetStrictFoldUFM_Directly k z (UFM m) = M.foldlWithKey' (\z' i x -> k (getUnique i) x z') z m
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetUFMToList :: UniqFM elt -> [(Unique, elt)]
+nonDetUFMToList :: UniqFM key elt -> [(Unique, elt)]
nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
-- | A wrapper around 'UniqFM' with the sole purpose of informing call sites
@@ -359,48 +378,48 @@ nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
-newtype NonDetUniqFM ele = NonDetUniqFM { getNonDet :: UniqFM ele }
+newtype NonDetUniqFM key ele = NonDetUniqFM { getNonDet :: UniqFM key ele }
deriving (Functor)
-- | Inherently nondeterministic.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
-instance Foldable NonDetUniqFM where
+instance forall key. Foldable (NonDetUniqFM key) where
foldr f z (NonDetUniqFM (UFM m)) = foldr f z m
-- | Inherently nondeterministic.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
-instance Traversable NonDetUniqFM where
+instance forall key. Traversable (NonDetUniqFM key) where
traverse f (NonDetUniqFM (UFM m)) = NonDetUniqFM . UFM <$> traverse f m
-ufmToIntMap :: UniqFM elt -> M.IntMap elt
+ufmToIntMap :: UniqFM key elt -> M.IntMap elt
ufmToIntMap (UFM m) = m
-unsafeIntMapToUFM :: M.IntMap elt -> UniqFM elt
+unsafeIntMapToUFM :: M.IntMap elt -> UniqFM key elt
unsafeIntMapToUFM = UFM
-- Determines whether two 'UniqFM's contain the same keys.
-equalKeysUFM :: UniqFM a -> UniqFM b -> Bool
+equalKeysUFM :: UniqFM key a -> UniqFM key b -> Bool
equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2
-- Instances
-instance Semi.Semigroup (UniqFM a) where
+instance Semi.Semigroup (UniqFM key a) where
(<>) = plusUFM
-instance Monoid (UniqFM a) where
+instance Monoid (UniqFM key a) where
mempty = emptyUFM
mappend = (Semi.<>)
-- Output-ery
-instance Outputable a => Outputable (UniqFM a) where
+instance Outputable a => Outputable (UniqFM key a) where
ppr ufm = pprUniqFM ppr ufm
-pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
+pprUniqFM :: (a -> SDoc) -> UniqFM key a -> SDoc
pprUniqFM ppr_elt ufm
= brackets $ fsep $ punctuate comma $
[ ppr uq <+> text ":->" <+> ppr_elt elt
@@ -413,7 +432,7 @@ pprUniqFM ppr_elt ufm
-- shouldn't be a problem.
-- Having this function helps contain the non-determinism created with
-- nonDetEltsUFM.
-pprUFM :: UniqFM a -- ^ The things to be pretty printed
+pprUFM :: UniqFM key a -- ^ The things to be pretty printed
-> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
-> SDoc -- ^ 'SDoc' where the things have been pretty
-- printed
@@ -425,7 +444,7 @@ pprUFM ufm pp = pp (nonDetEltsUFM ufm)
-- Having this function helps contain the non-determinism created with
-- nonDetUFMToList.
pprUFMWithKeys
- :: UniqFM a -- ^ The things to be pretty printed
+ :: UniqFM key a -- ^ The things to be pretty printed
-> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements
-> SDoc -- ^ 'SDoc' where the things have been pretty
-- printed
@@ -433,7 +452,7 @@ pprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm)
-- | Determines the pluralisation suffix appropriate for the length of a set
-- in the same way that plural from Outputable does for lists.
-pluralUFM :: UniqFM a -> SDoc
+pluralUFM :: UniqFM key a -> SDoc
pluralUFM ufm
| sizeUFM ufm == 1 = empty
| otherwise = char 's'
=====================================
compiler/GHC/Types/Unique/Set.hs
=====================================
@@ -63,7 +63,7 @@ import qualified Data.Semigroup as Semi
-- It means that to implement mapUniqSet you have to update
-- both the keys and the values.
-newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a}
+newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a a}
deriving (Data, Semi.Semigroup, Monoid)
emptyUniqSet :: UniqSet a
@@ -109,13 +109,13 @@ intersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t)
disjointUniqSets :: UniqSet a -> UniqSet a -> Bool
disjointUniqSets (UniqSet s) (UniqSet t) = disjointUFM s t
-restrictUniqSetToUFM :: UniqSet a -> UniqFM b -> UniqSet a
+restrictUniqSetToUFM :: UniqSet key -> UniqFM key b -> UniqSet key
restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m)
-uniqSetMinusUFM :: UniqSet a -> UniqFM b -> UniqSet a
+uniqSetMinusUFM :: UniqSet key -> UniqFM key b -> UniqSet key
uniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t)
-uniqSetMinusUDFM :: UniqSet a -> UniqDFM b -> UniqSet a
+uniqSetMinusUDFM :: UniqSet key -> UniqDFM key b -> UniqSet key
uniqSetMinusUDFM (UniqSet s) t = UniqSet (ufmMinusUDFM s t)
elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
@@ -145,7 +145,9 @@ sizeUniqSet (UniqSet s) = sizeUFM s
isEmptyUniqSet :: UniqSet a -> Bool
isEmptyUniqSet (UniqSet s) = isNullUFM s
-lookupUniqSet :: Uniquable a => UniqSet b -> a -> Maybe b
+-- | What's the point you might ask? We might have changed an object
+-- without it's key. In which case this lookup makes sense.
+lookupUniqSet :: Uniquable key => UniqSet key -> key -> Maybe key
lookupUniqSet (UniqSet s) k = lookupUFM s k
lookupUniqSet_Directly :: UniqSet a -> Unique -> Maybe a
@@ -178,13 +180,13 @@ mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet
instance Eq (UniqSet a) where
UniqSet a == UniqSet b = equalKeysUFM a b
-getUniqSet :: UniqSet a -> UniqFM a
+getUniqSet :: UniqSet a -> UniqFM a a
getUniqSet = getUniqSet'
-- | 'unsafeUFMToUniqSet' converts a @'UniqFM' a@ into a @'UniqSet' a@
-- assuming, without checking, that it maps each 'Unique' to a value
-- that has that 'Unique'. See Note [UniqSet invariant].
-unsafeUFMToUniqSet :: UniqFM a -> UniqSet a
+unsafeUFMToUniqSet :: UniqFM a a -> UniqSet a
unsafeUFMToUniqSet = UniqSet
instance Outputable a => Outputable (UniqSet a) where
=====================================
compiler/GHC/Types/Var/Env.hs
=====================================
@@ -440,7 +440,7 @@ delTidyEnvList (occ_env, var_env) vs = (occ_env', var_env')
-}
-- | Variable Environment
-type VarEnv elt = UniqFM elt
+type VarEnv elt = UniqFM Var elt
-- | Identifier Environment
type IdEnv elt = VarEnv elt
@@ -533,7 +533,7 @@ modifyVarEnv mangle_fn env key
Nothing -> env
Just xx -> extendVarEnv env key (mangle_fn xx)
-modifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a
+modifyVarEnv_Directly :: (a -> a) -> UniqFM key a -> Unique -> UniqFM key a
modifyVarEnv_Directly mangle_fn env key
= case (lookupUFM_Directly env key) of
Nothing -> env
@@ -544,7 +544,7 @@ modifyVarEnv_Directly mangle_fn env key
-- DVarEnv.
-- | Deterministic Variable Environment
-type DVarEnv elt = UniqDFM elt
+type DVarEnv elt = UniqDFM Var elt
-- | Deterministic Identifier Environment
type DIdEnv elt = DVarEnv elt
=====================================
compiler/GHC/Types/Var/Set.hs
=====================================
@@ -131,7 +131,7 @@ isEmptyVarSet = isEmptyUniqSet
mkVarSet = mkUniqSet
lookupVarSet_Directly = lookupUniqSet_Directly
lookupVarSet = lookupUniqSet
-lookupVarSetByName = lookupUniqSet
+lookupVarSetByName set name = lookupUniqSet_Directly set (getUnique name)
sizeVarSet = sizeUniqSet
filterVarSet = filterUniqSet
delVarSetByKey = delOneFromUniqSet_Directly
=====================================
compiler/GHC/Unit/Module/Env.hs
=====================================
@@ -32,6 +32,7 @@ where
import GHC.Prelude
+import {-# SOURCE #-} GHC.Types.Name (ModuleName)
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
@@ -191,12 +192,12 @@ UniqFM.
-}
-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
-type ModuleNameEnv elt = UniqFM elt
+type ModuleNameEnv elt = UniqFM ModuleName elt
-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
-- Has deterministic folds and can be deterministically converted to a list
-type DModuleNameEnv elt = UniqDFM elt
+type DModuleNameEnv elt = UniqDFM ModuleName elt
--------------------------------------------------------------------
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1148,7 +1148,7 @@ undef s = panic ("Binary.UserData: no " ++ s)
type Dictionary = Array Int FastString -- The dictionary
-- Should be 0-indexed
-putDictionary :: BinHandle -> Int -> UniqFM (Int,FastString) -> IO ()
+putDictionary :: BinHandle -> Int -> UniqFM key (Int,FastString) -> IO ()
putDictionary bh sz dict = do
put_ bh sz
mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict)))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41b032247b32bcbf97b766eeda360e9baf7b5b8b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41b032247b32bcbf97b766eeda360e9baf7b5b8b
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200623/dcf2d51c/attachment-0001.html>
More information about the ghc-commits
mailing list