\end{itemize}
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
module BasicTypes(
Version, bumpVersion, initialVersion,
import FastString
import Outputable
+
+import Data.Data hiding (Fixity)
\end{code}
%************************************************************************
\begin{code}
data FunctionOrData = IsFunction | IsData
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Data, Typeable)
instance Outputable FunctionOrData where
ppr IsFunction = text "(function)"
-- reason/explanation from a WARNING or DEPRECATED pragma
data WarningTxt = WarningTxt [FastString]
| DeprecatedTxt [FastString]
- deriving Eq
+ deriving (Eq, Data, Typeable)
instance Outputable WarningTxt where
ppr (WarningTxt ws) = doubleQuotes (vcat (map ftext ws))
\begin{code}
newtype IPName name = IPName name -- ?x
- deriving( Eq, Ord ) -- Ord is used in the IP name cache finite map
- -- (used in HscTypes.OrigIParamCache)
+ deriving( Eq, Ord, Data, Typeable )
+ -- Ord is used in the IP name cache finite map
+ -- (used in HscTypes.OrigIParamCache)
ipNameName :: IPName name -> name
ipNameName (IPName n) = n
\begin{code}
------------------------
data Fixity = Fixity Int FixityDirection
+ deriving (Data, Typeable)
instance Outputable Fixity where
ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
------------------------
data FixityDirection = InfixL | InfixR | InfixN
- deriving(Eq)
+ deriving (Eq, Data, Typeable)
instance Outputable FixityDirection where
ppr InfixL = ptext (sLit "infixl")
data Boxity
= Boxed
| Unboxed
- deriving( Eq )
+ deriving( Eq, Data, Typeable )
isBoxed :: Boxity -> Bool
isBoxed Boxed = True
\begin{code}
data RecFlag = Recursive
| NonRecursive
- deriving( Eq )
+ deriving( Eq, Data, Typeable )
isRec :: RecFlag -> Bool
isRec Recursive = True
| AlwaysActive
| ActiveBefore CompilerPhase -- Active only *before* this phase
| ActiveAfter CompilerPhase -- Active in this phase and later
- deriving( Eq ) -- 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 )
+ deriving( Eq, Data, Typeable )
data InlinePragma -- Note [InlinePragma]
= InlinePragma
-- explicit (non-type, non-dictionary) args
, inl_act :: Activation -- Says during which phases inlining is allowed
, inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
- } deriving( Eq )
+ } deriving( Eq, Data, Typeable )
\end{code}
Note [InlinePragma]
alwaysInlinePragma = defaultInlinePragma { inl_inline = True }
neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
-dfunInlinePragma = defaultInlinePragma { inl_rule = ConLike }
-
+
+-- 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
+-- never inlined other than via exprIsConApp_maybe.)
+dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
+ , inl_rule = ConLike }
isDefaultInlinePragma :: InlinePragma -> Bool
isDefaultInlinePragma (InlinePragma { inl_act = activation
setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
instance Outputable Activation where
- ppr AlwaysActive = ptext (sLit "ALWAYS")
- ppr NeverActive = ptext (sLit "NEVER")
+ ppr AlwaysActive = brackets (ptext (sLit "ALWAYS"))
+ ppr NeverActive = brackets (ptext (sLit "NEVER"))
ppr (ActiveBefore n) = brackets (char '~' <> int n)
ppr (ActiveAfter n) = brackets (int n)
instance Outputable InlinePragma where
ppr (InlinePragma { inl_inline = inline, inl_act = activation
, inl_rule = info, inl_sat = mb_arity })
- = pp_inline <> pp_activation <+> pp_sat <+> pp_info
+ = pp_inl_act (inline, activation) <+> pp_sat <+> pp_info
where
- pp_inline | inline = ptext (sLit "INLINE")
- | otherwise = ptext (sLit "NOINLINE")
+ 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_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
| otherwise = empty
pp_info | isFunLike info = empty
| otherwise = ppr info
- pp_activation
- | inline && isAlwaysActive activation = empty
- | not inline && isNeverActive activation = empty
- | otherwise = ppr activation
isActive :: CompilerPhase -> Activation -> Bool
isActive _ NeverActive = False