[commit: ghc] master: FloutOut.wrapTick: don't forget to tick the args of a constructor app (4200c4a)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/4200c4a4f01e9bd515aad8c47aac4a92851a62c8

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

commit 4200c4a4f01e9bd515aad8c47aac4a92851a62c8
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Aug 2 11:53:58 2012 +0100

    FloutOut.wrapTick: don't forget to tick the args of a constructor app
    
    Thanks to Peter Wortmann for pointing out this bug.

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

 compiler/coreSyn/CoreUtils.lhs  |    2 +-
 compiler/simplCore/FloatOut.lhs |    2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 7815aac..12a3fb3 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -10,7 +10,7 @@ Utility functions on @Core@ syntax
 module CoreUtils (
         -- * Constructing expressions
         mkCast,
-        mkTick, mkTickNoHNF,
+        mkTick, mkTickNoHNF, tickHNFArgs,
         bindNonRec, needsCaseBinding,
         mkAltExpr,
 
diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs
index 93397d8..ac62f41 100644
--- a/compiler/simplCore/FloatOut.lhs
+++ b/compiler/simplCore/FloatOut.lhs
@@ -562,7 +562,7 @@ wrapTick t (FB tops defns)
     wrap_one (FloatLet bind)      = FloatLet (wrap_bind bind)
     wrap_one (FloatCase e b c bs) = FloatCase (maybe_tick e) b c bs
 
-    maybe_tick e | exprIsHNF e = e
+    maybe_tick e | exprIsHNF e = tickHNFArgs t e
                  | otherwise   = mkTick t e
       -- we don't need to wrap a tick around an HNF when we float it
       -- outside a tick: that is an invariant of the tick semantics