From ff4eab4874e967322cdba9e4b8cb1cbf65415ddc Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Thu, 8 Apr 2021 09:43:40 +0100 Subject: Make UDFM semigroup instance associative 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 --- compiler/GHC/Types/Unique/DFM.hs | 8 +++++++- compiler/GHC/Types/Var/Env.hs | 4 ++++ 2 files changed, 11 insertions(+), 1 deletion(-) 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 -- cgit v1.2.1