[Git][ghc/ghc][wip/T23012] Fix shadowing bug in prepareAlts
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Feb 21 15:47:30 UTC 2023
Simon Peyton Jones pushed to branch wip/T23012 at Glasgow Haskell Compiler / GHC
Commits:
8ddd5efa by Simon Peyton Jones at 2023-02-21T15:48:42+00:00
Fix shadowing bug in prepareAlts
As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was
using an OutType to construct an InAlt. When shadowing is in play,
this is outright wrong.
See Note [Shadowing in prepareAlts].
- - - - -
4 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- + testsuite/tests/simplCore/should_compile/T23012.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -3224,9 +3224,11 @@ simplAlts env0 scrut case_bndr alts cont'
; (alt_env', scrut', case_bndr') <- improveSeq fam_envs env2 scrut
case_bndr case_bndr2 alts
- ; (imposs_deflt_cons, in_alts) <- prepareAlts scrut' case_bndr' alts
+ ; (imposs_deflt_cons, in_alts) <- prepareAlts scrut' case_bndr alts
-- NB: it's possible that the returned in_alts is empty: this is handled
- -- by the caller (rebuildCase) in the missingAlt function
+ -- by the caller (rebuildCase) in the missingAlt function
+ -- NB: pass case_bndr::InId, not case_bndr' :: OutId, to prepareAlts
+ -- See Note [Shadowing in prepareAlts] in GHC.Core.Opt.Simplify.Utils
; alts' <- mapM (simplAlt alt_env' (Just scrut') imposs_deflt_cons case_bndr' cont') in_alts
-- ; pprTrace "simplAlts" (ppr case_bndr $$ ppr alts $$ ppr cont') $ return ()
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -2270,26 +2270,37 @@ h y = case y of
If we inline h into f, the default case of the inlined h can't happen.
If we don't notice this, we may end up filtering out *all* the cases
of the inner case y, which give us nowhere to go!
+
+Note [Shadowing in prepareAlts]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note that we pass case_bndr::InId to prepareAlts; an /InId/, not an
+/OutId/. This is vital, because `refineDefaultAlt` uses `tys` to build
+a new /InAlt/. If you pass an OutId, we'll end up appling the
+substitution twice: disaster (#23012).
+
+However this does mean that filling in the default alt might be
+delayed by a simplifier cycle, because an InId has less info than an
+OutId. Test simplCore/should_compile/simpl013 apparently shows this
+up, although I'm not sure exactly how..
-}
-prepareAlts :: OutExpr -> OutId -> [InAlt] -> SimplM ([AltCon], [InAlt])
+prepareAlts :: OutExpr -> InId -> [InAlt] -> SimplM ([AltCon], [InAlt])
-- The returned alternatives can be empty, none are possible
-prepareAlts scrut case_bndr' alts
- | Just (tc, tys) <- splitTyConApp_maybe (varType case_bndr')
- -- Case binder is needed just for its type. Note that as an
- -- OutId, it has maximum information; this is important.
- -- Test simpl013 is an example
+--
+-- Note that case_bndr is an InId; see Note [Shadowing in prepareAlts]
+prepareAlts scrut case_bndr alts
+ | Just (tc, tys) <- splitTyConApp_maybe (idType case_bndr)
= do { us <- getUniquesM
- ; let (idcs1, alts1) = filterAlts tc tys imposs_cons alts
- (yes2, alts2) = refineDefaultAlt us (idMult case_bndr') tc tys idcs1 alts1
- -- the multiplicity on case_bndr's is the multiplicity of the
+ ; let (idcs1, alts1) = filterAlts tc tys imposs_cons alts
+ (yes2, alts2) = refineDefaultAlt us (idMult case_bndr) tc tys idcs1 alts1
+ -- The multiplicity on case_bndr's is the multiplicity of the
-- case expression The newly introduced patterns in
-- refineDefaultAlt must be scaled by this multiplicity
(yes3, idcs3, alts3) = combineIdenticalAlts idcs1 alts2
-- "idcs" stands for "impossible default data constructors"
-- i.e. the constructors that can't match the default case
- ; when yes2 $ tick (FillInCaseDefault case_bndr')
- ; when yes3 $ tick (AltMerge case_bndr')
+ ; when yes2 $ tick (FillInCaseDefault case_bndr)
+ ; when yes3 $ tick (AltMerge case_bndr)
; return (idcs3, alts3) }
| otherwise -- Not a data type, so nothing interesting happens
=====================================
testsuite/tests/simplCore/should_compile/T23012.hs
=====================================
@@ -0,0 +1,30 @@
+{-# LANGUAGE BangPatterns, FlexibleInstances, MultiParamTypeClasses #-}
+
+module T23012 where
+
+import Data.Kind (Type)
+
+class Vector v a where
+ nothing :: v a
+ just :: a -> v a
+
+data Proxy (a :: Type) = P
+
+instance Vector Proxy a where
+ nothing = P
+ just _ = P
+
+step :: Maybe a
+step = Nothing
+{-# INLINE[0] step #-}
+
+stream :: Vector v a => v a
+stream = case step of
+ Nothing -> nothing
+ Just !x -> just x
+{-# INLINE[1] stream #-}
+
+data Id a = MkId a
+
+f :: (Proxy (Id a), Proxy a)
+f = (stream, stream)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -472,5 +472,6 @@ test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-agg
test('T22802', normal, compile, ['-O'])
test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques'])
test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0'])
+test('T23012', normal, compile, ['-O'])
test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ddd5efa128957387dd75b41f5c49af0463b9e82
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ddd5efa128957387dd75b41f5c49af0463b9e82
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/20230221/e73f3e16/attachment-0001.html>
More information about the ghc-commits
mailing list