diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-04-08 09:43:40 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-04-08 09:47:03 +0100 |
| commit | ff4eab4874e967322cdba9e4b8cb1cbf65415ddc (patch) | |
| tree | ddf66975fc225c1503323ca2a9e341852dd59171 | |
| parent | 247684adc83f025d2ee329f4c98ae1f8829060b4 (diff) | |
| download | haskell-wip/t19654.tar.gz | |
Make UDFM semigroup instance associativewip/t19654
Divam noticed in #19654 that the (<>) definition was not associative.
This makes the operation associative, but it seems dubious to provide
plusUDFM at all as it is very easy to misuse and produce unexpected
results if your key sets are not disjoint.
The one case where it is fine is in the definition of UDSet because the
keys and values in the map coincide.
Fixes #19654
| -rw-r--r-- | compiler/GHC/Types/Unique/DFM.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/Types/Var/Env.hs | 4 |
2 files changed, 11 insertions, 1 deletions
diff --git a/compiler/GHC/Types/Unique/DFM.hs b/compiler/GHC/Types/Unique/DFM.hs index f3009de2a2..03a4e9bb45 100644 --- a/compiler/GHC/Types/Unique/DFM.hs +++ b/compiler/GHC/Types/Unique/DFM.hs @@ -216,6 +216,8 @@ addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v) delFromUDFM :: Uniquable key => UniqDFM key elt -> key -> UniqDFM key elt delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i +-- | Note that this operation is not associative unless the two maps are +-- disjoint. 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, @@ -256,6 +258,8 @@ 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. +-- | Note that this operation is not associative unless the two maps are +-- disjoint. 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, @@ -413,7 +417,9 @@ allUDFM :: (elt -> Bool) -> UniqDFM key elt -> Bool allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m instance Semi.Semigroup (UniqDFM key a) where - (<>) = plusUDFM + -- Important to use 'insertUDFMIntoLeft' here as 'plusUDFM' is not + -- associative. + (<>) = insertUDFMIntoLeft instance Monoid (UniqDFM key a) where mempty = emptyUDFM diff --git a/compiler/GHC/Types/Var/Env.hs b/compiler/GHC/Types/Var/Env.hs index ed58c413f4..5376ff3632 100644 --- a/compiler/GHC/Types/Var/Env.hs +++ b/compiler/GHC/Types/Var/Env.hs @@ -594,9 +594,13 @@ filterDVarEnv = filterUDFM alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a alterDVarEnv = alterUDFM +-- | Note that 'plusDVarEnv' is *not* associative unless the keys of the two +-- maps are disjoint. plusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a plusDVarEnv = plusUDFM +-- | Note that 'plusDVarEnv_C' is *not* associative unless the keys of the two +-- maps are disjoint. plusDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> DVarEnv a -> DVarEnv a plusDVarEnv_C = plusUDFM_C |