[commit: ghc] master: Re-sort case alternatives after scrutinee constant folding (#13170) (abaa681)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/abaa6815e6435ed29ad121b5e59fc017a1d3e836/ghc

>---------------------------------------------------------------

commit abaa6815e6435ed29ad121b5e59fc017a1d3e836
Author: Reid Barton <rwbarton at gmail.com>
Date:   Mon Jan 23 21:57:53 2017 -0500

    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


>---------------------------------------------------------------

abaa6815e6435ed29ad121b5e59fc017a1d3e836
 compiler/simplCore/SimplUtils.hs                   | 6 +++++-
 testsuite/tests/simplCore/should_compile/T13170.hs | 4 ++++
 testsuite/tests/simplCore/should_compile/all.T     | 1 +
 3 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 47c5be6..3b48924 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 0000000..06ea656
--- /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 8bd7cdd..d63d0d1 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'])