Remove dead code

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

diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 500f286..96857a3 100644 (file)
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -475,9 +475,9 @@ On the other hand, it is bad not to do ANY inlining into an
 InlineRule, because then recursive knots in instance declarations
 don't get unravelled.
 
 InlineRule, because then recursive knots in instance declarations
 don't get unravelled.
 

-However, *sometimes* SimplGently must do no call-site inlining at all.
-Before full laziness we must be careful not to inline wrappers,
-because doing so inhibits floating
+However, *sometimes* SimplGently must do no call-site inlining at all
+(hence sm_inline = False).  Before full laziness we must be careful
+not to inline wrappers, because doing so inhibits floating

     e.g. ...(case f x of ...)...
     ==> ...(case (case x of I# x# -> fw x#) of ...)...
     ==> ...(case x of I# x# -> case fw x# of ...)...
     e.g. ...(case f x of ...)...
     ==> ...(case (case x of I# x# -> fw x#) of ...)...
     ==> ...(case x of I# x# -> case fw x# of ...)...

@@ -502,6 +502,9 @@ RULES are enabled when doing "gentle" simplification.  Two reasons:
     to work in Template Haskell when simplifying
     splices, so we get simpler code for literal strings
 
     to work in Template Haskell when simplifying
     splices, so we get simpler code for literal strings
 

+But watch out: list fusion can prevent floating.  So use phase control
+to switch off those rules until after floating.
+

 Note [Simplifying inside InlineRules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We must take care with simplification inside InlineRules (which come from
 Note [Simplifying inside InlineRules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We must take care with simplification inside InlineRules (which come from

@@ -1010,7 +1013,7 @@ mkLam :: SimplEnv -> [OutBndr] -> OutExpr -> SimplM OutExpr
 
 mkLam _b [] body 
   = return body
 
 mkLam _b [] body 
   = return body

-mkLam env bndrs body
+mkLam _env bndrs body

   = do { dflags <- getDOptsSmpl
        ; mkLam' dflags bndrs body }
   where
   = do { dflags <- getDOptsSmpl
        ; mkLam' dflags bndrs body }
   where

@@ -1024,6 +1027,11 @@ mkLam env bndrs body
        co_vars  = tyVarsOfType co
        bad bndr = isCoVar bndr && bndr `elemVarSet` co_vars      
 
        co_vars  = tyVarsOfType co
        bad bndr = isCoVar bndr && bndr `elemVarSet` co_vars      
 

+    mkLam' dflags bndrs body@(Lam {})
+      = mkLam' dflags (bndrs ++ bndrs1) body1
+      where
+        (bndrs1, body1) = collectBinders body
+

     mkLam' dflags bndrs body
       | dopt Opt_DoEtaReduction dflags,
         Just etad_lam <- tryEtaReduce bndrs body
     mkLam' dflags bndrs body
       | dopt Opt_DoEtaReduction dflags,
         Just etad_lam <- tryEtaReduce bndrs body

@@ -1031,9 +1039,6 @@ mkLam env bndrs body
           ; return etad_lam }
 
       | dopt Opt_DoLambdaEtaExpansion dflags,
           ; return etad_lam }
 
       | dopt Opt_DoLambdaEtaExpansion dflags,

-        not (inGentleMode env),              -- In gentle mode don't eta-expansion
-                                     -- because it can clutter up the code
-                                     -- with casts etc that may not be removed

        not (all isTyVar bndrs) -- Don't eta expand type abstractions
       = do { let body' = tryEtaExpansion dflags body
           ; return (mkLams bndrs body') }
        not (all isTyVar bndrs) -- Don't eta expand type abstractions
       = do { let body' = tryEtaExpansion dflags body
           ; return (mkLams bndrs body') }