[commit: template-haskell] master: Add INLINABLE pragmas in Template Haskell (6c0b59b)

[Simon Peyton Jones]

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 <simonpj at microsoft.com>
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 )