From: simonpj@microsoft.com <unknown>
Date: Tue, 25 Jan 2011 11:04:18 +0000 (+0000)
Subject: Improve dataToTag# magic
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=5cdc2f1dcea1425ab4a842fde708cf55b17333c5

Improve dataToTag# magic

dataToTag# is a bit unsatisfactory because it requires
its argument to be evaluated, and we don't have a good
way to enforce that. This patch adds some comments, and
makes exprOkForSpeculation a bit less picky in the case
of dataToTag# (since the argument may, in fact, not be
eval'd).
---

diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 2cfd880..540fa2d 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -637,9 +637,7 @@ maybeSaturate fn expr n_args
 
 -------------
 saturateDataToTag :: CpeApp -> UniqSM CpeApp
--- Horrid: ensure that the arg of data2TagOp is evaluated
---   (data2tag x) -->  (case x of y -> data2tag y)
--- (yuk yuk) take into account the lambdas we've now introduced
+-- See Note [dataToTag magic]
 saturateDataToTag sat_expr
   = do { let (eta_bndrs, eta_body) = collectBinders sat_expr
        ; eta_body' <- eval_data2tag_arg eta_body
@@ -663,7 +661,14 @@ saturateDataToTag sat_expr
 	= pprPanic "eval_data2tag" (ppr other)
 \end{code}
 
+Note [dataToTag magic]
+~~~~~~~~~~~~~~~~~~~~~~
+Horrid: we must ensure that the arg of data2TagOp is evaluated
+  (data2tag x) -->  (case x of y -> data2tag y)
+(yuk yuk) take into account the lambdas we've now introduced
 
+How might it not be evaluated?  Well, we might have floated it out
+of the scope of a `seq`, or dropped the `seq` altogether.
 
 
 %************************************************************************
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 2cf8885..d74c278 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -687,6 +687,9 @@ exprOkForSpeculation other_expr
 		-- Often there is a literal divisor, and this 
 		-- can get rid of a thunk in an inner looop
 
+      | DataToTagOp <- op      -- See Note [dataToTag speculation]
+      = True
+
       | otherwise
       = primOpOkForSpeculation op && 
 	all exprOkForSpeculation args
@@ -742,6 +745,27 @@ If exprOkForSpeculation doesn't look through case expressions, you get this:
 
 The inner case is redundant, and should be nuked.
 
+Note [dataToTag speculation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Is this OK?
+   f x = let v::Int# = dataToTag# x
+         in ...
+We say "yes", even though 'x' may not be evaluated.  Reasons
+
+  * dataToTag#'s strictness means that its argument often will be
+    evaluated, but FloatOut makes that temporarily untrue
+         case x of y -> let v = dataToTag# y in ...
+    -->
+         case x of y -> let v = dataToTag# x in ...
+    Note that we look at 'x' instead of 'y' (this is to improve
+    floating in FloatOut).  So Lint complains.    
+ 
+    Moreover, it really *might* improve floating to let the
+    v-binding float out
+         
+  * CorePrep makes sure dataToTag#'s argument is evaluated, just
+    before code gen.  Until then, it's not guaranteed
+
 
 %************************************************************************
 %*									*