From 70a2631a1b9e233d94ac82d4fb5a904de3745df1 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 18 Aug 2005 10:25:47 +0000
Subject: [PATCH] [project @ 2005-08-18 10:25:46 by simonpj] 1. Remove
 redundant coerces.  Something that started life as 
 coerce a b <expr>    might change to 	coerct Int Int
 <expr>    after the types a,b are instantiated.

2. Get rid of the "bad eta expand" message. It can happen entirely legitimately.
   See comments in CoreUtils with eta_expand.

	MERGE TO STABLE
---
 ghc/compiler/coreSyn/CoreUtils.lhs  |   35 ++++++++++++++++++++++++++++++++---
 ghc/compiler/simplCore/Simplify.lhs |   14 +++++++++-----
 2 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index a8c7eae..8aba9b1 100644
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -46,7 +46,10 @@ import Var		( Var )
 import VarSet		( unionVarSet )
 import VarEnv
 import Name		( hashName )
-import Packages		( isDllName, HomeModules )
+import Packages		( HomeModules )
+#if mingw32_TARGET_OS
+import Packages		( isDllName )
+#endif
 import Literal		( hashLiteral, literalType, litIsDupable, 
 			  litIsTrivial, isZeroLit, Literal( MachLabel ) )
 import DataCon		( DataCon, dataConRepArity, dataConArgTys,
@@ -66,7 +69,6 @@ import Type		( Type, mkFunTy, mkForAllTy, splitFunTy_maybe,
 			  splitTyConApp_maybe, coreEqType, funResultTy, applyTy
 			)
 import TyCon		( tyConArity )
--- gaw 2004
 import TysWiredIn	( boolTy, trueDataCon, falseDataCon )
 import CostCentre	( CostCentre )
 import BasicTypes	( Arity )
@@ -754,6 +756,27 @@ consider
 This should diverge!  But if we eta-expand, it won't.   Again, we ignore this
 "problem", because being scrupulous would lose an important transformation for
 many programs.
+
+
+4. Newtypes
+
+Non-recursive newtypes are transparent, and should not get in the way.
+We do (currently) eta-expand recursive newtypes too.  So if we have, say
+
+	newtype T = MkT ([T] -> Int)
+
+Suppose we have
+	e = coerce T f
+where f has arity 1.  Then: etaExpandArity e = 1; 
+that is, etaExpandArity looks through the coerce.
+
+When we eta-expand e to arity 1: eta_expand 1 e T
+we want to get: 		 coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
+
+HOWEVER, note that if you use coerce bogusly you can ge
+	coerce Int negate
+And since negate has arity 2, you might try to eta expand.  But you can't
+decopose Int to a function type.   Hence the final case in eta_expand.
 -}
 
 
@@ -946,7 +969,13 @@ eta_expand n us expr ty
 
     	case splitRecNewType_maybe ty of {
  	  Just ty' -> mkCoerce2 ty ty' (eta_expand n us (mkCoerce2 ty' ty expr) ty') ;
- 	  Nothing  -> pprTrace "Bad eta expand" (ppr n $$ ppr expr $$ ppr ty) expr
+ 	  Nothing  -> 
+
+	-- We have an expression of arity > 0, but its type isn't a function
+	-- This *can* legitmately happen: e.g. 	coerce Int (\x. x)
+	-- Essentially the programmer is playing fast and loose with types
+	-- (Happy does this a lot).  So we simply decline to eta-expand.
+	expr
     	}}}
 \end{code}
 
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 610882d..d432024 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -40,7 +40,7 @@ import DataCon		( dataConTyCon, dataConRepStrictness, isVanillaDataCon )
 import TyCon		( tyConArity )
 import CoreSyn
 import PprCore		( pprParendExpr, pprCoreExpr )
-import CoreUnfold	( mkOtherCon, mkUnfolding, evaldUnfolding, callSiteInline )
+import CoreUnfold	( mkUnfolding, callSiteInline )
 import CoreUtils	( exprIsDupable, exprIsTrivial, needsCaseBinding,
 			  exprIsConApp_maybe, mkPiTypes, findAlt, 
 			  exprType, exprIsHNF, 
@@ -60,7 +60,6 @@ import BasicTypes	( TopLevelFlag(..), isTopLevel,
 			  RecFlag(..), isNonRec
 			)
 import OrdList
-import Maybe		( Maybe )
 import Maybes		( orElse )
 import Outputable
 import Util             ( notNull )
@@ -844,6 +843,11 @@ mkLamBndrZapper fun n_args
 \begin{code}
 simplNote env (Coerce to from) body cont
   = let
+	addCoerce s1 k1 cont 	-- Drop redundant coerces.  This can happen if a polymoprhic
+				-- (coerce a b e) is instantiated with a=ty1 b=ty2 and the
+				-- two are the same. This happens a lot in Happy-generated parsers
+	  | s1 `coreEqType` k1 = cont
+
 	addCoerce s1 k1 (CoerceIt t1 cont)
 		-- 	coerce T1 S1 (coerce S1 K1 e)
 		-- ==>
@@ -854,9 +858,9 @@ simplNote env (Coerce to from) body cont
 		-- we may find 	(coerce T (coerce S (\x.e))) y
 		-- and we'd like it to simplify to e[y/x] in one round 
 		-- of simplification
-	  | t1 `coreEqType` k1  = cont	 	-- The coerces cancel out
-	  | otherwise       = CoerceIt t1 cont	-- They don't cancel, but 
-						-- the inner one is redundant
+	  | t1 `coreEqType` k1  = cont		 	-- The coerces cancel out
+	  | otherwise           = CoerceIt t1 cont	-- They don't cancel, but 
+							-- the inner one is redundant
 
 	addCoerce t1t2 s1s2 (ApplyTo dup arg arg_se cont)
 	  | not (isTypeArg arg),	-- This whole case only works for value args
-- 
1.7.10.4