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

[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/95ec011ea0eac060efe826d7ef35f584aa03704b/ghc

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

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

    Some primitive operations are converging


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

95ec011ea0eac060efe826d7ef35f584aa03704b
 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 d2978dc..0aad841 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