Add TH support for annotations (#8340)
authorAustin Seipp <austin@well-typed.com>
Wed, 2 Oct 2013 02:09:43 +0000 (21:09 -0500)
committerAustin Seipp <austin@well-typed.com>
Wed, 2 Oct 2013 02:49:53 +0000 (21:49 -0500)
Authored-by: Gergely Risko <gergely@risko.hu>
Signed-off-by: Austin Seipp <austin@well-typed.com>
libraries/template-haskell/Language/Haskell/TH.hs
libraries/template-haskell/Language/Haskell/TH/Lib.hs
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs

index 38c91fe..7133b61 100644 (file)
@@ -53,7 +53,7 @@ module Language.Haskell.TH(
     -- ** Declarations
        Dec(..), Con(..), Clause(..), 
        Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),
-       Inline(..), RuleMatch(..), Phases(..), RuleBndr(..),
+       Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),
        FunDep(..), FamFlavour(..), TySynEqn(..),
        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
     -- ** Expressions
@@ -129,7 +129,7 @@ module Language.Haskell.TH(
     cCall, stdCall, unsafe, safe, forImpD,
     -- **** Pragmas
     ruleVar, typedRuleVar,
-    pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD,
+    pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,
 
        -- * Pretty-printer
     Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType
index 94696b8..2480ff3 100644 (file)
@@ -404,6 +404,12 @@ pragRuleD n bndrs lhs rhs phases
       rhs1   <- rhs
       return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases
 
+pragAnnD :: AnnTarget -> ExpQ -> DecQ
+pragAnnD target expr
+  = do
+      exp1 <- expr
+      return $ PragmaD $ AnnP target exp1
+
 familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
 familyNoKindD flav tc tvs = return $ FamilyD flav tc tvs Nothing
 
index 8222085..ce9fe15 100644 (file)
@@ -395,6 +395,11 @@ instance Ppr Pragma where
                        | otherwise  =   text "forall"
                                     <+> fsep (map ppr bndrs)
                                     <+> char '.'
+    ppr (AnnP tgt expr)
+       = text "{-# ANN" <+> target1 tgt <+> ppr expr <+> text "#-}"
+      where target1 ModuleAnnotation    = text "module"
+            target1 (TypeAnnotation t)  = text "type" <+> ppr t
+            target1 (ValueAnnotation v) = ppr v
 
 ------------------------------
 instance Ppr Inline where
index d59ffff..234225e 100644 (file)
@@ -1209,6 +1209,7 @@ data Pragma = InlineP         Name Inline RuleMatch Phases
             | SpecialiseP     Name Type (Maybe Inline) Phases
             | SpecialiseInstP Type
             | RuleP           String [RuleBndr] Exp Exp Phases
+            | AnnP            AnnTarget Exp
         deriving( Show, Eq, Data, Typeable )
 
 data Inline = NoInline
@@ -1229,6 +1230,11 @@ data RuleBndr = RuleVar Name
               | TypedRuleVar Name Type
               deriving (Show, Eq, Data, Typeable)
 
+data AnnTarget = ModuleAnnotation
+               | TypeAnnotation Name
+               | ValueAnnotation Name
+              deriving (Show, Eq, Data, Typeable)
+
 type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@
 
 data Pred = ClassP Name [Type]    -- ^ @Eq (Int, a)@