Arity,
- FunctionOrData(..),
+ FunctionOrData(..),
WarningTxt(..),
HsBang(..), isBanged, isMarkedUnboxed,
StrictnessMark(..), isMarkedStrict,
+ DefMethSpec(..),
+
CompilerPhase,
Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
RuleMatchInfo(..), isConLike, isFunLike,
- InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma,
- isDefaultInlinePragma, isInlinePragma, inlinePragmaSat,
+ InlineSpec(..),
+ InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
+ neverInlinePragma, dfunInlinePragma,
+ isDefaultInlinePragma, isInlinePragma, isInlinablePragma,
+ inlinePragmaSpec, inlinePragmaSat,
inlinePragmaActivation, inlinePragmaRuleMatchInfo,
setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
--
-- Example: constraint (Foo [Int])
-- instances (Foo [Int])
+
-- (Foo [a]) OverlapOk
-- Since the second instance has the OverlapOk flag,
-- the first instance will be chosen (otherwise
%************************************************************************
%* *
-\subsection{Strictness indication}
+ Strictness indication
%* *
%************************************************************************
%************************************************************************
%* *
+ Default method specfication
+%* *
+%************************************************************************
+
+The DefMethSpec enumeration just indicates what sort of default method
+is used for a class. It is generated from source code, and present in
+interface files; it is converted to Class.DefMeth before begin put in a
+Class object.
+
+\begin{code}
+data DefMethSpec = NoDM -- No default method
+ | VanillaDM -- Default method given with polymorphic code
+ | GenericDM -- Default method given with generic code
+
+instance Outputable DefMethSpec where
+ ppr NoDM = empty
+ ppr VanillaDM = ptext (sLit "{- Has default method -}")
+ ppr GenericDM = ptext (sLit "{- Has generic default method -}")
+\end{code}
+
+%************************************************************************
+%* *
\subsection{Success flag}
%* *
%************************************************************************
| AlwaysActive
| ActiveBefore CompilerPhase -- Active only *before* this phase
| ActiveAfter CompilerPhase -- Active in this phase and later
- deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
+ deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
| FunLike
- deriving( Eq, Data, Typeable )
+ deriving( Eq, Data, Typeable, Show )
+ -- Show needed for Lexer.x
data InlinePragma -- Note [InlinePragma]
= InlinePragma
- { inl_inline :: Bool -- True <=> INLINE,
- -- False <=> no pragma at all, or NOINLINE
+ { inl_inline :: InlineSpec
, inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
-- explicit (non-type, non-dictionary) args
, inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
} deriving( Eq, Data, Typeable )
+
+data InlineSpec -- What the user's INLINE pragama looked like
+ = Inline
+ | Inlinable
+ | NoInline
+ | EmptyInlineSpec
+ deriving( Eq, Data, Typeable, Show )
+ -- Show needed for Lexer.x
\end{code}
Note [InlinePragma]
isFunLike FunLike = True
isFunLike _ = False
+isInlineSpec :: InlineSpec -> Bool
+isInlineSpec Inline = True
+isInlineSpec Inlinable = True
+isInlineSpec _ = False
+
+isEmptyInlineSpec :: InlineSpec -> Bool
+isEmptyInlineSpec EmptyInlineSpec = True
+isEmptyInlineSpec _ = False
+
defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
:: InlinePragma
defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
, inl_rule = FunLike
- , inl_inline = False
+ , inl_inline = EmptyInlineSpec
, inl_sat = Nothing }
-alwaysInlinePragma = defaultInlinePragma { inl_inline = True }
+alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
+inlinePragmaSpec :: InlinePragma -> InlineSpec
+inlinePragmaSpec = inl_inline
+
-- A DFun has an always-active inline activation so that
-- exprIsConApp_maybe can "see" its unfolding
-- (However, its actual Unfolding is a DFunUnfolding, which is
isDefaultInlinePragma (InlinePragma { inl_act = activation
, inl_rule = match_info
, inl_inline = inline })
- = not inline && isAlwaysActive activation && isFunLike match_info
+ = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
isInlinePragma :: InlinePragma -> Bool
-isInlinePragma prag = inl_inline prag
+isInlinePragma prag = isInlineSpec (inl_inline prag)
+
+isInlinablePragma :: InlinePragma -> Bool
+isInlinablePragma prag = case inl_inline prag of
+ Inlinable -> True
+ _ -> False
inlinePragmaSat :: InlinePragma -> Maybe Arity
inlinePragmaSat = inl_sat
ppr ConLike = ptext (sLit "CONLIKE")
ppr FunLike = ptext (sLit "FUNLIKE")
+instance Outputable InlineSpec where
+ ppr Inline = ptext (sLit "INLINE")
+ ppr NoInline = ptext (sLit "NOINLINE")
+ ppr Inlinable = ptext (sLit "INLINABLE")
+ ppr EmptyInlineSpec = empty
+
instance Outputable InlinePragma where
ppr (InlinePragma { inl_inline = inline, inl_act = activation
, inl_rule = info, inl_sat = mb_arity })
- = pp_inl_act (inline, activation) <+> pp_sat <+> pp_info
+ = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
where
- pp_inl_act (False, AlwaysActive) = empty -- defaultInlinePragma
- pp_inl_act (False, NeverActive) = ptext (sLit "NOINLINE")
- pp_inl_act (False, act) = ptext (sLit "NOINLINE") <> ppr act
- pp_inl_act (True, AlwaysActive) = ptext (sLit "INLINE")
- pp_inl_act (True, act) = ptext (sLit "INLINE") <> ppr act
+ pp_act Inline AlwaysActive = empty
+ pp_act NoInline NeverActive = empty
+ pp_act _ act = ppr act
pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
| otherwise = empty
projects / ghc-hetmet.git / blobdiff