X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplUtils.lhs;h=34ee7d61151f4b5431acab7390848242dfc34401;hb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;hp=fd5f21e5cc50fbea0ec615e0478eadd25029d375;hpb=f5262d4457cabda7112af850d4659366a7ce34a1;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index fd5f21e..34ee7d6 100644
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -35,8 +35,9 @@ import Maybes		( maybeToBool, catMaybes )
 import Name		( isLocalName, setNameUnique )
 import SimplMonad
 import Type		( Type, tyVarsOfType, tyVarsOfTypes, mkForAllTys, seqType, repType,
-			  splitTyConApp_maybe, splitAlgTyConApp_maybe, mkTyVarTys, applyTys, splitFunTys, mkFunTys
+			  splitTyConApp_maybe, mkTyVarTys, applyTys, splitFunTys, mkFunTys
 			)
+import TyCon		( tyConDataConsIfAvailable )
 import PprType		( {- instance Outputable Type -} )
 import DataCon		( dataConRepArity )
 import TysPrim		( statePrimTyCon )
@@ -288,11 +289,16 @@ discardInline cont		   = cont
 
 -- Note the repType: we want to look through newtypes for this purpose
 
-canUpdateInPlace ty = case splitAlgTyConApp_maybe (repType ty) of
-			Just (_, _, [dc]) -> arity == 1 || arity == 2
-					  where
-					     arity = dataConRepArity dc
+canUpdateInPlace ty = case splitTyConApp_maybe (repType ty) of {
+			Nothing		-> False ;
+			Just (tycon, _) -> 
+
+		      case tyConDataConsIfAvailable tycon of
+			[dc]  -> arity == 1 || arity == 2
+			      where
+				 arity = dataConRepArity dc
 			other -> False
+		      }
 \end{code}
 
 
@@ -567,7 +573,7 @@ tryEtaExpansion rhs
   = returnSmpl rhs
 
   | otherwise	-- Consider eta expansion
-  = newIds y_tys						$ ( \ y_bndrs ->
+  = newIds SLIT("y") y_tys					$ ( \ y_bndrs ->
     tick (EtaExpansion (head y_bndrs))				`thenSmpl_`
     mapAndUnzipSmpl bind_z_arg (args `zip` trivial_args)	`thenSmpl` (\ (maybe_z_binds, z_args) ->
     returnSmpl (mkLams x_bndrs				$ 
@@ -582,7 +588,7 @@ tryEtaExpansion rhs
 
     bind_z_arg (arg, trivial_arg) 
 	| trivial_arg = returnSmpl (Nothing, arg)
-        | otherwise   = newId (exprType arg)	$ \ z ->
+        | otherwise   = newId SLIT("z") (exprType arg)	$ \ z ->
 			returnSmpl (Just (NonRec z arg), Var z)
 
 	-- Note: I used to try to avoid the exprType call by using