[commit: ghc] master: Make seq-of-cast rule generate a case (00f3187)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/00f3187a615813b5dbc870f0477124c9cf76c9f2/ghc

>---------------------------------------------------------------

commit 00f3187a615813b5dbc870f0477124c9cf76c9f2
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Jul 21 15:05:42 2015 +0100

    Make seq-of-cast rule generate a case
    
    Previously it generated another call to seq, which triggered
    a lint failure (Trac #10659)


>---------------------------------------------------------------

00f3187a615813b5dbc870f0477124c9cf76c9f2
 compiler/basicTypes/MkId.hs                 | 21 ++++++++++++++-------
 compiler/typecheck/TcExpr.hs                | 18 ++++++++----------
 testsuite/tests/concurrent/should_run/all.T |  3 +--
 3 files changed, 23 insertions(+), 19 deletions(-)

diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 1564d66..5f2cae8 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 826d143..cc09d23 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)
diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
index 196c7c8..80734ad 100644
--- a/testsuite/tests/concurrent/should_run/all.T
+++ b/testsuite/tests/concurrent/should_run/all.T
@@ -174,8 +174,7 @@ test('conc033', normal, compile_and_run, [''])
 
 # Omit for GHCi, because it just sits there waiting for you to press ^C
 test('conc034', [
-                 expect_broken_for(10659,
-                                   ['optasm', 'threaded2', 'dyn', 'optllvm']),
+                 normal,
                  omit_ways(['ghci']),
                  extra_run_opts('+RTS -C0 -RTS')],
 		compile_and_run, [''])