Fix dataToTag# argument evaluation

See #15696 for more details. We now always enter dataToTag# argument (done in
generated Cmm, in StgCmmExpr). Any high-level optimisations on dataToTag#
applications are done by the simplifier. Looking at tag bits (instead of
reading the info table) for small types is left to another diff.

Incorrect test T14626 is removed. We no longer do this optimisation (see
comment:44, comment:45, comment:60).

Comments and notes about special cases around dataToTag# are removed. We no
longer have any special cases around it in Core.

Other changes related to evaluating primops (seq# and dataToTag#) will be
pursued in follow-up diffs.

Test Plan: Validates with three regression tests

Reviewers: simonpj, simonmar, hvr, bgamari, dfeuer

Reviewed By: simonmar

Subscribers: rwbarton, carter

GHC Trac Issues: #15696

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

10 files changed, 65 insertions, 22 deletions

diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile
index c94c8b6f92..a1fc58f89b 100644
--- a/testsuite/tests/codeGen/should_compile/Makefile
+++ b/testsuite/tests/codeGen/should_compile/Makefile
@@ -5,9 +5,6 @@ include $(TOP)/mk/test.mk
 T2578:
 	'$(TEST_HC)' $(TEST_HC_OPTS) --make T2578 -fforce-recomp -v0
 
-T14626:
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-uniques T14626.hs | grep case
-
 debug:
 	# Without optimisations, we should get annotations for basically
 	# all expressions in the example program.
diff --git a/testsuite/tests/codeGen/should_compile/T14626.hs b/testsuite/tests/codeGen/should_compile/T14626.hs
deleted file mode 100644
index a665694bfc..0000000000
--- a/testsuite/tests/codeGen/should_compile/T14626.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-{-# LANGUAGE MagicHash #-}
-
-module T14626 where
-
-import GHC.Prim
-
-data T = MkT !Bool
-
-f v = case v of
-         MkT y -> dataToTag# y
-
--- This should /not/ produce an inner case on the y, thus:
---    f v = case v of
---            MkT y -> case y of z -> dataToTag# z
--- But it was!  See Trac #14626 comment:4
diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T
index dd6931f235..a5d5a47034 100644
--- a/testsuite/tests/codeGen/should_compile/all.T
+++ b/testsuite/tests/codeGen/should_compile/all.T
@@ -35,9 +35,6 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')),
      compile, ['-g'])
 test('T12115', normal, compile, [''])
 test('T12355', normal, compile, [''])
-test('T14626',
-     normal,
-     run_command, ['$MAKE -s --no-print-directory T14626'])
 test('T14999',
      [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261)),
       unless(opsys('linux') and arch('x86_64') and have_gdb() and
diff --git a/testsuite/tests/codeGen/should_run/T15696_1.hs b/testsuite/tests/codeGen/should_run/T15696_1.hs
new file mode 100644
index 0000000000..e747c0ad16
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T15696_1.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE MagicHash #-}
+
+import GHC.Exts
+import GHC.Prim
+
+main :: IO ()
+main = print (cmpT a T2)
+  where
+    {-# NOINLINE f #-}
+    f = T2
+    {-# NOINLINE a #-}
+    a = f
+
+data T = T1 | T2 | T3 | T4 | T5 | T6 | T7 | T8 | T9
+
+cmpT a b
+    = case dataToTag# a of
+        a' -> case dataToTag# b of
+                b' ->
+                      if tagToEnum# (a' <# b') :: Bool then
+                          LT -- used to return this
+                      else
+                          if tagToEnum# (a' ==# b') :: Bool then
+                              EQ -- should return this
+                          else
+                              GT
diff --git a/testsuite/tests/codeGen/should_run/T15696_1.stdout b/testsuite/tests/codeGen/should_run/T15696_1.stdout
new file mode 100644
index 0000000000..03426a729d
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T15696_1.stdout
@@ -0,0 +1 @@
+EQ
diff --git a/testsuite/tests/codeGen/should_run/T15696_2.hs b/testsuite/tests/codeGen/should_run/T15696_2.hs
new file mode 100644
index 0000000000..1a404bee92
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T15696_2.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE MagicHash #-}
+
+import GHC.Exts
+import GHC.Prim
+
+main :: IO ()
+main = do
+    print (I# (dataToTag# a))  -- used to print 0, should print 1
+    print (I# (dataToTag# f))  -- used to print 1 correctly
+
+  where
+    {-# NOINLINE f #-}
+    f = T2
+    {-# NOINLINE a #-}
+    a = f
+
+data T = T1 | T2
diff --git a/testsuite/tests/codeGen/should_run/T15696_2.stdout b/testsuite/tests/codeGen/should_run/T15696_2.stdout
new file mode 100644
index 0000000000..6ed281c757
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T15696_2.stdout
@@ -0,0 +1,2 @@
+1
+1
diff --git a/testsuite/tests/codeGen/should_run/T15696_3.hs b/testsuite/tests/codeGen/should_run/T15696_3.hs
new file mode 100644
index 0000000000..73b7f3cde6
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T15696_3.hs
@@ -0,0 +1,9 @@
+import qualified Data.Set as S
+
+main = print $
+  let {-# noinline f #-}
+      f () = T2
+  in  S.fromList [f (), f ()]
+
+data T = T1 | T2 | T3 | T4 | T5 | T6 | T7 | T8 | T9
+  deriving (Show, Read, Eq, Ord, Bounded, Enum)
diff --git a/testsuite/tests/codeGen/should_run/T15696_3.stdout b/testsuite/tests/codeGen/should_run/T15696_3.stdout
new file mode 100644
index 0000000000..307f49a11a
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T15696_3.stdout
@@ -0,0 +1 @@
+fromList [T2]
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index bd1521d6d8..eaf0e77b97 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -172,4 +172,12 @@ test('T13825-unit',
 test('T14619', normal, compile_and_run, [''])
 test('T14754', normal, compile_and_run, [''])
 test('T14346', only_ways(['threaded1','threaded2']), compile_and_run, ['-O -threaded'])
-test('T14251', normal, compile_and_run, [''])
+test('T14251', [expect_broken_for(14251, [''])],
+     compile_and_run, [''])
+
+# These actually used to fail with all optimisation settings, but adding -O just
+# to make sure
+test('T15696_1', normal, compile_and_run, ['-O'])
+test('T15696_2', normal, compile_and_run, ['-O'])
+# This requires -O
+test('T15696_3', normal, compile_and_run, ['-O'])