From c77080dd41381bdbdd2fbaa1472a458e415fc429 Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 7 Sep 2000 11:42:50 +0000 Subject: [PATCH] [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). --- ghc/compiler/basicTypes/BasicTypes.lhs | 12 ++++++++---- ghc/compiler/basicTypes/IdInfo.lhs | 16 +++++++++------- ghc/compiler/coreSyn/Subst.lhs | 20 +++++++++++++------- 3 files changed, 30 insertions(+), 18 deletions(-) diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs index 14c9893..b0100e6 100644 --- a/ghc/compiler/basicTypes/BasicTypes.lhs +++ b/ghc/compiler/basicTypes/BasicTypes.lhs @@ -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} diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index f73ba4f..1cf25b1 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -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 diff --git a/ghc/compiler/coreSyn/Subst.lhs b/ghc/compiler/coreSyn/Subst.lhs index 1f0f928..d9d9279 100644 --- a/ghc/compiler/coreSyn/Subst.lhs +++ b/ghc/compiler/coreSyn/Subst.lhs @@ -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 -- 1.7.10.4