Repository : ssh://darcs.haskell.org//srv/darcs/packages/template-haskell On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6c0b59b8d9db5ce12e5b566a2c3cf6889a00aca4 >--------------------------------------------------------------- commit 6c0b59b8d9db5ce12e5b566a2c3cf6889a00aca4 Author: Simon Peyton Jones <[email protected]> Date: Fri May 18 10:03:50 2012 +0100 Add INLINABLE pragmas in Template Haskell Thanks to mikhail.vorozhtsov for doing the work >--------------------------------------------------------------- Language/Haskell/TH.hs | 8 ++++---- Language/Haskell/TH/Lib.hs | 4 ++-- Language/Haskell/TH/Ppr.hs | 10 ++++++++-- Language/Haskell/TH/Syntax.hs | 13 +++++++++---- 4 files changed, 23 insertions(+), 12 deletions(-) diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs index 9f69c32..d6c8994 100644 --- a/Language/Haskell/TH.hs +++ b/Language/Haskell/TH.hs @@ -27,17 +27,17 @@ module Language.Haskell.TH( -- | The lowercase versions (/syntax operators/) of these constructors are -- preferred to these constructors, since they compose better with -- quotations (@[| |]@) and splices (@$( ... )@) - Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind(..), Cxt, + Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..), Match(..), Clause(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..), Pat(..), FieldExp, FieldPat, Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..), - InlineSpec(..), FunDep(..), FamFlavour(..), Info(..), Loc(..), + Inline(..), InlineSpec(..), FunDep(..), FamFlavour(..), Info(..), Loc(..), Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, -- * Library functions -- ** Abbreviations - InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, CxtQ, PredQ, MatchQ, ClauseQ, BodyQ, - GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ, + InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, MatchQ, ClauseQ, + BodyQ, GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ, InlineSpecQ, -- ** Constructors lifted to 'Q' diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs index 3bf5c60..909573c 100644 --- a/Language/Haskell/TH/Lib.hs +++ b/Language/Haskell/TH/Lib.hs @@ -541,11 +541,11 @@ interruptible = Interruptible ------------------------------------------------------------------------------- -- * InlineSpec -inlineSpecNoPhase :: Bool -> Bool -> InlineSpecQ +inlineSpecNoPhase :: Inline -> Bool -> InlineSpecQ inlineSpecNoPhase inline conlike = return $ InlineSpec inline conlike Nothing -inlineSpecPhase :: Bool -> Bool -> Bool -> Int -> InlineSpecQ +inlineSpecPhase :: Inline -> Bool -> Bool -> Int -> InlineSpecQ inlineSpecPhase inline conlike beforeFrom phase = return $ InlineSpec inline conlike (Just (beforeFrom, phase)) diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs index b63ccf1..b17e4c0 100644 --- a/Language/Haskell/TH/Ppr.hs +++ b/Language/Haskell/TH/Ppr.hs @@ -326,7 +326,10 @@ instance Ppr Foreign where instance Ppr Pragma where ppr (InlineP n (InlineSpec inline conlike activation)) = text "{-#" - <+> (if inline then text "INLINE" else text "NOINLINE") + <+> text (case inline of + NoInline -> "NOINLINE" + Inline -> "INLINE" + Inlinable -> "INLINABLE") <+> (if conlike then text "CONLIKE" else empty) <+> ppr_activation activation <+> ppr n @@ -339,7 +342,10 @@ instance Ppr Pragma where ] ppr (SpecialiseP n ty (Just (InlineSpec inline _conlike activation))) = sep [ text "{-# SPECIALISE" <+> - (if inline then text "INLINE" else text "NOINLINE") <+> + text (case inline of + NoInline -> "NOINLINE" + Inline -> "INLINE" + Inlinable -> "INLINABLE") <+> ppr_activation activation , ppr n <+> text "::" , ppr ty diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs index ae444d7..cb1a20f 100644 --- a/Language/Haskell/TH/Syntax.hs +++ b/Language/Haskell/TH/Syntax.hs @@ -35,13 +35,13 @@ module Language.Haskell.TH.Syntax( -- * The algebraic data types -- $infix - Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind(..),Cxt, + Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind, Cxt, TyLit(..), Pred(..), Match(..), Clause(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..), Pat(..), FieldExp, FieldPat, Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..), - InlineSpec(..), StrictType, VarStrictType, FunDep(..), FamFlavour(..), - Info(..), Loc(..), CharPos, + Inline(..), InlineSpec(..), StrictType, VarStrictType, FunDep(..), + FamFlavour(..), Info(..), Loc(..), CharPos, Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, -- * Internal functions @@ -956,8 +956,13 @@ data Pragma = InlineP Name InlineSpec | SpecialiseP Name Type (Maybe InlineSpec) deriving( Show, Eq, Data, Typeable ) +data Inline = NoInline + | Inline + | Inlinable + deriving (Show, Eq, Data, Typeable) + data InlineSpec - = InlineSpec Bool -- False: no inline; True: inline + = InlineSpec Inline Bool -- False: fun-like; True: constructor-like (Maybe (Bool, Int)) -- False: before phase; True: from phase deriving( Show, Eq, Data, Typeable ) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
