Make seq-of-cast rule generate a case

Previously it generated another call to seq, which triggered
a lint failure (Trac #10659)

2 files changed, 22 insertions, 17 deletions

diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 1564d6622e..5f2cae88d0 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -1086,7 +1086,6 @@ seqId = pcMiscPrelId seqName ty info
 
     ty  = mkForAllTys [alphaTyVar,betaTyVar]
                       (mkFunTy alphaTy (mkFunTy betaTy betaTy))
-              -- NB argBetaTyVar; see Note [seqId magic]
 
     [x,y] = mkTemplateLocals [alphaTy, betaTy]
     rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])
@@ -1102,8 +1101,15 @@ seqId = pcMiscPrelId seqName ty info
 match_seq_of_cast :: RuleFun
     -- See Note [Built-in RULES for seq]
 match_seq_of_cast _ _ _ [Type _, Type res_ty, Cast scrut co]
-  = Just (Var seqId `mkApps` [Type (pFst (coercionKind co)), Type res_ty,
-                              scrut])
+  = Just (fun `App` scrut)
+  where
+    fun      = Lam x $ Lam y $
+               Case (Var x) x res_ty [(DEFAULT,[],Var y)]
+               -- Generate a Case directly, not a call to seq, which
+               -- might be ill-kinded if res_ty is unboxed
+    [x,y]    = mkTemplateLocals [scrut_ty, res_ty]
+    scrut_ty = pFst (coercionKind co)
+
 match_seq_of_cast _ _ _ _ = Nothing
 
 ------------------------------------------------
@@ -1184,9 +1190,12 @@ Note [seqId magic]
 ~~~~~~~~~~~~~~~~~~
 'GHC.Prim.seq' is special in several ways.
 
-a) Its second arg can have an unboxed type
+a) In source Haskell its second arg can have an unboxed type
       x `seq` (v +# w)
-   Hence its second type variable has ArgKind
+   But see Note [Typing rule for seq] in TcExpr, which
+   explains why we give seq itself an ordinary type
+         seq :: forall a b. a -> b -> b
+   and treat it as a language construct from a typing point of view.
 
 b) Its fixity is set in LoadIface.ghcPrimIface
 
@@ -1195,8 +1204,6 @@ c) It has quite a bit of desugaring magic.
 
 d) There is some special rule handing: Note [User-defined RULES for seq]
 
-e) See Note [Typing rule for seq] in TcExpr.
-
 Note [User-defined RULES for seq]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Roman found situations where he had
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 826d1432a7..cc09d23554 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -282,18 +282,15 @@ Note [Typing rule for seq]
 We want to allow
        x `seq` (# p,q #)
 which suggests this type for seq:
-   seq :: forall (a:*) (b:??). a -> b -> b,
-with (b:??) meaning that be can be instantiated with an unboxed tuple.
-But that's ill-kinded!  Function arguments can't be unboxed tuples.
-And indeed, you could not expect to do this with a partially-applied
-'seq'; it's only going to work when it's fully applied.  so it turns
-into
+   seq :: forall (a:*) (b:Open). a -> b -> b,
+with (b:Open) meaning that be can be instantiated with an unboxed
+tuple.  The trouble is that this might accept a partially-applied
+'seq', and I'm just not certain that would work.  I'm only sure it's
+only going to work when it's fully applied, so it turns into
     case x of _ -> (# p,q #)
 
-For a while I slid by by giving 'seq' an ill-kinded type, but then
-the simplifier eta-reduced an application of seq and Lint blew up
-with a kind error.  It seems more uniform to treat 'seq' as it it
-was a language construct.
+So it seems more uniform to treat 'seq' as it it was a language
+construct.
 
 See Note [seqId magic] in MkId, and
 -}
@@ -1183,6 +1180,7 @@ tcSeq :: SrcSpan -> Name -> LHsExpr Name -> LHsExpr Name
       -> TcRhoType -> TcM (HsExpr TcId)
 -- (seq e1 e2) :: res_ty
 -- We need a special typing rule because res_ty can be unboxed
+-- See Note [Typing rule for seq]
 tcSeq loc fun_name arg1 arg2 res_ty
   = do  { fun <- tcLookupId fun_name
         ; (arg1', arg1_ty) <- tcInfer (tcMonoExpr arg1)