Commit 74e0bdb6 authored by simonpj's avatar simonpj

[project @ 2004-04-27 12:47:13 by simonpj]

----------------------------------------
     1. Make primOpIsCheap do something sensible
     2. Make the state hack work better
     ----------------------------------------

1.  In March 2001, we changed primOpIsCheap to
	primOpIsCheap op = False
thereby making *no* primops seem cheap.  But this killed eta
expansion on case (x ==# y) of True -> \s -> ...
which is bad.  In particular a loop like
  doLoop n = loop 0
    where
      loop i | i == n    = return ()
             | otherwise = bar i >> loop (i+1)
allocated a closure every time round because it didn't eta expand.

The problem that made us set primOpIsCheap to False was
		let x = a +# b *# c in x +# x
where we don't want to inline x. But primopIsCheap doesn't control
that (it's exprIsDupable that does) so the problem doesn't occur
even if primOpIsCheap sometimes says 'True'.  I think that perhaps
something changed since March 2001.


2.  Consider this
	case x of
	  True  -> \(s:RealWorld) -> e
	  False -> foo
where foo has arity 1.  If we are using the "state hack" we want to
eta expand here.  This commit fixes arityType in the Var case (for foo)
to take account of foo's type.

Also add -fno-state-hack to the static flags, to allow the state hack to
be switched off.
parent 8685fce5
......@@ -38,7 +38,8 @@ module Id (
-- One shot lambda stuff
isOneShotBndr, isOneShotLambda, setOneShotLambda, clearOneShotLambda,
isOneShotBndr, isOneShotLambda, isStateHackType,
setOneShotLambda, clearOneShotLambda,
-- IdInfo stuff
setIdUnfolding,
......@@ -459,15 +460,16 @@ idLBVarInfo id = lbvarInfo (idInfo id)
isOneShotBndr :: Id -> Bool
-- This one is the "business end", called externally.
-- Its main purpose is to encapsulate the Horrible State Hack
isOneShotBndr id = isOneShotLambda id || (isStateHack id)
isOneShotBndr id = isOneShotLambda id || (isStateHackType (idType id))
isStateHack id
isStateHackType :: Type -> Bool
isStateHackType ty
| opt_NoStateHack
= False
| otherwise
= case splitTyConApp_maybe (idType id) of
Just (tycon,_) | tycon == statePrimTyCon -> True
other -> False
= case splitTyConApp_maybe ty of
Just (tycon,_) -> tycon == statePrimTyCon
other -> False
-- This 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
......
......@@ -51,7 +51,7 @@ import DataCon ( DataCon, dataConRepArity, dataConArgTys,
import PrimOp ( PrimOp(..), primOpOkForSpeculation, primOpIsCheap )
import Id ( Id, idType, globalIdDetails, idNewStrictness,
mkWildId, idArity, idName, idUnfolding, idInfo,
isOneShotBndr, isDataConWorkId_maybe, mkSysLocal,
isOneShotBndr, isStateHackType, isDataConWorkId_maybe, mkSysLocal,
isDataConWorkId, isBottomingId
)
import IdInfo ( GlobalIdDetails(..), megaSeqIdInfo )
......@@ -770,15 +770,25 @@ arityType (Note n e) = arityType e
-- | otherwise = ATop
arityType (Var v)
= mk (idArity v)
= mk (idArity v) (arg_tys (idType v))
where
mk :: Arity -> ArityType
mk 0 | isBottomingId v = ABot
| otherwise = ATop
mk n = AFun False (mk (n-1))
-- When the type of the Id encodes one-shot-ness,
-- use the idinfo here
mk :: Arity -> [Type] -> ArityType
-- The argument types are only to steer the "state hack"
-- Consider case x of
-- True -> foo
-- False -> \(s:RealWorld) -> e
-- where foo has arity 1. Then we want the state hack to
-- apply to foo too, so we can eta expand the case.
mk 0 tys | isBottomingId v = ABot
| otherwise = ATop
mk n (ty:tys) = AFun (isStateHackType ty) (mk (n-1) tys)
mk n [] = AFun False (mk (n-1) [])
arg_tys :: Type -> [Type] -- Ignore for-alls
arg_tys ty
| Just (_, ty') <- splitForAllTy_maybe ty = arg_tys ty'
| Just (arg,res) <- splitFunTy_maybe ty = arg : arg_tys res
| otherwise = []
-- Lambdas; increase arity
arityType (Lam x e) | isId x = AFun (isOneShotBndr x) (arityType e)
......
......@@ -845,11 +845,11 @@ isStaticHscFlag f =
"fno-hi-version-check",
"dno-black-holing",
"fno-method-sharing",
"fno-state-hack",
"fruntime-types",
"fno-pre-inlining",
"fexcess-precision",
"funfolding-update-in-place",
"fno-prune-decls",
"static",
"funregisterised",
"fext-core",
......
......@@ -321,13 +321,28 @@ primOpIsCheap
@primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
WARNING), we just borrow some other predicates for a
what-should-be-good-enough test. "Cheap" means willing to call it more
than once. Evaluation order is unaffected.
than once, and/or push it inside a lambda. The latter could change the
behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
\begin{code}
primOpIsCheap :: PrimOp -> Bool
primOpIsCheap op = False
-- March 2001: be less eager to inline PrimOps
-- Was: not (primOpHasSideEffects op || primOpOutOfLine op)
primOpIsCheap op = primOpOkForSpeculation op
-- In March 2001, we changed this to
-- primOpIsCheap op = False
-- thereby making *no* primops seem cheap. But this killed eta
-- expansion on case (x ==# y) of True -> \s -> ...
-- which is bad. In particular a loop like
-- doLoop n = loop 0
-- where
-- loop i | i == n = return ()
-- | otherwise = bar i >> loop (i+1)
-- allocated a closure every time round because it doesn't eta expand.
--
-- The problem that originally gave rise to the change was
-- let x = a +# b *# c in x +# x
-- were we don't want to inline x. But primopIsCheap doesn't control
-- that (it's exprIsDupable that does) so the problem doesn't occur
-- even if primOpIsCheap sometimes says 'True'.
\end{code}
primOpIsDupable
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment