From 4539cb1bc16136ac60bbb0cac712fc9a6fe99c48 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Mon, 5 Feb 2007 17:35:44 +0000
Subject: [PATCH] Float casts out of lambdas

See Note [Casts and lambdas] in SimplUtils.  I found this transformation
when staring at some cast-heavy code generated by
Language.Haskell.Lexer.hs in the haskell-src library.

The basic transformation is this:
	(\x. e `cast` g1)  -->  (\x.e) `cast` (tx -> g1)
where x:tx.
---
 compiler/simplCore/SimplUtils.lhs |   23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 6ab117f..acd0830 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -804,6 +804,14 @@ mkLam bndrs body
   = do	{ dflags <- getDOptsSmpl
 	; mkLam' dflags bndrs body }
   where
+    mkLam' :: DynFlags -> [OutBndr] -> OutExpr -> SimplM OutExpr
+    mkLam' dflags bndrs (Cast body@(Lam _ _) co)
+	-- Note [Casts and lambdas]
+      = do { lam <- mkLam' dflags (bndrs ++ bndrs') body'
+	   ; return (mkCoerce (mkPiTypes bndrs co) lam) }
+      where	
+	(bndrs',body') = collectBinders body
+
     mkLam' dflags bndrs body
       | dopt Opt_DoEtaReduction dflags,
         Just etad_lam <- tryEtaReduce bndrs body
@@ -819,6 +827,21 @@ mkLam bndrs body
       = returnSmpl (mkLams bndrs body)
 \end{code}
 
+Note [Casts and lambdas]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Consider 
+	(\x. (\y. e) `cast` g1) `cast` g2
+There is a danger here that the two lambdas look separated, and the 
+full laziness pass might float an expression to between the two.
+
+So this equation in mkLam' floats the g1 out, thus:
+	(\x. e `cast` g1)  -->  (\x.e) `cast` (tx -> g1)
+where x:tx.
+
+In general, this floats casts outside lambdas, where (I hope) they might meet
+and cancel with some other cast.
+
+
 --	c) floating lets out through big lambdas 
 --		[only if all tyvar lambdas, and only if this lambda
 --		 is the RHS of a let]
-- 
1.7.10.4