Commit 9c30856d authored by simonpj's avatar simonpj

[project @ 2005-10-31 11:49:29 by simonpj]

Wibble to: "Add a new pragma: SPECIALISE INLINE"

I messed up the way that NOINLINE is parsed; this commit fixes it.
parent 435a55f2
...@@ -48,7 +48,7 @@ module BasicTypes( ...@@ -48,7 +48,7 @@ module BasicTypes(
CompilerPhase, CompilerPhase,
Activation(..), isActive, isNeverActive, isAlwaysActive, Activation(..), isActive, isNeverActive, isAlwaysActive,
InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
SuccessFlag(..), succeeded, failed, successIf SuccessFlag(..), succeeded, failed, successIf
) where ) where
...@@ -475,7 +475,8 @@ data InlineSpec ...@@ -475,7 +475,8 @@ data InlineSpec
deriving( Eq ) deriving( Eq )
defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced 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 instance Outputable Activation where
ppr AlwaysActive = empty -- The default ppr AlwaysActive = empty -- The default
......
...@@ -531,11 +531,13 @@ rules :: { OrdList (LHsDecl RdrName) } -- Reversed ...@@ -531,11 +531,13 @@ rules :: { OrdList (LHsDecl RdrName) } -- Reversed
rule :: { LHsDecl RdrName } rule :: { LHsDecl RdrName }
: STRING activation rule_forall infixexp '=' exp : 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 activation :: { Maybe Activation }
: {- empty -} { AlwaysActive } : {- empty -} { Nothing }
| explicit_activation { $1 } | explicit_activation { Just $1 }
explicit_activation :: { Activation } -- In brackets explicit_activation :: { Activation } -- In brackets
: '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) } : '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
...@@ -996,12 +998,12 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } ...@@ -996,12 +998,12 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
| infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1)))) | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
| n <- unLoc $3 ] } | n <- unLoc $3 ] }
| '{-# INLINE' activation qvar '#-}' | '{-# 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 '#-}' | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
{ LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec) { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
| t <- $4] } | t <- $4] }
| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}' | '{-# 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] } | t <- $5] }
| '{-# SPECIALISE' 'instance' inst_type '#-}' | '{-# SPECIALISE' 'instance' inst_type '#-}'
{ LL $ unitOL (LL $ SigD (SpecInstSig $3)) } { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
......
...@@ -11,7 +11,7 @@ module RdrHsSyn ( ...@@ -11,7 +11,7 @@ module RdrHsSyn (
mkHsOpApp, mkClassDecl, mkHsOpApp, mkClassDecl,
mkHsNegApp, mkHsIntegral, mkHsFractional, mkHsNegApp, mkHsIntegral, mkHsFractional,
mkHsDo, mkHsSplice, mkHsDo, mkHsSplice,
mkTyData, mkPrefixCon, mkRecCon, mkTyData, mkPrefixCon, mkRecCon, mkInlineSpec,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
cvBindGroup, cvBindGroup,
...@@ -53,7 +53,7 @@ import HsSyn -- Lots of it ...@@ -53,7 +53,7 @@ import HsSyn -- Lots of it
import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc, import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc,
isRdrDataCon, isUnqual, getRdrName, isQual, isRdrDataCon, isUnqual, getRdrName, isQual,
setRdrNameSpace ) setRdrNameSpace )
import BasicTypes ( maxPrecedence ) import BasicTypes ( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec )
import Lexer ( P, failSpanMsgP ) import Lexer ( P, failSpanMsgP )
import TysWiredIn ( unitTyCon ) import TysWiredIn ( unitTyCon )
import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..), import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
...@@ -671,6 +671,13 @@ mkRecConstrOrUpdate exp loc fs@(_:_) ...@@ -671,6 +671,13 @@ mkRecConstrOrUpdate exp loc fs@(_:_)
mkRecConstrOrUpdate _ loc [] mkRecConstrOrUpdate _ loc []
= parseError loc "Empty record update" = 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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment