Commit 52276d81 authored by simonpj's avatar simonpj

[project @ 2004-04-02 13:34:42 by simonpj]

Add a flag -fno-state-hack, which switches off the "state hack".

It's 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.
parent fb30abb2
......@@ -38,7 +38,7 @@ module Id (
-- One shot lambda stuff
isOneShotLambda, setOneShotLambda, clearOneShotLambda,
isOneShotBndr, isOneShotLambda, setOneShotLambda, clearOneShotLambda,
-- IdInfo stuff
setIdUnfolding,
......@@ -89,8 +89,8 @@ import Var ( Id, DictId,
globalIdDetails
)
import qualified Var ( mkLocalId, mkGlobalId, mkSpecPragmaId, mkExportedLocalId )
import Type ( Type, typePrimRep, addFreeTyVars, seqType)
import Type ( Type, typePrimRep, addFreeTyVars, seqType, splitTyConApp_maybe )
import TysPrim ( statePrimTyCon )
import IdInfo
#ifdef OLD_STRICTNESS
......@@ -110,6 +110,7 @@ import Maybes ( orElse )
import SrcLoc ( SrcLoc )
import Outputable
import Unique ( Unique, mkBuiltinUnique )
import CmdLineOpts ( opt_NoStateHack )
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setIdUnfolding`,
......@@ -455,6 +456,38 @@ modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (
idLBVarInfo :: Id -> LBVarInfo
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)
isStateHack id
| opt_NoStateHack
= False
| otherwise
= case splitTyConApp_maybe (idType id) of
Just (tycon,_) | tycon == statePrimTyCon -> True
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
-- 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.
-- The OneShotLambda functions simply fiddle with the IdInfo flag
isOneShotLambda :: Id -> Bool
isOneShotLambda id = case idLBVarInfo id of
IsOneShotLambda -> True
......
......@@ -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,
isOneShotLambda, isDataConWorkId_maybe, mkSysLocal,
isOneShotBndr, isDataConWorkId_maybe, mkSysLocal,
isDataConWorkId, isBottomingId
)
import IdInfo ( GlobalIdDetails(..), megaSeqIdInfo )
......@@ -71,7 +71,6 @@ import Unique ( Unique )
import Outputable
import TysPrim ( alphaTy ) -- Debugging only
import Util ( equalLength, lengthAtLeast )
import TysPrim ( statePrimTyCon )
\end{code}
......@@ -715,7 +714,7 @@ IO state transformers, where we often get
and the \s is a real-world state token abstraction. Such abstractions
are almost invariably 1-shot, so we want to pull the \s out, past the
let x=E, even if E is expensive. So we treat state-token lambdas as
one-shot even if they aren't really. The hack is in Id.isOneShotLambda.
one-shot even if they aren't really. The hack is in Id.isOneShotBndr.
3. Dealing with bottom
......@@ -782,7 +781,7 @@ arityType (Var v)
-- use the idinfo here
-- Lambdas; increase arity
arityType (Lam x e) | isId x = AFun (isOneShotLambda x || isStateHack x) (arityType e)
arityType (Lam x e) | isId x = AFun (isOneShotBndr x) (arityType e)
| otherwise = arityType e
-- Applications; decrease arity
......@@ -810,28 +809,6 @@ 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
......
......@@ -65,7 +65,8 @@ module CmdLineOpts (
opt_Flatten,
-- optimisation opts
opt_NoMethodSharing,
opt_NoMethodSharing,
opt_NoStateHack,
opt_LiberateCaseThreshold,
opt_CprOff,
opt_RulesOff,
......@@ -767,6 +768,7 @@ opt_SMP = lookUp FSLIT("-fsmp")
opt_Flatten = lookUp FSLIT("-fflatten")
-- optimisation opts
opt_NoStateHack = lookUp FSLIT("-fno-state-hack")
opt_NoMethodSharing = lookUp FSLIT("-fno-method-sharing")
opt_CprOff = lookUp FSLIT("-fcpr-off")
opt_RulesOff = lookUp FSLIT("-frules-off")
......
......@@ -21,7 +21,7 @@ import CoreSyn
import CoreUtils ( exprIsValue, exprIsDupable )
import CoreLint ( showPass, endPass )
import CoreFVs ( CoreExprWithFVs, freeVars, freeVarsOf )
import Id ( isOneShotLambda )
import Id ( isOneShotBndr )
import Var ( Id, idType )
import Type ( isUnLiftedType )
import VarSet
......@@ -357,7 +357,7 @@ noFloatIntoRhs (AnnLam b _) = not (is_one_shot b)
noFloatIntoRhs rhs = exprIsValue (deAnnotate' rhs) -- We'd just float right back out again...
is_one_shot b = isId b && isOneShotLambda b
is_one_shot b = isId b && isOneShotBndr b
\end{code}
......
......@@ -20,7 +20,7 @@ module OccurAnal (
import CoreSyn
import CoreFVs ( idRuleVars )
import CoreUtils ( exprIsTrivial )
import Id ( isDataConWorkId, isOneShotLambda, setOneShotLambda,
import Id ( isDataConWorkId, isOneShotBndr, setOneShotLambda,
idOccInfo, setIdOccInfo,
isExportedId, modifyIdInfo, idInfo, idArity,
idSpecialisation, isLocalId,
......@@ -859,7 +859,7 @@ oneShotGroup (OccEnv cands encl ctxt) bndrs
= case go ctxt bndrs [] of
(new_ctxt, new_bndrs) -> (all is_one_shot new_bndrs, OccEnv cands encl new_ctxt, new_bndrs)
where
is_one_shot b = isId b && isOneShotLambda b
is_one_shot b = isId b && isOneShotBndr b
go ctxt [] rev_bndrs = (ctxt, reverse rev_bndrs)
......
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