[project @ 2000-05-25 12:41:14 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / SimplUtils.lhs

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index fd5f21e..34ee7d6 100644 (file)
--- 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