X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FBasicTypes.lhs;h=d60321ade60b22ee6af0d0c7202590e09e6fa0af;hp=2bb2f360089bc6697b32700de783788f11d14016;hb=30c122df62ec75f9ed7f392f24c2925675bf1d06;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index 2bb2f36..d60321a 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -14,13 +14,6 @@ types that \end{itemize} \begin{code} -{-# OPTIONS_GHC -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings --- for details - module BasicTypes( Version, bumpVersion, initialVersion, @@ -65,7 +58,7 @@ module BasicTypes( #include "HsVersions.h" -import FastString( FastString ) +import FastString import Outputable \end{code} @@ -158,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 @@ -385,10 +380,8 @@ data OccInfo | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers -- in a group of recursive definitions - !RulesOnly -- True <=> This loop breaker mentions the other binders - -- in its recursive group only in its RULES, not - -- in its rhs - -- See OccurAnal Note [RulesOnly] + !RulesOnly -- True <=> This is a weak or rules-only loop breaker + -- See OccurAnal Note [Weak loop breakers] type RulesOnly = Bool \end{code} @@ -397,7 +390,7 @@ type RulesOnly = Bool \begin{code} isNoOcc :: OccInfo -> Bool isNoOcc NoOccInfo = True -isNoOcc other = False +isNoOcc _ = False seqOccInfo :: OccInfo -> () seqOccInfo occ = occ `seq` () @@ -411,33 +404,36 @@ 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 _ = False isNonRuleLoopBreaker :: OccInfo -> Bool -isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle -isNonRuleLoopBreaker other = False +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} @@ -476,11 +472,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("!") @@ -541,31 +539,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}