diff options
| author | Reid Barton <rwbarton@gmail.com> | 2017-01-23 21:57:53 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-01-23 22:05:53 -0500 |
| commit | abaa6815e6435ed29ad121b5e59fc017a1d3e836 (patch) | |
| tree | 1a5efbaf3586c25e99f91d90f1c28c82c8117248 | |
| parent | 53e2e70a477896d57059b5f12147b69d22a2e2e0 (diff) | |
| download | haskell-abaa6815e6435ed29ad121b5e59fc017a1d3e836.tar.gz | |
Re-sort case alternatives after scrutinee constant folding (#13170)
Commit d3b546b1a605 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
| -rw-r--r-- | compiler/simplCore/SimplUtils.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T13170.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
3 files changed, 10 insertions, 1 deletions
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 47c5be6d8e..3b48924ed1 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -64,6 +64,7 @@ import PrelRules import Literal 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 mkCase2 dflags scrut bndr alts_ty alts | gopt Opt_CaseFolding dflags , 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 = mkCase3 dflags scrut bndr alts_ty alts where @@ -1946,6 +1947,9 @@ mkCase2 dflags scrut bndr alts_ty alts | isDeadBinder bndr = 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 DEFAULT -> (c, bs, wrap_rhs scrut e) LitAlt l diff --git a/testsuite/tests/simplCore/should_compile/T13170.hs b/testsuite/tests/simplCore/should_compile/T13170.hs new file mode 100644 index 0000000000..06ea6563e0 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T13170.hs @@ -0,0 +1,4 @@ +module T13170 where +f :: Int -> Bool +f x = y == 2 || y == 3 + where y = -x diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 8bd7cdd350..d63d0d1958 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -239,3 +239,4 @@ test('str-rules', normal, run_command, ['$MAKE -s --no-print-directory str-rules']) +test('T13170', only_ways(['optasm']), compile, ['-dcore-lint']) |