Minor refactoring to remove redundant code

[ghc-hetmet.git] / compiler / basicTypes / BasicTypes.lhs

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 9b21399..15725fd 100644 (file)
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -42,8 +42,9 @@ module BasicTypes(
 
        TupCon(..), tupleParens,
 
-       OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc, 
+       OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc, 
        isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
+        nonRuleLoopBreaker,
 
        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
@@ -56,7 +57,7 @@ module BasicTypes(
        CompilerPhase, 
        Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
         RuleMatchInfo(..), isConLike, isFunLike, 
-        InlinePragma(..), defaultInlinePragma, neverInlinePragma, dfunInlinePragma,
+        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma,
        isDefaultInlinePragma, isInlinePragma,
         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
@@ -476,17 +477,20 @@ isNonRuleLoopBreaker :: OccInfo -> Bool
 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
 isNonRuleLoopBreaker _                       = False
 
+nonRuleLoopBreaker :: OccInfo
+nonRuleLoopBreaker = IAmALoopBreaker False
+
 isDeadOcc :: OccInfo -> Bool
 isDeadOcc IAmDead = True
 isDeadOcc _       = False
 
 isOneOcc :: OccInfo -> Bool
-isOneOcc (OneOcc _ _ _) = True
-isOneOcc _              = False
+isOneOcc (OneOcc {}) = True
+isOneOcc _           = False
 
-isFragileOcc :: OccInfo -> Bool
-isFragileOcc (OneOcc _ _ _) = True
-isFragileOcc _              = False
+zapFragileOcc :: OccInfo -> OccInfo
+zapFragileOcc (OneOcc {}) = NoOccInfo
+zapFragileOcc occ         = occ
 \end{code}
 
 \begin{code}
@@ -656,9 +660,12 @@ isFunLike :: RuleMatchInfo -> Bool
 isFunLike FunLike = True
 isFunLike _            = False
 
-defaultInlinePragma, neverInlinePragma, dfunInlinePragma :: InlinePragma
+defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
+  :: InlinePragma
 defaultInlinePragma 
   = InlinePragma { inl_act = AlwaysActive, inl_rule = FunLike, inl_inline = False }
+alwaysInlinePragma
+  = InlinePragma { inl_act = AlwaysActive, inl_rule = FunLike, inl_inline = True }
 neverInlinePragma   
    = InlinePragma { inl_act = NeverActive, inl_rule = FunLike, inl_inline = False }
 dfunInlinePragma