From 4a851c8281491a26ce130e6ce4496042e3feb42b Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 29 Aug 2002 13:38:45 +0000
Subject: [PATCH] [project @ 2002-08-29 13:38:45 by simonpj] Fix eta-expansion
 bug, which led to an infinite loop in CoreUtils.etaExpand.
 This showed up when compiling FranTk.

		MERGE TO STABLE
---
 ghc/compiler/coreSyn/CoreUtils.lhs |   37 +++++++++++++++++++++++++-----------
 1 file changed, 26 insertions(+), 11 deletions(-)

diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index 8a45975..b8ccb05 100644
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -803,6 +803,11 @@ etaExpand :: Arity	  	-- Result should have this number of value args
 -- Given e' = etaExpand n us e ty
 -- We should have
 --	ty = exprType e = exprType e'
+--
+-- Note that SCCs are not treated specially.  If we have
+--	etaExpand 2 (\x -> scc "foo" e)
+--	= (\xy -> (scc "foo" e) y)
+-- So the costs of evaluating 'e' (not 'e y') are attributed to "foo"
 
 etaExpand n us expr ty
   | manifestArity expr >= n = expr		-- The no-op case
@@ -830,23 +835,13 @@ eta_expand n us expr ty
     -- The ILX code generator requires eta expansion for type arguments
     -- too, but alas the 'n' doesn't tell us how many of them there 
     -- may be.  So we eagerly eta expand any big lambdas, and just
-    -- cross our fingers about possible loss of sharing in the
-    -- ILX case. 
+    -- cross our fingers about possible loss of sharing in the ILX case. 
     -- The Right Thing is probably to make 'arity' include
     -- type variables throughout the compiler.  (ToDo.)
     not (isForAllTy ty)	
     -- Saturated, so nothing to do
   = expr
 
-eta_expand n us (Note note@(Coerce _ ty) e) _
-  = Note note (eta_expand n us e ty)
-
-	-- Use mkNote so that _scc_s get pushed inside any lambdas that
-	-- are generated as part of the eta expansion.  We rely on this
-	-- behaviour in CorePrep, when we eta expand an already-prepped RHS.
-eta_expand n us (Note note e) ty
-  = mkNote note (eta_expand n us e ty)
-
 	-- Short cut for the case where there already
 	-- is a lambda; no point in gratuitously adding more
 eta_expand n us (Lam v body) ty
@@ -856,6 +851,19 @@ eta_expand n us (Lam v body) ty
   | otherwise
   = Lam v (eta_expand (n-1) us body (funResultTy ty))
 
+-- We used to have a special case that stepped inside Coerces here,
+-- thus:  eta_expand n us (Note note@(Coerce _ ty) e) _  
+--		= Note note (eta_expand n us e ty)
+-- BUT this led to an infinite loop
+-- Example: 	newtype T = MkT (Int -> Int)
+--	eta_expand 1 (coerce (Int->Int) e)
+--	--> coerce (Int->Int) (eta_expand 1 T e)
+--		by the bogus eqn
+--	--> coerce (Int->Int) (coerce T 
+--		(\x::Int -> eta_expand 1 (coerce (Int->Int) e)))
+--		by the splitNewType_maybe case below
+--	and round we go
+
 eta_expand n us expr ty
   = case splitForAllTy_maybe ty of { 
  	  Just (tv,ty') -> Lam tv (eta_expand n us (App expr (Type (mkTyVarTy tv))) ty')
@@ -870,6 +878,13 @@ eta_expand n us expr ty
 				   
 	; Nothing ->
 
+		-- Given this:
+		-- 	newtype T = MkT (Int -> Int)
+		-- Consider eta-expanding this
+		--  	eta_expand 1 e T
+		-- We want to get
+		--	coerce T (\x::Int -> (coerce (Int->Int) e) x)
+
     	case splitNewType_maybe ty of {
  	  Just ty' -> mkCoerce2 ty ty' (eta_expand n us (mkCoerce2 ty' ty expr) ty') ;
  	  Nothing  -> pprTrace "Bad eta expand" (ppr expr $$ ppr ty) expr
-- 
1.7.10.4