[project @ 2001-10-22 13:50:17 by simonpj]

Make SimplGently a bit less gentle

diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs
index 2b0d527..16e8499 100644 (file)
--- a/ghc/compiler/simplCore/SimplMonad.lhs
+++ b/ghc/compiler/simplCore/SimplMonad.lhs
@@ -856,16 +856,27 @@ because they don't have bindings, so we must inline them no matter how
 gentle we are being.
 
 \begin{code}
-activeInline :: SimplEnv -> OutId -> Bool
-activeInline env id
+activeInline :: SimplEnv -> OutId -> OccInfo -> Bool
+activeInline env id occ
   = case getMode env of
-       SimplGently -> isDataConWrapId id
+       SimplGently -> isDataConWrapId id || isOneOcc occ
                -- No inlining at all when doing gentle stuff,
-               -- except (hack alert) for data con wrappers
-               -- We want to inline data con wrappers even in gentle mode
-               -- because rule LHSs match better then
+               -- except (a) things that occur once
+               -- and (b) (hack alert) data con wrappers
+               --         We want to inline data con wrappers even 
+               --         in gentle mode because rule LHSs match better then
+-- The reason for (a) is that too little clean-up happens if you 
+-- don't inline use-once things.   Also a bit of inlining is *good* for
+-- full laziness; it can expose constant sub-expressions.
+-- Example in spectral/mandel/Mandel.hs, where the mandelset 
+-- function gets a useful let-float if you inline windowToViewport
+
        SimplPhase n -> isActive n (idInlinePragma id)
 
+-- Belongs in BasicTypes; this frag occurs in OccurAnal too
+isOneOcc (OneOcc _ _) = True
+isOneOcc other       = False
+
 activeRule :: SimplEnv -> Maybe (Activation -> Bool)
 -- Nothing => No rules at all
 activeRule env

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 88e6348..fce552a 100644 (file)
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -911,7 +911,7 @@ completeCall env var occ_info cont
                                                  (not (null arg_infos))
                                                  call_cont
 
-       active_inline = activeInline env var
+       active_inline = activeInline env var occ_info
        maybe_inline  = callSiteInline dflags active_inline inline_call occ_info
                                       var arg_infos interesting_cont
     in