Fixity(..), FixityDirection(..),
defaultFixity, maxPrecedence,
- negateFixity,
+ negateFixity, funTyFixity,
compareFixity,
IPName(..), ipNameName, mapIPName,
- NewOrData(..),
-
RecFlag(..), isRec, isNonRec, boolToRecFlag,
TopLevelFlag(..), isTopLevel, isNotTopLevel,
TupCon(..), tupleParens,
OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
- isDeadOcc, isLoopBreaker,
+ isDeadOcc, isLoopBreaker, isNoOcc,
InsideLam, insideLam, notInsideLam,
OneBranch, oneBranch, notOneBranch,
+ InterestingCxt,
EP(..),
CompilerPhase,
Activation(..), isActive, isNeverActive, isAlwaysActive,
+ InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
SuccessFlag(..), succeeded, failed, successIf
) where
maxPrecedence = (9::Int)
defaultFixity = Fixity maxPrecedence InfixL
-negateFixity :: Fixity
-negateFixity = Fixity negatePrecedence InfixL -- Precedence of unary negate is wired in as infixl 6!
-
-negatePrecedence :: Int
-negatePrecedence = 6
+negateFixity, funTyFixity :: Fixity
+-- Wired-in fixities
+negateFixity = Fixity 6 InfixL -- Fixity of unary negate
+funTyFixity = Fixity 0 InfixR -- Fixity of '->'
\end{code}
Consider
%************************************************************************
%* *
-\subsection[NewType/DataType]{NewType/DataType flag}
-%* *
-%************************************************************************
-
-\begin{code}
-data NewOrData
- = NewType -- "newtype Blah ..."
- | DataType -- "data Blah ..."
- deriving( Eq ) -- Needed because Demand derives Eq
-
-instance Outputable NewOrData where
- ppr NewType = ptext SLIT("newtype")
- ppr DataType = ptext SLIT("data")
-\end{code}
-
-
-%************************************************************************
-%* *
\subsection[Top-level/local]{Top-level/not-top level flag}
%* *
%************************************************************************
| IAmDead -- Marks unused variables. Sometimes useful for
-- lambda and case-bound variables.
- | OneOcc InsideLam
-
- OneBranch
+ | OneOcc !InsideLam
+ !OneBranch
+ !InterestingCxt
| IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers
-- in a group of recursive definitions
+isNoOcc :: OccInfo -> Bool
+isNoOcc NoOccInfo = True
+isNoOcc other = False
+
seqOccInfo :: OccInfo -> ()
-seqOccInfo (OneOcc in_lam once) = in_lam `seq` once `seq` ()
-seqOccInfo occ = ()
+seqOccInfo occ = occ `seq` ()
+
+-----------------
+type InterestingCxt = Bool -- True <=> Function: is applied
+ -- Data value: scrutinised by a case with
+ -- at least one non-DEFAULT branch
+-----------------
type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
-- Substituting a redex for this occurrence is
-- dangerous because it might duplicate work.
insideLam = True
notInsideLam = False
+-----------------
type OneBranch = Bool -- True <=> Occurs in only one case branch
-- so no code-duplication issue to worry about
oneBranch = True
isDeadOcc IAmDead = True
isDeadOcc other = False
-isOneOcc (OneOcc _ _) = True
-isOneOcc other = False
+isOneOcc (OneOcc _ _ _) = True
+isOneOcc other = False
isFragileOcc :: OccInfo -> Bool
-isFragileOcc (OneOcc _ _) = True
-isFragileOcc other = False
+isFragileOcc (OneOcc _ _ _) = True
+isFragileOcc other = False
\end{code}
\begin{code}
instance Outputable OccInfo where
-- only used for debugging; never parsed. KSW 1999-07
ppr NoOccInfo = empty
- ppr IAmALoopBreaker = ptext SLIT("_Kx")
- ppr IAmDead = ptext SLIT("_Kd")
- ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("_Kl")
- | one_branch = ptext SLIT("_Ks")
- | otherwise = ptext SLIT("_Ks*")
+ ppr IAmALoopBreaker = ptext SLIT("LoopBreaker")
+ ppr IAmDead = ptext SLIT("Dead")
+ ppr (OneOcc inside_lam one_branch int_cxt)
+ = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
+ where
+ pp_lam | inside_lam = char 'L'
+ | otherwise = empty
+ pp_br | one_branch = empty
+ | otherwise = char '*'
+ pp_args | int_cxt = char '!'
+ | otherwise = empty
instance Show OccInfo where
showsPrec p occ = showsPrecSDoc p (ppr occ)
| ActiveAfter CompilerPhase -- Active in this phase and later
deriving( Eq ) -- Eq used in comparing rules in HsDecls
+data InlineSpec
+ = Inline
+ Activation -- Says during which phases inlining is allowed
+ Bool -- True <=> make the RHS look small, so that when inlining
+ -- is enabled, it will definitely actually happen
+ deriving( Eq )
+
+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 (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
+
isActive :: CompilerPhase -> Activation -> Bool
isActive p NeverActive = False
isActive p AlwaysActive = True
projects / ghc-hetmet.git / blobdiff