Remove special casing of singleton strings, split all strings.

Summary:
exprIsConApp_maybe now detects string literals and correctly
splits them. This means case-statemnts on string literals can
now push the literal into the cases.

fix trac issue #9400

Test Plan: validate

Reviewers: austin, simonpj

Reviewed By: austin, simonpj

Subscribers: simonmar, ezyang, carter

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

GHC Trac Issues: #9400

3 files changed, 55 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T9400.hs b/testsuite/tests/simplCore/should_compile/T9400.hs
new file mode 100644
index 0000000000..4e9cb72cb9
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T9400.hs
@@ -0,0 +1,18 @@
+module T9400 (main) where
+import GHC.Base
+
+str = "defg"
+
+main :: IO ()
+main = do
+    case "abc" of
+        (x:y:xs) -> putStrLn xs
+    case "" of
+        [] -> putStrLn "x"
+    case "ab" of
+        [] -> putStrLn "y"
+        (x:y:[]) -> putStrLn "z"
+    case str of
+        (x:xs) -> putStrLn xs
+    case "ab" of
+        "" -> putStrLn "fail"
diff --git a/testsuite/tests/simplCore/should_compile/T9400.stderr b/testsuite/tests/simplCore/should_compile/T9400.stderr
new file mode 100644
index 0000000000..e66eecfc0a
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T9400.stderr
@@ -0,0 +1,36 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 23, types: 16, coercions: 0}
+
+T9400.main :: GHC.Types.IO ()
+[GblId, Str=DmdType]
+T9400.main =
+  GHC.Base.>>
+    @ GHC.Types.IO
+    GHC.Base.$fMonadIO
+    @ ()
+    @ ()
+    (System.IO.putStrLn (GHC.CString.unpackCString# "c"#))
+    (GHC.Base.>>
+       @ GHC.Types.IO
+       GHC.Base.$fMonadIO
+       @ ()
+       @ ()
+       (System.IO.putStrLn (GHC.CString.unpackCString# "x"#))
+       (GHC.Base.>>
+          @ GHC.Types.IO
+          GHC.Base.$fMonadIO
+          @ ()
+          @ ()
+          (System.IO.putStrLn (GHC.CString.unpackCString# "z"#))
+          (GHC.Base.>>
+             @ GHC.Types.IO
+             GHC.Base.$fMonadIO
+             @ ()
+             @ ()
+             (System.IO.putStrLn (GHC.CString.unpackCString# "efg"#))
+             (Control.Exception.Base.patError
+                @ (GHC.Types.IO ()) "T9400.hs:(17,5)-(18,29)|case"#))))
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 88d10228f9..399498b800 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -206,3 +206,4 @@ test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings -dsuppress-u
 test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules'])
 test('T8331', only_ways(['optasm']), compile, ['-ddump-rules'])
 test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings'])
+test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniques'])