[project @ 2000-04-17 13:28:17 by sewardj]

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

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 22d1357..fd5f21e 100644 (file)
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -21,21 +21,23 @@ module SimplUtils (
 import BinderInfo
 import CmdLineOpts     ( opt_SimplDoLambdaEtaExpansion, opt_SimplCaseMerge )
 import CoreSyn
+import PprCore         ( {- instance Outputable Expr -} )
 import CoreUnfold      ( isValueUnfolding )
 import CoreFVs         ( exprFreeVars )
 import CoreUtils       ( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, exprEtaExpandArity, bindNonRec )
 import Subst           ( InScopeSet, mkSubst, substBndrs, substBndr, substIds, lookupIdSubst )
 import Id              ( Id, idType, isId, idName, 
                          idOccInfo, idUnfolding,
-                         idDemandInfo, mkId, idInfo
+                         mkId, idInfo
                        )
 import IdInfo          ( arityLowerBound, setOccInfo, vanillaIdInfo )
 import Maybes          ( maybeToBool, catMaybes )
 import Name            ( isLocalName, setNameUnique )
 import SimplMonad
-import Type            ( Type, tyVarsOfType, tyVarsOfTypes, mkForAllTys, seqType,
+import Type            ( Type, tyVarsOfType, tyVarsOfTypes, mkForAllTys, seqType, repType,
                          splitTyConApp_maybe, splitAlgTyConApp_maybe, mkTyVarTys, applyTys, splitFunTys, mkFunTys
                        )
+import PprType         ( {- instance Outputable Type -} )
 import DataCon         ( dataConRepArity )
 import TysPrim         ( statePrimTyCon )
 import Var             ( setVarUnique )
@@ -284,7 +286,9 @@ discardInline cont             = cont
 -- small arity.  But arity zero isn't good -- we share the single copy
 -- for that case, so no point in sharing.
 
-canUpdateInPlace ty = case splitAlgTyConApp_maybe ty of
+-- 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