X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FBasicTypes.lhs;h=cdfc28c4c90e54b31d8384653336548725a73aa2;hb=9526ada5b1e4a3463833bd74a15473d2ff7b53c1;hp=e6e3a90dfb9d7798db2f93ba80d9f07952998c87;hpb=c248518fe81b6d2807d3bcbb8a09ae14facce1ad;p=ghc-hetmet.git diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index e6e3a90..cdfc28c 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -1,4 +1,5 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998 % \section[BasicTypes]{Miscellanous types} @@ -38,7 +39,7 @@ module BasicTypes( TupCon(..), tupleParens, OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc, - isDeadOcc, isLoopBreaker, isNoOcc, + isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc, InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch, @@ -57,7 +58,7 @@ module BasicTypes( #include "HsVersions.h" -import FastString( FastString ) +import FastString import Outputable \end{code} @@ -150,7 +151,9 @@ instance Outputable FixityDirection where ppr InfixN = ptext SLIT("infix") ------------------------ -maxPrecedence = (9::Int) +maxPrecedence :: Int +maxPrecedence = 9 +defaultFixity :: Fixity defaultFixity = Fixity maxPrecedence InfixL negateFixity, funTyFixity :: Fixity @@ -235,7 +238,7 @@ isBoxed Unboxed = False %* * %************************************************************************ -\begin{code} +\begin{code} data RecFlag = Recursive | NonRecursive deriving( Eq ) @@ -367,21 +370,39 @@ defn of OccInfo here, safely at the bottom data OccInfo = NoOccInfo -- Many occurrences, or unknown - | RulesOnly -- Occurs only in the RHS of one or more rules - | IAmDead -- Marks unused variables. Sometimes useful for -- lambda and case-bound variables. - | OneOcc !InsideLam -- Occurs exactly once, not inside a rule - !OneBranch - !InterestingCxt + | OneOcc -- Occurs exactly once, not inside a rule + !InsideLam + !OneBranch + !InterestingCxt + + | IAmALoopBreaker -- Note [LoopBreaker OccInfo] + !RulesOnly -- True <=> This is a weak or rules-only loop breaker + -- See OccurAnal Note [Weak loop breakers] + +type RulesOnly = Bool +\end{code} + +Note [LoopBreaker OccInfo] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +An OccInfo of (IAmLoopBreaker False) is used by the occurrence +analyser in two ways: + (a) to mark loop-breakers in a group of recursive + definitions (hence the name) + (b) to mark binders that must not be inlined in this phase + (perhaps it has a NOINLINE pragma) +Things with (IAmLoopBreaker False) do not get an unfolding +pinned on to them, so they are completely opaque. + +See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True). - | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers - -- in a group of recursive definitions +\begin{code} isNoOcc :: OccInfo -> Bool isNoOcc NoOccInfo = True -isNoOcc other = False +isNoOcc _ = False seqOccInfo :: OccInfo -> () seqOccInfo occ = occ `seq` () @@ -395,38 +416,44 @@ type InterestingCxt = Bool -- True <=> Function: is applied type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda -- Substituting a redex for this occurrence is -- dangerous because it might duplicate work. +insideLam, notInsideLam :: InsideLam insideLam = True notInsideLam = False ----------------- type OneBranch = Bool -- True <=> Occurs in only one case branch -- so no code-duplication issue to worry about +oneBranch, notOneBranch :: OneBranch oneBranch = True notOneBranch = False isLoopBreaker :: OccInfo -> Bool -isLoopBreaker IAmALoopBreaker = True -isLoopBreaker other = False +isLoopBreaker (IAmALoopBreaker _) = True +isLoopBreaker _ = False + +isNonRuleLoopBreaker :: OccInfo -> Bool +isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle +isNonRuleLoopBreaker _ = False isDeadOcc :: OccInfo -> Bool isDeadOcc IAmDead = True -isDeadOcc other = False +isDeadOcc _ = False +isOneOcc :: OccInfo -> Bool isOneOcc (OneOcc _ _ _) = True -isOneOcc other = False +isOneOcc _ = False isFragileOcc :: OccInfo -> Bool isFragileOcc (OneOcc _ _ _) = True -isFragileOcc other = False +isFragileOcc _ = False \end{code} \begin{code} instance Outputable OccInfo where -- only used for debugging; never parsed. KSW 1999-07 - ppr NoOccInfo = empty - ppr RulesOnly = ptext SLIT("RulesOnly") - ppr IAmALoopBreaker = ptext SLIT("LoopBreaker") - ppr IAmDead = ptext SLIT("Dead") + ppr NoOccInfo = empty + ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty + ppr IAmDead = ptext SLIT("Dead") ppr (OneOcc inside_lam one_branch int_cxt) = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args where @@ -457,11 +484,13 @@ data StrictnessMark -- Used in interface decls only | NotMarkedStrict deriving( Eq ) +isMarkedUnboxed :: StrictnessMark -> Bool isMarkedUnboxed MarkedUnboxed = True -isMarkedUnboxed other = False +isMarkedUnboxed _ = False +isMarkedStrict :: StrictnessMark -> Bool isMarkedStrict NotMarkedStrict = False -isMarkedStrict other = True -- All others are strict +isMarkedStrict _ = True -- All others are strict instance Outputable StrictnessMark where ppr MarkedStrict = ptext SLIT("!") @@ -479,6 +508,10 @@ instance Outputable StrictnessMark where \begin{code} data SuccessFlag = Succeeded | Failed +instance Outputable SuccessFlag where + ppr Succeeded = ptext SLIT("Succeeded") + ppr Failed = ptext SLIT("Failed") + successIf :: Bool -> SuccessFlag successIf True = Succeeded successIf False = Failed @@ -518,31 +551,40 @@ data InlineSpec -- is enabled, it will definitely actually happen deriving( Eq ) +defaultInlineSpec, alwaysInlineSpec, neverInlineSpec :: InlineSpec + defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced alwaysInlineSpec = Inline AlwaysActive True -- INLINE always neverInlineSpec = Inline NeverActive False -- NOINLINE instance Outputable Activation where - ppr AlwaysActive = empty -- The default + ppr NeverActive = ptext SLIT("NEVER") + ppr AlwaysActive = ptext SLIT("ALWAYS") ppr (ActiveBefore n) = brackets (char '~' <> int n) ppr (ActiveAfter n) = brackets (int n) - ppr NeverActive = ptext SLIT("NEVER") instance Outputable InlineSpec where - ppr (Inline act True) = ptext SLIT("INLINE") <> ppr act - ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act + ppr (Inline act is_inline) + | is_inline = ptext SLIT("INLINE") + <> case act of + AlwaysActive -> empty + _ -> ppr act + | otherwise = ptext SLIT("NOINLINE") + <> case act of + NeverActive -> empty + _ -> ppr act isActive :: CompilerPhase -> Activation -> Bool -isActive p NeverActive = False -isActive p AlwaysActive = True +isActive _ NeverActive = False +isActive _ AlwaysActive = True isActive p (ActiveAfter n) = p <= n isActive p (ActiveBefore n) = p > n isNeverActive, isAlwaysActive :: Activation -> Bool isNeverActive NeverActive = True -isNeverActive act = False +isNeverActive _ = False isAlwaysActive AlwaysActive = True -isAlwaysActive other = False +isAlwaysActive _ = False \end{code}