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(
CompilerPhase,
Activation(..), isActive, isNeverActive, isAlwaysActive,
InlineSpec(..), defaultInlineSpec, alwaysInlineSpec,
InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
SuccessFlag(..), succeeded, failed, successIf
) where
......@@ -475,7 +475,8 @@ data InlineSpec
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
......
......@@ -531,11 +531,13 @@ rules :: { OrdList (LHsDecl RdrName) } -- Reversed
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)) }
......@@ -996,12 +998,12 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
| 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 '#-}'
{ 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)) }
......
......@@ -11,7 +11,7 @@ module RdrHsSyn (
mkHsOpApp, mkClassDecl,
mkHsNegApp, mkHsIntegral, mkHsFractional,
mkHsDo, mkHsSplice,
mkTyData, mkPrefixCon, mkRecCon,
mkTyData, mkPrefixCon, mkRecCon, mkInlineSpec,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
cvBindGroup,
......@@ -53,7 +53,7 @@ import HsSyn -- Lots of it
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(..),
......@@ -671,6 +671,13 @@ mkRecConstrOrUpdate exp loc fs@(_:_)
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
......
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