summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2021-02-23 13:08:29 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-01 17:32:48 -0500
commit51828c6daedc5ba0843706bba65dfe396648944c (patch)
treea3f11c3241e8ac3a01744098337a5044ff3ab9f3
parentce85cffc7c3afa55755ae8d1aa027761bf54bed4 (diff)
downloadhaskell-51828c6daedc5ba0843706bba65dfe396648944c.tar.gz
Fix a bug causing loss of sharing in `UniqSDFM`
While fixing #18610, I noticed that ```hs f :: Bool -> Int f x = case (x, x) of (True, True) -> 1 (False, False) -> 2 ``` was *not* detected as exhaustive. I tracked it down to `equateUSDFM`, where upon merging equality classes of `x` and `y`, we failed to atually indirect the *representative* `x'` of the equality class of `x` to the representative `y'` of `y`. The fixed code is much more naturally and would I should have written in the first place. I can confirm that the above example now is detected as exhaustive. The commit that fixes #18610 comes directly after and it has `f` above as a regression test, so I saw no need to open a ticket or commit a separate regression test.
-rw-r--r--compiler/GHC/Types/Unique/SDFM.hs4
1 files changed, 2 insertions, 2 deletions
diff --git a/compiler/GHC/Types/Unique/SDFM.hs b/compiler/GHC/Types/Unique/SDFM.hs
index a0871909ed..b34c4b3f94 100644
--- a/compiler/GHC/Types/Unique/SDFM.hs
+++ b/compiler/GHC/Types/Unique/SDFM.hs
@@ -88,8 +88,8 @@ equateUSDFM usdfm@(USDFM env) x y =
case (lu x, lu y) of
((x', _) , (y', _))
| getUnique x' == getUnique y' -> (Nothing, usdfm) -- nothing to do
- ((x', _) , (_ , Nothing)) -> (Nothing, set_indirect y x')
- ((_ , mb_ex), (y', _)) -> (mb_ex, set_indirect x y')
+ ((x', _) , (y', Nothing)) -> (Nothing, set_indirect y' x')
+ ((x', mb_ex), (y', _)) -> (mb_ex, set_indirect x' y')
where
lu = lookupReprAndEntryUSDFM usdfm
set_indirect a b = USDFM $ addToUDFM env a (Indirect b)