Wibble to: "Add a new pragma: SPECIALISE INLINE"
I messed up the way that NOINLINE is parsed; this commit fixes it.
CompilerPhase,
Activation(..), isActive, isNeverActive, isAlwaysActive,
CompilerPhase,
Activation(..), isActive, isNeverActive, isAlwaysActive,
- InlineSpec(..), defaultInlineSpec, alwaysInlineSpec,
+ InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
SuccessFlag(..), succeeded, failed, successIf
) where
SuccessFlag(..), succeeded, failed, successIf
) where
deriving( Eq )
defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced
deriving( Eq )
defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced
-alwaysInlineSpec = Inline AlwaysActive True -- Inline unconditionally
+alwaysInlineSpec = Inline AlwaysActive True -- INLINE always
+neverInlineSpec = Inline NeverActive False -- NOINLINE
instance Outputable Activation where
ppr AlwaysActive = empty -- The default
instance Outputable Activation where
ppr AlwaysActive = empty -- The default
rule :: { LHsDecl RdrName }
: STRING activation rule_forall infixexp '=' exp
rule :: { LHsDecl RdrName }
: STRING activation rule_forall infixexp '=' exp
- { LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6) }
+ { LL $ RuleD (HsRule (getSTRING $1)
+ ($2 `orElse` AlwaysActive)
+ $3 $4 $6) }
-activation :: { Activation } -- Omitted means AlwaysActive
- : {- empty -} { AlwaysActive }
- | explicit_activation { $1 }
+activation :: { Maybe Activation }
+ : {- empty -} { Nothing }
+ | explicit_activation { Just $1 }
explicit_activation :: { Activation } -- In brackets
: '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
explicit_activation :: { Activation } -- In brackets
: '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
| infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
| n <- unLoc $3 ] }
| '{-# INLINE' activation qvar '#-}'
| infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
| n <- unLoc $3 ] }
| '{-# INLINE' activation qvar '#-}'
- { LL $ unitOL (LL $ SigD (InlineSig $3 (Inline $2 (getINLINE $1)))) }
+ { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
| '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
{ LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
| t <- $4] }
| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
| '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
{ LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
| t <- $4] }
| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
- { LL $ toOL [ LL $ SigD (SpecSig $3 t (Inline $2 (getSPEC_INLINE $1)))
+ { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
| t <- $5] }
| '{-# SPECIALISE' 'instance' inst_type '#-}'
{ LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
| t <- $5] }
| '{-# SPECIALISE' 'instance' inst_type '#-}'
{ LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
mkHsOpApp, mkClassDecl,
mkHsNegApp, mkHsIntegral, mkHsFractional,
mkHsDo, mkHsSplice,
mkHsOpApp, mkClassDecl,
mkHsNegApp, mkHsIntegral, mkHsFractional,
mkHsDo, mkHsSplice,
- mkTyData, mkPrefixCon, mkRecCon,
+ mkTyData, mkPrefixCon, mkRecCon, mkInlineSpec,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
cvBindGroup,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
cvBindGroup,
import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc,
isRdrDataCon, isUnqual, getRdrName, isQual,
setRdrNameSpace )
import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc,
isRdrDataCon, isUnqual, getRdrName, isQual,
setRdrNameSpace )
-import BasicTypes ( maxPrecedence )
+import BasicTypes ( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec )
import Lexer ( P, failSpanMsgP )
import TysWiredIn ( unitTyCon )
import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
import Lexer ( P, failSpanMsgP )
import TysWiredIn ( unitTyCon )
import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
mkRecConstrOrUpdate _ loc []
= parseError loc "Empty record update"
mkRecConstrOrUpdate _ loc []
= parseError loc "Empty record update"
+mkInlineSpec :: Maybe Activation -> Bool -> InlineSpec
+-- The Maybe is becuase the user can omit the activation spec (and usually does)
+mkInlineSpec Nothing True = alwaysInlineSpec -- INLINE
+mkInlineSpec Nothing False = neverInlineSpec -- NOINLINE
+mkInlineSpec (Just act) inl = Inline act inl
+
+
-----------------------------------------------------------------------------
-- utilities for foreign declarations
-----------------------------------------------------------------------------
-- utilities for foreign declarations