diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2023-03-06 18:58:10 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-03-10 10:18:54 -0500 |
commit | ec2d93ebf2468e9250676da256936d8940de4723 (patch) | |
tree | 7cd89268ab58657332178b8ccff3139e6894d2b4 | |
parent | 9ea719f2f1929bf2b789e4001f6c542a04185d61 (diff) | |
download | haskell-ec2d93ebf2468e9250676da256936d8940de4723.tar.gz |
DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997)
We should not panic in `add_demands` (now `set_lam_dmds`), because that code
path is legimitely taken for OPAQUE PAP bindings, as in T22997.
Fixes #22997.
-rw-r--r-- | compiler/GHC/Core/Opt/DmdAnal.hs | 22 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_compile/T22997.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_compile/all.T | 2 |
3 files changed, 23 insertions, 10 deletions
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs index 0bcabf55d3..ece13d894b 100644 --- a/compiler/GHC/Core/Opt/DmdAnal.hs +++ b/compiler/GHC/Core/Opt/DmdAnal.hs @@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- Check for an OPAQUE function: see Note [OPAQUE pragma] -- In that case, trim off all boxity info from argument demands + -- and demand info on lambda binders -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments] | isOpaquePragma (idInlinePragma fn) , let trimmed_rhs_dmds = map trimBoxity rhs_dmds - = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs) + = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs) -- Check that we have enough visible binders to match the -- threshold arity; if not, we won't do worker/wrapper @@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ - (arg_dmds', add_demands arg_dmds' rhs) - -- add_demands: we must attach the final boxities to the lambda-binders + (arg_dmds', set_lam_dmds arg_dmds' rhs) + -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis -- uses the info on the binders directly. where @@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs | positiveTopBudget bg_inner' = (bg_inner', dmd') | otherwise = (bg_inner, trimBoxity dmd) - add_demands :: [Demand] -> CoreExpr -> CoreExpr + set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr -- Attach the demands to the outer lambdas of this expression - add_demands [] e = e - add_demands (dmd:dmds) (Lam v e) - | isTyVar v = Lam v (add_demands (dmd:dmds) e) - | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e) - add_demands dmds (Cast e co) = Cast (add_demands dmds e) co + set_lam_dmds (dmd:dmds) (Lam v e) + | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e) + | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e) + set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co -- This case happens for an OPAQUE function, which may look like -- f = (\x y. blah) |> co -- We give it strictness but no boxity (#22502) - add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e) + set_lam_dmds _ e = e + -- In the OPAQUE case, the list of demands at this point might be + -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997). finaliseLetBoxity :: AnalEnv diff --git a/testsuite/tests/stranal/should_compile/T22997.hs b/testsuite/tests/stranal/should_compile/T22997.hs new file mode 100644 index 0000000000..4c77f70a6e --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T22997.hs @@ -0,0 +1,9 @@ +module T22997 where + +{-# OPAQUE trivial #-} +trivial :: Int -> Int +trivial = succ + +{-# OPAQUE pap #-} +pap :: Integer -> Integer +pap = (42 +) diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index c5f142567f..0355def88e 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) # T22388: Should see $winteresting but not $wboring test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) +# T22997: Just a panic that should not happen +test('T22997', normal, compile, ['']) |