[commit: ghc] wip/nested-cpr: Some primitive operations are converging (9809d5a)

[git at git.haskell.org]

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

On branch  : wip/nested-cpr
Link       : http://ghc.haskell.org/trac/ghc/changeset/9809d5a2cd2a28a5d9a93ab7c361cacce47b83d8/ghc

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

commit 9809d5a2cd2a28a5d9a93ab7c361cacce47b83d8
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Jan 10 13:42:21 2014 +0000

    Some primitive operations are converging


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

9809d5a2cd2a28a5d9a93ab7c361cacce47b83d8
 compiler/prelude/PrimOp.lhs     |    4 +++-
 compiler/prelude/primops.txt.pp |    1 +
 2 files changed, 4 insertions(+), 1 deletion(-)

diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs
index 12f71c2..2ee7da4 100644
--- a/compiler/prelude/PrimOp.lhs
+++ b/compiler/prelude/PrimOp.lhs
@@ -516,8 +516,10 @@ primOpOcc op = case primOpInfo op of
 
 primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)
 primOpSig op
-  = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
+  = (tyvars, arg_tys, res_ty, arity, strict_sig)
   where
+    strict_sig | primOpOkForSpeculation op = convergeSig $ primOpStrictness op arity
+               | otherwise                 =               primOpStrictness op arity
     arity = length arg_tys
     (tyvars, arg_tys, res_ty)
       = case (primOpInfo op) of
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 36eec67..f020ae8 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -61,6 +61,7 @@ defaults
    can_fail         = False   -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp
    commutable       = False
    code_size        = { primOpCodeSizeDefault }
+   -- Strictness is turned to terminating in PrimOp.primOpSig, if allowed
    strictness       = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes }
    fixity           = Nothing
    llvm_only        = False