diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2012-08-02 11:53:58 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2012-08-02 11:57:30 +0100 |
| commit | 4200c4a4f01e9bd515aad8c47aac4a92851a62c8 (patch) | |
| tree | 0fa6f8f7bfc3ffb2eb9e7877cd0e1c03a76c780a | |
| parent | 15e4f93b661fe83cff96c8c295e7ea8985aa08aa (diff) | |
| download | haskell-4200c4a4f01e9bd515aad8c47aac4a92851a62c8.tar.gz | |
FloutOut.wrapTick: don't forget to tick the args of a constructor app
Thanks to Peter Wortmann for pointing out this bug.
| -rw-r--r-- | compiler/coreSyn/CoreUtils.lhs | 2 | ||||
| -rw-r--r-- | 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 7815aac3c9..12a3fb3491 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 93397d84b9..ac62f417c7 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 |