[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).

diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
index 14c9893..b0100e6 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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