Re-sort case alternatives after scrutinee constant folding (#13170)
authorReid Barton <rwbarton@gmail.com>
Tue, 24 Jan 2017 02:57:53 +0000 (21:57 -0500)
committerBen Gamari <ben@smart-cactus.org>
Tue, 24 Jan 2017 03:05:53 +0000 (22:05 -0500)
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

compiler/simplCore/SimplUtils.hs
testsuite/tests/simplCore/should_compile/T13170.hs [new file with mode: 0644]
testsuite/tests/simplCore/should_compile/all.T

index 47c5be6..3b48924 100644 (file)
@@ -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 (file)
index 0000000..06ea656
--- /dev/null
@@ -0,0 +1,4 @@
+module T13170 where
+f :: Int -> Bool
+f x = y == 2 || y == 3
+  where y = -x
index 8bd7cdd..d63d0d1 100644 (file)
@@ -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'])