[project @ 2002-11-19 14:16:43 by simonmar]

- Fix a bug in eta-expansion of an application; it probably never bit
  us in practice.

- Change the behaviour of State#-lambdas: previously a State# lambda
  was considered to be one-shot for the purposes of inlining and
  eta-expansion.  Both can lead to unbounded extra work, but inlining
  is more likely to kill us, and eta-expansion is the case we mostly
  care about (getting the State# lambda to the outside of the function
  is often very important).  So now we only consider a State# lambda to be
  one-shot in eta expansion, not for inlining.

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 2ef248a..0f3f1c3 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -104,7 +104,6 @@ import Name         ( Name, OccName,
                        ) 
 import OccName         ( EncodedFS, mkWorkerOcc )
 import PrimRep         ( PrimRep )
-import TysPrim         ( statePrimTyCon )
 import FieldLabel      ( FieldLabel )
 import Maybes          ( orElse )
 import SrcLoc          ( SrcLoc )
@@ -464,31 +463,10 @@ idLBVarInfo :: Id -> LBVarInfo
 idLBVarInfo id = lbvarInfo (idInfo id)
 
 isOneShotLambda :: Id -> Bool
-isOneShotLambda id = analysis || hack
+isOneShotLambda id = analysis
   where analysis = case idLBVarInfo id of
                      LBVarInfo u    | u `eqUsage` usOnce      -> True
                      other                                    -> False
-        hack     = case splitTyConApp_maybe (idType id) of
-                     Just (tycon,_) | tycon == statePrimTyCon -> True
-                     other                                    -> False
-
-       -- The last clause is a gross hack.  It claims that 
-       -- every function over realWorldStatePrimTy is a one-shot
-       -- function.  This is pretty true in practice, and makes a big
-       -- difference.  For example, consider
-       --      a `thenST` \ r -> ...E...
-       -- The early full laziness pass, if it doesn't know that r is one-shot
-       -- will pull out E (let's say it doesn't mention r) to give
-       --      let lvl = E in a `thenST` \ r -> ...lvl...
-       -- When `thenST` gets inlined, we end up with
-       --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
-       -- and we don't re-inline E.
-       --
-       -- It would be better to spot that r was one-shot to start with, but
-       -- I don't want to rely on that.
-       --
-       -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
-       -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 
 setOneShotLambda :: Id -> Id
 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id

diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index c5db883..03258d9 100644 (file)
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -69,6 +69,7 @@ import Unique         ( Unique )
 import Outputable
 import TysPrim         ( alphaTy )     -- Debugging only
 import Util             ( equalLength, lengthAtLeast )
+import TysPrim         ( statePrimTyCon )
 \end{code}
 
 
@@ -752,14 +753,13 @@ arityType (Var v)
                        -- use the idinfo here
 
        -- Lambdas; increase arity
-arityType (Lam x e) | isId x    = AFun (isOneShotLambda x) (arityType e)
+arityType (Lam x e) | isId x    = AFun (isOneShotLambda x || isStateHack x) (arityType e)
                    | otherwise = arityType e
 
        -- Applications; decrease arity
 arityType (App f (Type _)) = arityType f
 arityType (App f a)       = case arityType f of
-                               AFun one_shot xs | one_shot      -> xs
-                                                | exprIsCheap a -> xs
+                               AFun one_shot xs | exprIsCheap a -> xs
                                other                            -> ATop
                                                           
        -- Case/Let; keep arity if either the expression is cheap
@@ -776,6 +776,28 @@ arityType (Let b e) = case arityType e of
 
 arityType other = ATop
 
+isStateHack id = case splitTyConApp_maybe (idType id) of
+                     Just (tycon,_) | tycon == statePrimTyCon -> True
+                     other                                    -> False
+
+       -- The last clause is a gross hack.  It claims that 
+       -- every function over realWorldStatePrimTy is a one-shot
+       -- function.  This is pretty true in practice, and makes a big
+       -- difference.  For example, consider
+       --      a `thenST` \ r -> ...E...
+       -- The early full laziness pass, if it doesn't know that r is one-shot
+       -- will pull out E (let's say it doesn't mention r) to give
+       --      let lvl = E in a `thenST` \ r -> ...lvl...
+       -- When `thenST` gets inlined, we end up with
+       --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
+       -- and we don't re-inline E.
+       --
+       -- It would be better to spot that r was one-shot to start with, but
+       -- I don't want to rely on that.
+       --
+       -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
+       -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
+
 {- NOT NEEDED ANY MORE: etaExpand is cleverer
 ok_note InlineMe = False
 ok_note other    = True