Add idHasRules

Add Id.idHasRules :: Id -> Bool, with the obvious semantics.
This patch makes sense by itself, but it's just a tidy-up.

diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index c7ce818..8f955d3 100644 (file)
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -66,7 +66,7 @@ module Id (
        idNewStrictness, idNewStrictness_maybe, 
        idWorkerInfo,
        idUnfolding,
        idNewStrictness, idNewStrictness_maybe, 
        idWorkerInfo,
        idUnfolding,

-       idSpecialisation, idCoreRules,
+       idSpecialisation, idCoreRules, idHasRules,

        idCafInfo,
        idLBVarInfo,
        idOccInfo,
        idCafInfo,
        idLBVarInfo,
        idOccInfo,

@@ -409,6 +409,9 @@ idSpecialisation id = specInfo (idInfo id)
 idCoreRules :: Id -> [CoreRule]
 idCoreRules id = specInfoRules (idSpecialisation id)
 
 idCoreRules :: Id -> [CoreRule]
 idCoreRules id = specInfoRules (idSpecialisation id)
 

+idHasRules :: Id -> Bool
+idHasRules id = not (isEmptySpecInfo (idSpecialisation id))
+

 setIdSpecialisation :: Id -> SpecInfo -> Id
 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 
 setIdSpecialisation :: Id -> SpecInfo -> Id
 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 

diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 90a565f..00fdebe 100644 (file)
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -22,10 +22,9 @@ import CoreFVs               ( idRuleVars )
 import CoreUtils       ( exprIsTrivial, isDefaultAlt )
 import Id              ( isDataConWorkId, isOneShotBndr, setOneShotLambda, 
                          idOccInfo, setIdOccInfo, isLocalId,
 import CoreUtils       ( exprIsTrivial, isDefaultAlt )
 import Id              ( isDataConWorkId, isOneShotBndr, setOneShotLambda, 
                          idOccInfo, setIdOccInfo, isLocalId,

-                         isExportedId, idArity, idSpecialisation,
+                         isExportedId, idArity, idHasRules,

                          idType, idUnique, Id
                        )
                          idType, idUnique, Id
                        )

-import IdInfo          ( isEmptySpecInfo )

 import BasicTypes      ( OccInfo(..), isOneOcc, InterestingCxt )
 
 import VarSet
 import BasicTypes      ( OccInfo(..), isOneOcc, InterestingCxt )
 
 import VarSet

@@ -320,7 +319,7 @@ reOrderRec env (CyclicSCC (bind : binds))
 
        | inlineCandidate bndr rhs = 2  -- Likely to be inlined
 
 
        | inlineCandidate bndr rhs = 2  -- Likely to be inlined
 

-       | not (isEmptySpecInfo (idSpecialisation bndr)) = 1
+       | idHasRules bndr = 1

                -- Avoid things with specialisations; we'd like
                -- to take advantage of them in the subsequent bindings
 
                -- Avoid things with specialisations; we'd like
                -- to take advantage of them in the subsequent bindings