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]

compiler/specialise/SpecConstr.hs

@@ -1178,7 +1178,9 @@ scExpr' _   e@(Lit {})   = return (nullUsage, e)
 scExpr' env (Tick t e)   = do (usg, e') <- scExpr env e
                               return (usg, Tick t e')
 scExpr' env (Cast e co)  = do (usg, e') <- scExpr env e
-                              return (usg, Cast e' (scSubstCo env co))
+                              return (usg, mkCast e' (scSubstCo env co))
+                              -- Important to use mkCast here
+                              -- See Note [SpecConstr call patterns]
 scExpr' env e@(App _ _)  = scApp env (collectArgs e)
 scExpr' env (Lam b e)    = do let (env', b') = extendBndr env b
                               (usg, e') <- scExpr env' e
@@ -1764,9 +1766,27 @@ BUT phantom type synonyms can mess this reasoning up,
   eg   x::T b   with  type T b = Int
 So we apply expandTypeSynonyms to the bound Ids.
 See Trac # 5458.  Yuk.
+
+Note [SpecConstr call patterns]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A "call patterns" that we collect is going to become the LHS of a RULE.
+It's important that it doesn't have
+     e |> Refl
+or
+    e |> g1 |> g2
+because both of these will be optimised by Simplify.simplRule. In the
+former case such optimisation benign, because the rule will match more
+terms; but in the latter we may lose a binding of 'g1' or 'g2', and
+end up with a rule LHS that doesn't bind the template variables (Trac
+#10602).
+
+The simplifier eliminates such things, but SpecConstr itself constructs
+new terms by substituting.  So the 'mkCast' in the Cast case of scExpr
+is very important!
 -}
 
 type CallPat = ([Var], [CoreExpr])      -- Quantified variables and arguments
+                                        -- See Note [SpecConstr call patterns]
 
 callsToPats :: ScEnv -> [OneSpec] -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat])
         -- Result has no duplicate patterns,
@@ -1886,9 +1906,6 @@ argToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ
 -}
 
 argToPat env in_scope val_env (Cast arg co) arg_occ
-  | isReflCo co     -- Substitution in the SpecConstr itself
-                    -- can lead to identity coercions
-  = argToPat env in_scope val_env arg arg_occ
   | not (ignoreType env ty2)
   = do  { (interesting, arg') <- argToPat env in_scope val_env arg arg_occ
         ; if not interesting then

testsuite/tests/simplCore/should_compile/T10602.hs

-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)

testsuite/tests/simplCore/should_compile/T10602b.hs

+{-# 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

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, [''])