Make sure rule LHSs are simplified

SpecConstr was generating a rule LHS with nested casts,
which the simplifier then optimised away.  Result: unbound
template variables.

Easily fixed.  See Note [SpecConstr call patterns]

3 files changed, 40 insertions, 28 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T10602.hs b/testsuite/tests/simplCore/should_compile/T10602.hs
index fc2523d33e..c29d743fab 100644
--- a/testsuite/tests/simplCore/should_compile/T10602.hs
+++ b/testsuite/tests/simplCore/should_compile/T10602.hs
@@ -1,34 +1,26 @@
-import Control.Monad
-import Data.Binary
-import Data.List
+{-# OPTIONS_GHC -O2 #-}
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+-- {-# OPTIONS_GHC -fno-spec-constr #-} -- Makes the problem go away.
+-- {-# OPTIONS_GHC -fspec-constr-count=1 #-} -- Makes the problem go away.
 
-newtype A a = A [a]
+module T10602 where
 
-instance Binary a => Binary (A a) where
-    put (A xs) = case splitAt 254 xs of
-        (_, []) -> mapM_ put xs
-        (a, b)  -> put (A b)
+-- Copy-pasting T10602b.hs into the current module makes the problem go away.
+import T10602b
 
-    get = do xs <- replicateM 254 get
-             A ys <- get
-             return $ A $ xs ++ ys
+data PairS a = PairS a a
 
-main :: IO ()
-main = undefined
+-- Removing the '~' makes the problem go away.
+(PairS _ _) >> ~(PairS b g) = PairS b g
 
-{-
-This intermittently failed with although I was never able to reliably reproduce,
+class Binary t where
+    put :: t -> PairS ()
 
-$ ./inplace/bin/ghc-stage2 -O2 Test.hs -fforce-recomp
-[1 of 1] Compiling Main             ( Test.hs, Test.o )
-ghc-stage2: panic! (the 'impossible' happened)
-  (GHC version 7.10.1.20150708 for x86_64-unknown-linux):
-        Template variable unbound in rewrite rule
-  sg_s5zh
-  [sc_s5zf, sc_s5zg, sg_s5zh, sg_s5zi]
-  [sc_s5zf, sc_s5zg, sg_s5zh, sg_s5zi]
-  [: @ a_a3fv sc_s5zf sc_s5zg]
-  [: @ a_a3fv sc_s5zb sc_s5zc]
+-- Not using a newtype makes the problem go away.
+newtype A a = A [a]
 
-Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
--}
+instance Binary a => Binary (A a) where
+    put (A xs) = case splitAt 254 xs of
+        (_, []) -> foldr (>>) (PairS () ()) (map put xs)
+        (_, b)  -> put (A b)
diff --git a/testsuite/tests/simplCore/should_compile/T10602b.hs b/testsuite/tests/simplCore/should_compile/T10602b.hs
new file mode 100644
index 0000000000..f90ad0a783
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T10602b.hs
@@ -0,0 +1,20 @@
+{-# OPTIONS_GHC -O2 #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module T10602b (splitAt, map, foldr) where
+
+import GHC.Classes
+import GHC.Types
+import GHC.Num
+import GHC.Base
+
+splitAt                :: Int -> [a] -> ([a],[a])
+splitAt n ls
+  | n <= 0 = ([], ls)
+  | otherwise          = splitAt' n ls
+    where
+        splitAt' :: Int -> [a] -> ([a], [a])
+        splitAt' _  []     = ([], [])
+        splitAt' 1  (x:xs) = ([x], xs)
+        splitAt' m  (x:xs) = (x:xs', xs'')
+          where
+            (xs', xs'') = splitAt' (m - 1) xs
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index ec2a18a06c..e08eb8441e 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -212,5 +212,5 @@ test('T9565', only_ways(['optasm']), compile, [''])
 test('T5821', only_ways(['optasm']), compile, [''])
 test('T10176', only_ways(['optasm']), compile, [''])
 test('T10180', only_ways(['optasm']), compile, [''])
-test('T10602', only_ways(['optasm']), compile, ['-O2'])
+test('T10602', only_ways(['optasm']), multimod_compile, ['T10602','-v0'])
 test('T10627', only_ways(['optasm']), compile, [''])