Commit c77080dd authored by simonpj's avatar simonpj
Browse files

[project @ 2000-09-07 11:42:49 by simonpj]

1) Fix a bad bug in Subst.lhs that made uniqAway go into an
   infinite loop when the 'hash code' in the in-scope set was
   zero.

2) Rename BasicTypes.isFragileOccInfo to isFragileOcc
   Add isDeadOcc to BasisTypes


(2) is just a tidy-up.  I have to commit it now because of (1), which
is a bad bug.  I hope that I've committed all the files involved in (2).
parent 02086d37
......@@ -31,7 +31,7 @@ module BasicTypes(
Boxity(..), isBoxed, tupleParens,
OccInfo(..), seqOccInfo, isFragileOccInfo, isLoopBreaker,
OccInfo(..), seqOccInfo, isFragileOcc, isDeadOcc, isLoopBreaker,
InsideLam, insideLam, notInsideLam,
OneBranch, oneBranch, notOneBranch
......@@ -242,9 +242,13 @@ isLoopBreaker :: OccInfo -> Bool
isLoopBreaker IAmALoopBreaker = True
isLoopBreaker other = False
isFragileOccInfo :: OccInfo -> Bool
isFragileOccInfo (OneOcc _ _) = True
isFragileOccInfo other = False
isDeadOcc :: OccInfo -> Bool
isDeadOcc IAmDead = True
isDeadOcc other = False
isFragileOcc :: OccInfo -> Bool
isFragileOcc (OneOcc _ _) = True
isFragileOcc other = False
\end{code}
\begin{code}
......
......@@ -48,7 +48,7 @@ module IdInfo (
isNeverInlinePrag, neverInlinePrag,
-- Occurrence info
OccInfo(..), isFragileOccInfo,
OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker,
InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch,
occInfo, setOccInfo,
......@@ -75,7 +75,7 @@ module IdInfo (
import CoreSyn
import PrimOp ( PrimOp )
import Var ( Id )
import BasicTypes ( OccInfo(..), isFragileOccInfo, seqOccInfo,
import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
InsideLam, insideLam, notInsideLam,
OneBranch, oneBranch, notOneBranch,
Arity
......@@ -286,7 +286,11 @@ data ArityInfo
-- function; it's already been compiled and we know its
-- arity for sure.
| ArityAtLeast Arity -- Arity is this or greater. We attach this arity to
| ArityAtLeast Arity -- A partial application of this Id to up to n-1 value arguments
-- does essentially no work. That is not necessarily the
-- same as saying that it has n leading lambdas, because coerces
-- may get in the way.
-- functions in the module being compiled. Their arity
-- might increase later in the compilation process, if
-- an extra lambda floats up to the binding site.
......@@ -373,9 +377,7 @@ There might not be a worker, even for a strict function, because:
data WorkerInfo = NoWorker
| HasWorker Id Arity
-- The Arity is the arity of the *wrapper* at the moment of the
-- w/w split. It had better be the same as the arity of the wrapper
-- at the moment it is spat into the interface file.
-- This Arity just lets us make a (hopefully redundant) sanity check
-- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code.
seqWorker :: WorkerInfo -> ()
seqWorker (HasWorker id _) = id `seq` ()
......@@ -581,7 +583,7 @@ zapFragileInfo info@(IdInfo {occInfo = occ,
workerInfo = wrkr,
specInfo = rules,
unfoldingInfo = unfolding})
| not (isFragileOccInfo occ)
| not (isFragileOcc occ)
-- We must forget about whether it was marked safe-to-inline,
-- because that isn't necessarily true in the simplified expression.
-- This is important because expressions may be re-simplified
......
......@@ -51,7 +51,7 @@ import VarSet
import VarEnv
import Var ( setVarUnique, isId )
import Id ( idType, setIdType, idOccInfo, zapFragileIdInfo )
import IdInfo ( IdInfo, isFragileOccInfo,
import IdInfo ( IdInfo, isFragileOcc,
specInfo, setSpecInfo,
WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo
)
......@@ -75,12 +75,13 @@ import Util ( mapAccumL, foldl2, seqList, ($!) )
data InScopeSet = InScope (VarEnv Var) Int#
-- The Int# is a kind of hash-value used by uniqAway
-- For example, it might be the size of the set
-- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
emptyInScopeSet :: InScopeSet
emptyInScopeSet = InScope emptyVarSet 0#
emptyInScopeSet = InScope emptyVarSet 1#
mkInScopeSet :: VarEnv Var -> InScopeSet
mkInScopeSet in_scope = InScope in_scope 0#
mkInScopeSet in_scope = InScope in_scope 1#
extendInScopeSet :: InScopeSet -> Var -> InScopeSet
extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#)
......@@ -123,11 +124,16 @@ uniqAway :: InScopeSet -> Var -> Var
-- in the hope that it won't have to change it, nad thereafter uses a combination
-- of that and the hash-code found in the in-scope set
uniqAway (InScope set n) var
| not (var `elemVarSet` set) = var -- Nothing to do
| not (var `elemVarSet` set) = var -- Nothing to do
| otherwise = try 1#
where
orig_unique = getUnique var
try k | uniq `elemUniqSet_Directly` set = try (k +# 1#)
try k
#ifdef DEBUG
| k ># 1000#
= pprPanic "uniqAway loop:" (ppr (I# k) <+> text "tries" <+> ppr var <+> int (I# n))
#endif
| uniq `elemUniqSet_Directly` set = try (k +# 1#)
#ifdef DEBUG
| opt_PprStyle_Debug && k ># 3#
= pprTrace "uniqAway:" (ppr (I# k) <+> text "tries" <+> ppr var <+> int (I# n))
......@@ -242,7 +248,7 @@ lookupIdSubst (Subst in_scope env) v
Just res -> res
Nothing -> DoneId v' (idOccInfo v')
-- We don't use DoneId for LoopBreakers, so the idOccInfo is
-- very important! If isFragileOccInfo returned True for
-- very important! If isFragileOcc returned True for
-- loop breakers we could avoid this call, but at the expense
-- of adding more to the substitution, and building new Ids
-- in substId a bit more often than really necessary
......@@ -531,7 +537,7 @@ substId subst@(Subst in_scope env) old_id
-- Extend the substitution if the unique has changed,
-- or there's some useful occurrence information
-- See the notes with substTyVar for the delSubstEnv
new_env | new_id /= old_id || isFragileOccInfo occ_info
new_env | new_id /= old_id || isFragileOcc occ_info
= extendSubstEnv env old_id (DoneId new_id occ_info)
| otherwise
= delSubstEnv env old_id
......
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