Make seq-of-cast rule generate a case
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 21 Jul 2015 14:05:42 +0000 (15:05 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 21 Jul 2015 16:43:28 +0000 (17:43 +0100)
Previously it generated another call to seq, which triggered
a lint failure (Trac #10659)

compiler/basicTypes/MkId.hs
compiler/typecheck/TcExpr.hs
testsuite/tests/concurrent/should_run/all.T

index 1564d66..5f2cae8 100644 (file)
@@ -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
index 826d143..cc09d23 100644 (file)
@@ -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)
index 196c7c8..80734ad 100644 (file)
@@ -174,9 +174,8 @@ 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']),
-                 omit_ways(['ghci']), 
+                 normal,
+                 omit_ways(['ghci']),
                  extra_run_opts('+RTS -C0 -RTS')],
                compile_and_run, [''])