Commit abaa6815 authored by rwbarton's avatar rwbarton Committed by Ben Gamari
Browse files

Re-sort case alternatives after scrutinee constant folding (#13170)

Commit d3b546b1 added a "scrutinee constant folding" pass
that rewrites a case expression whose scrutinee is an expression like
x +# 3#. But case expressions are supposed to have their alternatives in
sorted order, so when the scrutinee is (for example) negateInt# x#, we
need to re-sort the alternatives after mapping their values.

This showed up as a core lint failure when compiling System.Process.Posix:

    isSigIntQuit n = sig == sigINT || sig == sigQUIT
        where sig = fromIntegral (-n)

Data.List.sortBy is supposed to be linear-time on sorted or reverse-sorted
input, so it is probably not worth doing anything more clever than this.

Test Plan: Added a new test T13170 for the above case.

Reviewers: austin, hsyl20, simonpj, bgamari

Reviewed By: hsyl20, simonpj, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3008

GHC Trac Issues: #13170
parent 53e2e70a
...@@ -64,6 +64,7 @@ import PrelRules ...@@ -64,6 +64,7 @@ import PrelRules
import Literal import Literal
import Control.Monad ( when ) import Control.Monad ( when )
import Data.List ( sortBy )
{- {-
************************************************************************ ************************************************************************
...@@ -1926,7 +1927,7 @@ mkCase1 dflags scrut bndr alts_ty alts = mkCase2 dflags scrut bndr alts_ty alts ...@@ -1926,7 +1927,7 @@ mkCase1 dflags scrut bndr alts_ty alts = mkCase2 dflags scrut bndr alts_ty alts
mkCase2 dflags scrut bndr alts_ty alts mkCase2 dflags scrut bndr alts_ty alts
| gopt Opt_CaseFolding dflags | gopt Opt_CaseFolding dflags
, Just (scrut',f) <- caseRules dflags scrut , Just (scrut',f) <- caseRules dflags scrut
= mkCase3 dflags scrut' bndr alts_ty (map (mapAlt f) alts) = mkCase3 dflags scrut' bndr alts_ty (new_alts f)
| otherwise | otherwise
= mkCase3 dflags scrut bndr alts_ty alts = mkCase3 dflags scrut bndr alts_ty alts
where where
...@@ -1946,6 +1947,9 @@ mkCase2 dflags scrut bndr alts_ty alts ...@@ -1946,6 +1947,9 @@ mkCase2 dflags scrut bndr alts_ty alts
| isDeadBinder bndr = rhs | isDeadBinder bndr = rhs
| otherwise = Let (NonRec bndr l) rhs | otherwise = Let (NonRec bndr l) rhs
-- We need to re-sort the alternatives to preserve the #case_invariants#
new_alts f = sortBy cmpAlt (map (mapAlt f) alts)
mapAlt f alt@(c,bs,e) = case c of mapAlt f alt@(c,bs,e) = case c of
DEFAULT -> (c, bs, wrap_rhs scrut e) DEFAULT -> (c, bs, wrap_rhs scrut e)
LitAlt l LitAlt l
......
module T13170 where
f :: Int -> Bool
f x = y == 2 || y == 3
where y = -x
...@@ -239,3 +239,4 @@ test('str-rules', ...@@ -239,3 +239,4 @@ test('str-rules',
normal, normal,
run_command, run_command,
['$MAKE -s --no-print-directory str-rules']) ['$MAKE -s --no-print-directory str-rules'])
test('T13170', only_ways(['optasm']), compile, ['-dcore-lint'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment