diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs
--- a/Language/Haskell/TH.hs
+++ b/Language/Haskell/TH.hs
@@ -19,7 +19,9 @@
 	-- ** Querying the compiler
 	-- *** Reify
 	reify, 		  -- :: Name -> Q Info
-	Info(..),
+	reifyModule,
+	thisModule,
+	Info(..), ModuleInfo(..),
 	InstanceDec,
 	ParentName,
 	Arity,
@@ -30,7 +32,14 @@
 	-- *** Instance lookup
 	reifyInstances,
 	isInstance,
+        -- *** Roles lookup
+        reifyRoles,
+        -- *** Annotation lookup
+        reifyAnnotations, AnnLookup(..),
 
+	-- * Typed expressions
+	TExp, unType,
+
 	-- * Names
 	Name, NameSpace,	-- Abstract
 	-- ** Constructing names
@@ -51,21 +60,21 @@
     -- ** Declarations
 	Dec(..), Con(..), Clause(..), 
 	Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),
-	Inline(..), RuleMatch(..), Phases(..), RuleBndr(..),
-	FunDep(..), FamFlavour(..),
+	Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),
+	FunDep(..), FamFlavour(..), TySynEqn(..),
 	Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
     -- ** Expressions
         Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),
     -- ** Patterns
         Pat(..), FieldExp, FieldPat,
     -- ** Types
-        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..),
+        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..), Syntax.Role(..),
 
     -- * Library functions
     -- ** Abbreviations
         InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, MatchQ, ClauseQ,
         BodyQ, GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,
-        RuleBndrQ,
+        RuleBndrQ, TySynEqnQ,
 
     -- ** Constructors lifted to 'Q'
     -- *** Literals
@@ -108,27 +117,33 @@
     -- *** Kinds
   varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,
 
+    -- *** Roles
+    nominalR, representationalR, phantomR, inferR,
+
     -- *** Top Level Declarations
     -- **** Data
 	valD, funD, tySynD, dataD, newtypeD,
     -- **** Class
     classD, instanceD, sigD,
+    -- **** Role annotations
+    roleAnnotD,
     -- **** Type Family / Data Family
     familyNoKindD, familyKindD, dataInstD,
+    closedTypeFamilyNoKindD, closedTypeFamilyKindD,
     newtypeInstD, tySynInstD,
-    typeFam, dataFam,
+    typeFam, dataFam, tySynEqn,
     -- **** Foreign Function Interface (FFI)
     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
 
    ) where
 
-import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Syntax as Syntax
 import Language.Haskell.TH.Lib
 import Language.Haskell.TH.Ppr
 
diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs
--- a/Language/Haskell/TH/Lib.hs
+++ b/Language/Haskell/TH/Lib.hs
@@ -7,7 +7,8 @@
     -- be "public" functions.  The main module TH
     -- re-exports them all.
 
-import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Syntax hiding (Role)
+import qualified Language.Haskell.TH.Syntax as TH
 import Control.Monad( liftM, liftM2 )
 import Data.Word( Word8 )
 
@@ -19,6 +20,7 @@
 type PatQ           = Q Pat
 type FieldPatQ      = Q FieldPat
 type ExpQ           = Q Exp
+type TExpQ a        = Q (TExp a)
 type DecQ           = Q Dec
 type DecsQ          = Q [Dec]
 type ConQ           = Q Con
@@ -36,6 +38,8 @@
 type VarStrictTypeQ = Q VarStrictType
 type FieldExpQ      = Q FieldExp
 type RuleBndrQ      = Q RuleBndr
+type TySynEqnQ      = Q TySynEqn
+type Role           = TH.Role       -- must be defined here for DsMeta to find it
 
 ----------------------------------------------------------
 -- * Lowercase pattern syntax functions
@@ -127,23 +131,23 @@
 noBindS e = do { e1 <- e; return (NoBindS e1) }
 
 parS :: [[StmtQ]] -> StmtQ
-parS _ = fail "No parallel comprehensions yet"
+parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
 
 -------------------------------------------------------------------------------
 -- *   Range
 
 fromR :: ExpQ -> RangeQ
-fromR x = do { a <- x; return (FromR a) }  
+fromR x = do { a <- x; return (FromR a) }
 
 fromThenR :: ExpQ -> ExpQ -> RangeQ
-fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }  
+fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
 
 fromToR :: ExpQ -> ExpQ -> RangeQ
-fromToR x y = do { a <- x; b <- y; return (FromToR a b) }  
+fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
 
 fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
 fromThenToR x y z = do { a <- x; b <- y; c <- z;
-                         return (FromThenToR a b c) }  
+                         return (FromThenToR a b c) }
 -------------------------------------------------------------------------------
 -- *   Body
 
@@ -192,10 +196,12 @@
 -- *   Exp
 
 -- | Dynamically binding a variable (unhygenic)
-dyn :: String -> Q Exp 
+dyn :: String -> ExpQ
 dyn s = return (VarE (mkName s))
 
 global :: Name -> ExpQ
+{-# DEPRECATED global "Use varE instead" #-}
+-- Trac #8656; I have no idea why this function is duplicated
 global s = return (VarE s)
 
 varE :: Name -> ExpQ
@@ -261,16 +267,16 @@
 letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
 
 caseE :: ExpQ -> [MatchQ] -> ExpQ
-caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) } 
+caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
 
 doE :: [StmtQ] -> ExpQ
-doE ss = do { ss1 <- sequence ss; return (DoE ss1) } 
+doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
 
 compE :: [StmtQ] -> ExpQ
-compE ss = do { ss1 <- sequence ss; return (CompE ss1) } 
+compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
 
 arithSeqE :: RangeQ -> ExpQ
-arithSeqE r = do { r' <- r; return (ArithSeqE r') }  
+arithSeqE r = do { r' <- r; return (ArithSeqE r') }
 
 listE :: [ExpQ] -> ExpQ
 listE es = do { es1 <- sequence es; return (ListE es1) }
@@ -292,24 +298,24 @@
 
 -- ** 'arithSeqE' Shortcuts
 fromE :: ExpQ -> ExpQ
-fromE x = do { a <- x; return (ArithSeqE (FromR a)) }  
+fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
 
 fromThenE :: ExpQ -> ExpQ -> ExpQ
-fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }  
+fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
 
 fromToE :: ExpQ -> ExpQ -> ExpQ
-fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }  
+fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
 
 fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
 fromThenToE x y z = do { a <- x; b <- y; c <- z;
-                         return (ArithSeqE (FromThenToR a b c)) }  
+                         return (ArithSeqE (FromThenToR a b c)) }
 
 
 -------------------------------------------------------------------------------
 -- *   Dec
 
 valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
-valD p b ds = 
+valD p b ds =
   do { p' <- p
      ; ds' <- sequence ds
      ; b' <- b
@@ -317,7 +323,7 @@
      }
 
 funD :: Name -> [ClauseQ] -> DecQ
-funD nm cs = 
+funD nm cs =
  do { cs1 <- sequence cs
     ; return (FunD nm cs1)
     }
@@ -341,14 +347,14 @@
 
 classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ
 classD ctxt cls tvs fds decs =
-  do 
+  do
     decs1 <- sequence decs
     ctxt1 <- ctxt
     return $ ClassD ctxt1 cls tvs fds decs1
 
 instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
 instanceD ctxt ty decs =
-  do 
+  do
     ctxt1 <- ctxt
     decs1 <- sequence decs
     ty1   <- ty
@@ -401,6 +407,12 @@
       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
 
@@ -423,12 +435,33 @@
     con1  <- con
     return (NewtypeInstD ctxt1 tc tys1 con1 derivs)
 
-tySynInstD :: Name -> [TypeQ] -> TypeQ -> DecQ
-tySynInstD tc tys rhs = 
-  do 
-    tys1 <- sequence tys
+tySynInstD :: Name -> TySynEqnQ -> DecQ
+tySynInstD tc eqn =
+  do
+    eqn1 <- eqn
+    return (TySynInstD tc eqn1)
+
+closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ
+closedTypeFamilyNoKindD tc tvs eqns =
+  do
+    eqns1 <- sequence eqns
+    return (ClosedTypeFamilyD tc tvs Nothing eqns1)
+
+closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ
+closedTypeFamilyKindD tc tvs kind eqns =
+  do
+    eqns1 <- sequence eqns
+    return (ClosedTypeFamilyD tc tvs (Just kind) eqns1)
+
+roleAnnotD :: Name -> [Role] -> DecQ
+roleAnnotD name roles = return $ RoleAnnotD name roles
+
+tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
+tySynEqn lhs rhs =
+  do
+    lhs1 <- sequence lhs
     rhs1 <- rhs
-    return (TySynInstD tc tys1 rhs1)
+    return (TySynEqn lhs1 rhs1)
 
 cxt :: [PredQ] -> CxtQ
 cxt = sequence
@@ -572,6 +605,15 @@
 constraintK = ConstraintT
 
 -------------------------------------------------------------------------------
+-- *   Role
+
+nominalR, representationalR, phantomR, inferR :: Role
+nominalR          = NominalR
+representationalR = RepresentationalR
+phantomR          = PhantomR
+inferR            = InferR
+
+-------------------------------------------------------------------------------
 -- *   Callconv
 
 cCall, stdCall :: Callconv
@@ -615,3 +657,9 @@
 appsE [x] = x
 appsE (x:y:zs) = appsE ( (appE x y) : zs )
 
+-- | Return the Module at the place of splicing.  Can be used as an
+-- input for 'reifyModule'.
+thisModule :: Q Module
+thisModule = do
+  loc <- location
+  return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs
--- a/Language/Haskell/TH/Ppr.hs
+++ b/Language/Haskell/TH/Ppr.hs
@@ -10,8 +10,9 @@
 import Language.Haskell.TH.PprLib
 import Language.Haskell.TH.Syntax
 import Data.Word ( Word8 )
-import Data.Char ( toLower, chr )
+import Data.Char ( toLower, chr, ord, isSymbol )
 import GHC.Show  ( showMultiLineString )
+import Data.Ratio ( numerator, denominator )
 
 nestDepth :: Int
 nestDepth = 4
@@ -52,7 +53,7 @@
     ppr (PrimTyConI name arity is_unlifted) 
       = text "Primitive"
 	<+> (if is_unlifted then text "unlifted" else empty)
-	<+> text "type construtor" <+> quotes (ppr name)
+	<+> text "type constructor" <+> quotes (ppr name)
 	<+> parens (text "arity" <+> int arity)
     ppr (ClassOpI v ty cls fix) 
       = text "Class op from" <+> ppr cls <> colon <+>
@@ -78,13 +79,34 @@
 
 
 ------------------------------
+instance Ppr Module where
+  ppr (Module pkg m) = text (pkgString pkg) <+> text (modString m)
+
+instance Ppr ModuleInfo where
+  ppr (ModuleInfo imps) = text "Module" <+> vcat (map ppr imps)
+
+------------------------------
 instance Ppr Exp where
     ppr = pprExp noPrec
 
+pprPrefixOcc :: Name -> Doc
+-- Print operators with parens around them
+pprPrefixOcc n = parensIf (isSymOcc n) (ppr n)
+
+isSymOcc :: Name -> Bool
+isSymOcc n
+  = case nameBase n of 
+      []    -> True  -- Empty name; weird
+      (c:_) -> isSymbolASCII c || (ord c > 0x7f && isSymbol c) 
+                   -- c.f. OccName.startsVarSym in GHC itself
+
+isSymbolASCII :: Char -> Bool
+isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
+
 pprInfixExp :: Exp -> Doc
 pprInfixExp (VarE v) = pprName' Infix v
 pprInfixExp (ConE v) = pprName' Infix v
-pprInfixExp _        = error "Attempt to pretty-print non-variable or constructor in infix context!"
+pprInfixExp _        = text "<<Non-variable/constructor in infix context>>"
 
 pprExp :: Precedence -> Exp -> Doc
 pprExp _ (VarE v)     = pprName' Applied v
@@ -121,13 +143,23 @@
         []            -> [text "if {}"]
         (alt : alts') -> text "if" <+> pprGuarded arrow alt
                          : map (nest 3 . pprGuarded arrow) alts'
-pprExp i (LetE ds e) = parensIf (i > noPrec) $ text "let" <+> ppr ds
-                                            $$ text " in" <+> ppr e
+pprExp i (LetE ds_ e) = parensIf (i > noPrec) $ text "let" <+> pprDecs ds_
+                                             $$ text " in" <+> ppr e
+  where
+    pprDecs []  = empty
+    pprDecs [d] = ppr d
+    pprDecs ds  = braces $ sep $ punctuate semi $ map ppr ds
+
 pprExp i (CaseE e ms)
  = parensIf (i > noPrec) $ text "case" <+> ppr e <+> text "of"
                         $$ nest nestDepth (ppr ms)
-pprExp i (DoE ss) = parensIf (i > noPrec) $ text "do" <+> ppr ss
-pprExp _ (CompE []) = error "Can't happen: pprExp (CompExp [])"
+pprExp i (DoE ss_) = parensIf (i > noPrec) $ text "do" <+> pprStms ss_
+  where
+    pprStms []  = empty
+    pprStms [s] = ppr s
+    pprStms ss  = braces $ sep $ punctuate semi $ map ppr ss
+    
+pprExp _ (CompE []) = text "<<Empty CompExp>>"
 -- This will probably break with fixity declarations - would need a ';'
 pprExp _ (CompE ss) = text "[" <> ppr s
                   <+> text "|"
@@ -189,7 +221,9 @@
 pprLit _ (CharL c)       = text (show c)
 pprLit _ (StringL s)     = pprString s
 pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#'
-pprLit i (RationalL rat) = parensIf (i > noPrec) $ rational rat
+pprLit i (RationalL rat) = parensIf (i > noPrec) $
+                           integer (numerator rat) <+> char '/' 
+                              <+> integer (denominator rat)
 
 bytesToString :: [Word8] -> String
 bytesToString = map (chr . fromIntegral)
@@ -239,7 +273,7 @@
 ppr_dec :: Bool     -- declaration on the toplevel?
         -> Dec 
         -> Doc
-ppr_dec _ (FunD f cs)   = vcat $ map (\c -> ppr f <+> ppr c) cs
+ppr_dec _ (FunD f cs)   = vcat $ map (\c -> pprPrefixOcc f <+> ppr c) cs
 ppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r
                           $$ where_clause ds
 ppr_dec _ (TySynD t xs rhs) 
@@ -253,7 +287,7 @@
     $$ where_clause ds
 ppr_dec _ (InstanceD ctxt i ds) = text "instance" <+> pprCxt ctxt <+> ppr i
                                   $$ where_clause ds
-ppr_dec _ (SigD f t)    = ppr f <+> text "::" <+> ppr t
+ppr_dec _ (SigD f t)    = pprPrefixOcc f <+> text "::" <+> ppr t
 ppr_dec _ (ForeignD f)  = ppr f
 ppr_dec _ (InfixD fx n) = pprFixity n fx
 ppr_dec _ (PragmaD p)   = ppr p
@@ -275,12 +309,24 @@
   where
     maybeInst | isTop     = text "instance"
               | otherwise = empty
-ppr_dec isTop (TySynInstD tc tys rhs) 
+ppr_dec isTop (TySynInstD tc (TySynEqn tys rhs))
   = ppr_tySyn maybeInst tc (sep (map pprParendType tys)) rhs
   where
     maybeInst | isTop     = text "instance"
               | otherwise = empty
+ppr_dec _ (ClosedTypeFamilyD tc tvs mkind eqns)
+  = hang (hsep [ text "type family", ppr tc, hsep (map ppr tvs), maybeKind
+               , text "where" ])
+      nestDepth (vcat (map ppr_eqn eqns))
+  where
+    maybeKind | (Just k') <- mkind = text "::" <+> ppr k'
+              | otherwise          = empty
+    ppr_eqn (TySynEqn lhs rhs)
+      = ppr tc <+> sep (map pprParendType lhs) <+> text "=" <+> ppr rhs
 
+ppr_dec _ (RoleAnnotD name roles)
+  = hsep [ text "type role", ppr name ] <+> hsep (map ppr roles)
+
 ppr_data :: Doc -> Cxt -> Name -> Doc -> [Con] -> [Name] -> Doc
 ppr_data maybeInst ctxt t argsDoc cs decs
   = sep [text "data" <+> maybeInst
@@ -366,6 +412,11 @@
                        | 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
@@ -475,6 +526,12 @@
 instance Ppr TyVarBndr where
     ppr (PlainTV nm)    = ppr nm
     ppr (KindedTV nm k) = parens (ppr nm <+> text "::" <+> ppr k)
+
+instance Ppr Role where
+    ppr NominalR          = text "nominal"
+    ppr RepresentationalR = text "representational"
+    ppr PhantomR          = text "phantom"
+    ppr InferR            = text "_"
 
 ------------------------------
 pprCxt :: Cxt -> Doc
diff --git a/Language/Haskell/TH/PprLib.hs b/Language/Haskell/TH/PprLib.hs
--- a/Language/Haskell/TH/PprLib.hs
+++ b/Language/Haskell/TH/PprLib.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, MagicHash #-}
 
 -- | Monadic front-end to Text.PrettyPrint
 
@@ -38,7 +38,8 @@
 import Language.Haskell.TH.Syntax
     (Name(..), showName', NameFlavour(..), NameIs(..))
 import qualified Text.PrettyPrint as HPJ
-import Control.Monad (liftM, liftM2)
+import Control.Applicative (Applicative(..))
+import Control.Monad (liftM, liftM2, ap)
 import Data.Map ( Map )
 import qualified Data.Map as Map ( lookup, insert, empty )
 import GHC.Base (Int(..))
@@ -146,6 +147,13 @@
 
 to_HPJ_Doc :: Doc -> HPJ.Doc
 to_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)
+
+instance Functor PprM where
+      fmap = liftM
+
+instance Applicative PprM where
+      pure = return
+      (<*>) = ap
 
 instance Monad PprM where
     return x = PprM $ \s -> (x, s)
diff --git a/Language/Haskell/TH/Quote.hs b/Language/Haskell/TH/Quote.hs
--- a/Language/Haskell/TH/Quote.hs
+++ b/Language/Haskell/TH/Quote.hs
@@ -75,7 +75,7 @@
 -- the data out of a file.  For example, suppose 'asmq' is an 
 -- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]
 -- as an expression. Then if you define @asmq_f = quoteFile asmq@, then
--- the quote [asmq_f| foo.s |] will take input from file "foo.s" instead
+-- the quote [asmq_f|foo.s|] will take input from file @"foo.s"@ instead
 -- of the inline text
 quoteFile :: QuasiQuoter -> QuasiQuoter
 quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd }) 
@@ -83,4 +83,5 @@
   where
    get :: (String -> Q a) -> String -> Q a
    get old_quoter file_name = do { file_cts <- runIO (readFile file_name) 
+                                 ; addDependentFile file_name
                                  ; old_quoter file_cts }
diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs
--- a/Language/Haskell/TH/Syntax.hs
+++ b/Language/Haskell/TH/Syntax.hs
@@ -1,17 +1,11 @@
-{-# LANGUAGE UnboxedTuples #-}
-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
--- The -fno-warn-warnings-deprecations flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
+{-# LANGUAGE DeriveDataTypeable, MagicHash, PolymorphicComponents, RoleAnnotations, UnboxedTuples #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Language.Haskell.Syntax
 -- Copyright   :  (c) The University of Glasgow 2003
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
+--
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  portable
@@ -22,8 +16,7 @@
 
 module Language.Haskell.TH.Syntax where
 
-import GHC.Base		( Int(..), Int#, (<#), (==#) )
-
+import GHC.Exts
 import Data.Data (Data(..), Typeable, mkConstr, mkDataType, constrIndex)
 import qualified Data.Data as Data
 import Control.Applicative( Applicative(..) )
@@ -31,7 +24,7 @@
 import System.IO.Unsafe	( unsafePerformIO )
 import Control.Monad (liftM)
 import System.IO	( hPutStrLn, stderr )
-import Data.Char        ( isAlpha )
+import Data.Char        ( isAlpha, isAlphaNum, isUpper )
 import Data.Word        ( Word8 )
 
 -----------------------------------------------------
@@ -50,16 +43,19 @@
   qRecover :: m a -- ^ the error handler
            -> m a -- ^ action which may fail
            -> m a		-- ^ Recover from the monadic 'fail'
- 
+
 	-- Inspect the type-checker's environment
   qLookupName :: Bool -> String -> m (Maybe Name)
        -- True <=> type namespace, False <=> value namespace
   qReify          :: Name -> m Info
   qReifyInstances :: Name -> [Type] -> m [Dec]
        -- Is (n tys) an instance?
-       -- Returns list of matching instance Decs 
+       -- Returns list of matching instance Decs
        --    (with empty sub-Decs)
        -- Works for classes and type functions
+  qReifyRoles       :: Name -> m [Role]
+  qReifyAnnotations :: Data a => AnnLookup -> m [a]
+  qReifyModule      :: Module -> m ModuleInfo
 
   qLocation :: m Loc
 
@@ -68,9 +64,17 @@
 
   qAddDependentFile :: FilePath -> m ()
 
+  qAddTopDecls :: [Dec] -> m ()
+
+  qAddModFinalizer :: Q () -> m ()
+
+  qGetQ :: Typeable a => m (Maybe a)
+
+  qPutQ :: Typeable a => a -> m ()
+
 -----------------------------------------------------
 --	The IO instance of Quasi
--- 
+--
 --  This instance is used only when running a Q
 --  computation in the IO monad, usually just to
 --  print the result.  There is no interesting
@@ -89,13 +93,20 @@
 
   qLookupName _ _     = badIO "lookupName"
   qReify _            = badIO "reify"
-  qReifyInstances _ _ = badIO "classInstances"
+  qReifyInstances _ _ = badIO "reifyInstances"
+  qReifyRoles _       = badIO "reifyRoles"
+  qReifyAnnotations _ = badIO "reifyAnnotations"
+  qReifyModule _      = badIO "reifyModule"
   qLocation    	      = badIO "currentLocation"
   qRecover _ _ 	      = badIO "recover" -- Maybe we could fix this?
   qAddDependentFile _ = badIO "addDependentFile"
+  qAddTopDecls _      = badIO "addTopDecls"
+  qAddModFinalizer _  = badIO "addModFinalizer"
+  qGetQ               = badIO "getQ"
+  qPutQ _             = badIO "putQ"
 
   qRunIO m = m
-  
+
 badIO :: String -> IO a
 badIO op = do	{ qReport True ("Can't do `" ++ op ++ "' in the IO monad")
 		; fail "Template Haskell failure" }
@@ -119,7 +130,7 @@
 -- are the usual way of running a 'Q' computation.
 --
 -- This function is primarily used in GHC internals, and for debugging
--- splices by running them in 'IO'. 
+-- splices by running them in 'IO'.
 --
 -- Note that many functions in 'Q', such as 'reify' and other compiler
 -- queries, are not supported when running 'Q' in 'IO'; these operations
@@ -137,15 +148,45 @@
 instance Functor Q where
   fmap f (Q x) = Q (fmap f x)
 
-instance Applicative Q where 
-  pure x = Q (pure x) 
-  Q f <*> Q x = Q (f <*> x) 
+instance Applicative Q where
+  pure x = Q (pure x)
+  Q f <*> Q x = Q (f <*> x)
 
+-----------------------------------------------------
+--
+--		The TExp type
+--
+-----------------------------------------------------
+
+type role TExp nominal   -- See Note [Role of TExp]
+newtype TExp a = TExp { unType :: Exp }
+
+unTypeQ :: Q (TExp a) -> Q Exp
+unTypeQ m = do { TExp e <- m
+               ; return e }
+
+unsafeTExpCoerce :: Q Exp -> Q (TExp a)
+unsafeTExpCoerce m = do { e <- m
+                        ; return (TExp e) }
+
+{- Note [Role of TExp]
+~~~~~~~~~~~~~~~~~~~~~~
+TExp's argument must have a nominal role, not phantom as would
+be inferred (Trac #8459).  Consider
+
+  e :: TExp Age
+  e = MkAge 3
+
+  foo = $(coerce e) + 4::Int
+
+The splice will evaluate to (MkAge 3) and you can't add that to
+4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}
+
 ----------------------------------------------------
 -- Packaged versions for the programmer, hiding the Quasi-ness
 
-{- | 
-Generate a fresh name, which cannot be captured. 
+{- |
+Generate a fresh name, which cannot be captured.
 
 For example, this:
 
@@ -181,11 +222,11 @@
 newName :: String -> Q Name
 newName s = Q (qNewName s)
 
--- | Report an error (True) or warning (False), 
+-- | Report an error (True) or warning (False),
 -- but carry on; use 'fail' to stop.
 report  :: Bool -> String -> Q ()
 report b s = Q (qReport b s)
-{-# DEPRECATED report "Use reportError or reportWarning instead" #-}
+{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6
 
 -- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
 reportError :: String -> Q ()
@@ -230,7 +271,7 @@
 there is, the @Name@ of this value is returned;
 if not, then @Nothing@ is returned.
 
-The returned name cannot be \"captured\". 
+The returned name cannot be \"captured\".
 For example:
 
 > f = "global"
@@ -246,7 +287,7 @@
 being run. For example:
 
 > f = "global"
-> g = $( [| let f = "local" in 
+> g = $( [| let f = "local" in
 >            $(do
 >                Just nm <- lookupValueName "f"
 >                varE nm
@@ -286,7 +327,7 @@
 reify :: Name -> Q Info
 reify v = Q (qReify v)
 
-{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is, 
+{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is,
 if @nm@ is the name of a type class, then all instances of this class at the types @tys@
 are returned. Alternatively, if @nm@ is the name of a data family or type family,
 all instances of this family at the types @tys@ are returned.
@@ -294,6 +335,26 @@
 reifyInstances :: Name -> [Type] -> Q [InstanceDec]
 reifyInstances cls tys = Q (qReifyInstances cls tys)
 
+{- | @reifyRoles nm@ returns the list of roles associated with the parameters of
+the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
+The returned list should never contain 'InferR'.
+-}
+reifyRoles :: Name -> Q [Role]
+reifyRoles nm = Q (qReifyRoles nm)
+
+-- | @reifyAnnotations target@ returns the list of annotations
+-- associated with @target@.  Only the annotations that are
+-- appropriately typed is returned.  So if you have @Int@ and @String@
+-- annotations for the same target, you have to call this function twice.
+reifyAnnotations :: Data a => AnnLookup -> Q [a]
+reifyAnnotations an = Q (qReifyAnnotations an)
+
+-- | @reifyModule mod@ looks up information about module @mod@.  To
+-- look up the current module, call this function with the return
+-- value of @thisModule@.
+reifyModule :: Module -> Q ModuleInfo
+reifyModule m = Q (qReifyModule m)
+
 -- | Is the list of instances returned by 'reifyInstances' nonempty?
 isInstance :: Name -> [Type] -> Q Bool
 isInstance nm tys = do { decs <- reifyInstances nm tys
@@ -304,10 +365,10 @@
 location = Q qLocation
 
 -- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
--- Take care: you are guaranteed the ordering of calls to 'runIO' within 
--- a single 'Q' computation, but not about the order in which splices are run.  
+-- Take care: you are guaranteed the ordering of calls to 'runIO' within
+-- a single 'Q' computation, but not about the order in which splices are run.
 --
--- Note: for various murky reasons, stdout and stderr handles are not 
+-- Note: for various murky reasons, stdout and stderr handles are not
 -- necesarily flushed when the  compiler finishes running, so you should
 -- flush them yourself.
 runIO :: IO a -> Q a
@@ -320,16 +381,41 @@
 addDependentFile :: FilePath -> Q ()
 addDependentFile fp = Q (qAddDependentFile fp)
 
+-- | Add additional top-level declarations. The added declarations will be type
+-- checked along with the current declaration group.
+addTopDecls :: [Dec] -> Q ()
+addTopDecls ds = Q (qAddTopDecls ds)
+
+-- | Add a finalizer that will run in the Q monad after the current module has
+-- been type checked. This only makes sense when run within a top-level splice.
+addModFinalizer :: Q () -> Q ()
+addModFinalizer act = Q (qAddModFinalizer (unQ act))
+
+-- | Get state from the Q monad.
+getQ :: Typeable a => Q (Maybe a)
+getQ = Q qGetQ
+
+-- | Replace the state in the Q monad.
+putQ :: Typeable a => a -> Q ()
+putQ x = Q (qPutQ x)
+
 instance Quasi Q where
   qNewName  	    = newName
   qReport   	    = report
-  qRecover  	    = recover 
+  qRecover  	    = recover
   qReify    	    = reify
   qReifyInstances   = reifyInstances
+  qReifyRoles       = reifyRoles
+  qReifyAnnotations = reifyAnnotations
+  qReifyModule      = reifyModule
   qLookupName       = lookupName
   qLocation 	    = location
   qRunIO    	    = runIO
   qAddDependentFile = addDependentFile
+  qAddTopDecls      = addTopDecls
+  qAddModFinalizer  = addModFinalizer
+  qGetQ             = getQ
+  qPutQ             = putQ
 
 
 ----------------------------------------------------
@@ -354,7 +440,7 @@
 
 class Lift t where
   lift :: t -> Q Exp
-  
+
 instance Lift Integer where
   lift x = return (LitE (IntegerL x))
 
@@ -414,7 +500,7 @@
 -- which we should take advantage of.
 -- NB: the lhs of the rule has no args, so that
 --     the rule will apply to a 'lift' all on its own
---     which happens to be the way the type checker 
+--     which happens to be the way the type checker
 --     creates it.
 {-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
 
@@ -433,17 +519,21 @@
 
 
 -----------------------------------------------------
---		Names and uniques 
+--		Names and uniques
 -----------------------------------------------------
 
 newtype ModName = ModName String	-- Module name
- deriving (Eq,Ord,Typeable,Data)
+ deriving (Show,Eq,Ord,Typeable,Data)
 
 newtype PkgName = PkgName String	-- package name
- deriving (Eq,Ord,Typeable,Data)
+ deriving (Show,Eq,Ord,Typeable,Data)
 
+-- | Obtained from 'reifyModule' and 'thisModule'.
+data Module = Module PkgName ModName -- package qualified module name
+ deriving (Show,Eq,Ord,Typeable,Data)
+
 newtype OccName = OccName String
- deriving (Eq,Ord,Typeable,Data)
+ deriving (Show,Eq,Ord,Typeable,Data)
 
 mkModName :: String -> ModName
 mkModName s = ModName s
@@ -473,7 +563,7 @@
 -----------------------------------------------------
 --		 Names
 -----------------------------------------------------
--- 
+--
 -- For "global" names ('NameG') we need a totally unique name,
 -- so we must include the name-space of the thing
 --
@@ -522,7 +612,7 @@
 > g x = let x' = 0 in x
 > h y = let x' = 0 in y
 
-which avoids name capture as desired. 
+which avoids name capture as desired.
 
 In the general case, we say that a @Name@ can be captured if
 the thing it refers to can be changed by adding new declarations.
@@ -535,19 +625,19 @@
 name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for
 an explanation of name capture):
 
-  * the built-in syntax @'f@ and @''T@ can be used to construct names, 
-    The expression @'f@ gives a @Name@ which refers to the value @f@ 
+  * the built-in syntax @'f@ and @''T@ can be used to construct names,
+    The expression @'f@ gives a @Name@ which refers to the value @f@
     currently in scope, and @''T@ gives a @Name@ which refers to the
     type @T@ currently in scope. These names can never be captured.
-    
-  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and 
+
+  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and
      @''T@ respectively, but the @Name@s are looked up at the point
      where the current splice is being run. These names can never be
      captured.
 
   * 'newName' monadically generates a new name, which can never
      be captured.
-     
+
   * 'mkName' generates a capturable name.
 
 Names constructed using @newName@ and @mkName@ may be used in bindings
@@ -563,7 +653,7 @@
   | NameL Int#      -- ^ Local name bound outside of the TH AST
   | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:
                 -- An original name (occurrences only, not binders)
-		-- Need the namespace too to be sure which 
+		-- Need the namespace too to be sure which
 		-- thing we are naming
   deriving ( Typeable )
 
@@ -575,7 +665,7 @@
 --
 -- The long term solution to this is to use the binary package for annotation serialization and
 -- then remove this instance. However, to do _that_ we need to wait on binary to become stable, since
--- boot libraries cannot be upgraded seperately from GHC itself.
+-- boot libraries cannot be upgraded separately from GHC itself.
 --
 -- This instance cannot be derived automatically due to bug #2701
 instance Data NameFlavour where
@@ -611,7 +701,7 @@
                              con_NameL, con_NameG]
 
 data NameSpace = VarName	-- ^ Variables
-	       | DataName	-- ^ Data constructors 
+	       | DataName	-- ^ Data constructors
 	       | TcClsName	-- ^ Type constructors and classes; Haskell has them
 				-- in the same name space for now.
 	       deriving( Eq, Ord, Data, Typeable )
@@ -628,7 +718,7 @@
 nameModule (Name _ (NameG _ _ m)) = Just (modString m)
 nameModule _                      = Nothing
 
-{- | 
+{- |
 Generate a capturable name. Occurrences of such names will be
 resolved according to the Haskell scoping rules at the occurrence
 site.
@@ -659,7 +749,7 @@
 --
 -- Parse the string to see if it has a "." in it
 -- so we know whether to generate a qualified or unqualified name
--- It's a bit tricky because we need to parse 
+-- It's a bit tricky because we need to parse
 --
 -- > Foo.Baz.x   as    Qual Foo.Baz x
 --
@@ -668,17 +758,33 @@
   = split [] (reverse str)
   where
     split occ []        = Name (mkOccName occ) NameS
-    split occ ('.':rev)	| not (null occ), 
-			  not (null rev), head rev /= '.'
+    split occ ('.':rev)	| not (null occ)
+			, is_rev_mod_name rev
 			= Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
 	-- The 'not (null occ)' guard ensures that
 	-- 	mkName "&." = Name "&." NameS
-	-- The 'rev' guards ensure that
+	-- The 'is_rev_mod' guards ensure that
 	--	mkName ".&" = Name ".&" NameS
+	--	mkName "^.." = Name "^.." NameS      -- Trac #8633
 	--	mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
 	-- This rather bizarre case actually happened; (.&.) is in Data.Bits
     split occ (c:rev)   = split (c:occ) rev
 
+    -- Recognises a reversed module name xA.yB.C, 
+    -- with at least one component, 
+    -- and each component looks like a module name
+    --   (i.e. non-empty, starts with capital, all alpha)
+    is_rev_mod_name rev_mod_str
+      | (compt, rest) <- break (== '.') rev_mod_str
+      , not (null compt), isUpper (last compt), all is_mod_char compt
+      = case rest of
+          []             -> True
+          (_dot : rest') -> is_rev_mod_name rest'
+      | otherwise
+      = False
+
+    is_mod_char c = isAlphaNum c || c == '_' || c == '\''
+
 -- | Only used internally
 mkNameU :: String -> Uniq -> Name
 mkNameU s (I# u) = Name (mkOccName s) (NameU u)
@@ -718,22 +824,22 @@
 
   (NameU _)  `compare` NameS      = GT
   (NameU _)  `compare` (NameQ _)  = GT
-  (NameU u1) `compare` (NameU u2) | u1  <# u2 = LT
-				  | u1 ==# u2 = EQ
-				  | otherwise = GT
+  (NameU u1) `compare` (NameU u2) | isTrue# (u1  <# u2) = LT
+				  | isTrue# (u1 ==# u2) = EQ
+				  | otherwise           = GT
   (NameU _)  `compare` _     = LT
 
   (NameL _)  `compare` NameS      = GT
   (NameL _)  `compare` (NameQ _)  = GT
   (NameL _)  `compare` (NameU _)  = GT
-  (NameL u1) `compare` (NameL u2) | u1  <# u2 = LT
-				  | u1 ==# u2 = EQ
-				  | otherwise = GT
+  (NameL u1) `compare` (NameL u2) | isTrue# (u1  <# u2) = LT
+				  | isTrue# (u1 ==# u2) = EQ
+				  | otherwise           = GT
   (NameL _)  `compare` _          = LT
 
   (NameG ns1 p1 m1) `compare` (NameG ns2 p2 m2) = (ns1 `compare` ns2) `thenCmp`
                                             (p1 `compare` p2) `thenCmp`
-					    (m1 `compare` m2) 
+					    (m1 `compare` m2)
   (NameG _ _ _)    `compare` _ = GT
 
 data NameIs = Alone | Applied | Infix
@@ -845,60 +951,61 @@
 
 -- | Obtained from 'reify' in the 'Q' Monad.
 data Info
-  = 
+  =
   -- | A class, with a list of its visible instances
-  ClassI 
+  ClassI
       Dec
       [InstanceDec]
-  
+
   -- | A class method
   | ClassOpI
        Name
        Type
        ParentName
        Fixity
-  
+
   -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned using 'PrimTyConI' or 'FamilyI' as appropriate
-  | TyConI 
+  | TyConI
         Dec
 
-  -- | A type or data family, with a list of its visible instances
-  | FamilyI 
+  -- | A type or data family, with a list of its visible instances. A closed
+  -- type family is returned with 0 instances.
+  | FamilyI
         Dec
         [InstanceDec]
-  
+
   -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'. Examples: @(->)@, @Int#@.
-  | PrimTyConI 
+  | PrimTyConI
        Name
        Arity
        Unlifted
-  
+
   -- | A data constructor
-  | DataConI 
+  | DataConI
        Name
        Type
        ParentName
        Fixity
 
-  {- | 
+  {- |
   A \"value\" variable (as opposed to a type variable, see 'TyVarI').
-  
-  The @Maybe Dec@ field contains @Just@ the declaration which 
-  defined the variable -- including the RHS of the declaration -- 
+
+  The @Maybe Dec@ field contains @Just@ the declaration which
+  defined the variable -- including the RHS of the declaration --
   or else @Nothing@, in the case where the RHS is unavailable to
   the compiler. At present, this value is _always_ @Nothing@:
   returning the RHS has not yet been implemented because of
   lack of interest.
   -}
-  | VarI 
+  | VarI
        Name
        Type
        (Maybe Dec)
        Fixity
 
-  {- | 
+  {- |
   A type variable.
-  
+
   The @Type@ field contains the type which underlies the variable.
   At present, this is always @'VarT' theName@, but future changes
   may permit refinement of this.
@@ -908,7 +1015,13 @@
 	Type	-- What it is bound to
   deriving( Show, Data, Typeable )
 
-{- | 
+-- | Obtained from 'reifyModule' in the 'Q' Monad.
+data ModuleInfo =
+  -- | Contains the import list of the module.
+  ModuleInfo [Module]
+  deriving( Show, Data, Typeable )
+
+{- |
 In 'ClassOpI' and 'DataConI', name of the parent class or type
 -}
 type ParentName = Name
@@ -1012,8 +1125,8 @@
 --
 -----------------------------------------------------
 
-data Lit = CharL Char 
-         | StringL String 
+data Lit = CharL Char
+         | StringL String
          | IntegerL Integer     -- ^ Used for overloaded and non-overloaded
                                 -- literals. We don't have a good way to
                                 -- represent non-overloaded literals at
@@ -1026,12 +1139,12 @@
          | StringPrimL [Word8]	-- ^ A primitive C-style string, type Addr#
     deriving( Show, Eq, Data, Typeable )
 
-    -- We could add Int, Float, Double etc, as we do in HsLit, 
+    -- We could add Int, Float, Double etc, as we do in HsLit,
     -- but that could complicate the
     -- suppposedly-simple TH.Syntax literal type
 
 -- | Pattern in Haskell given in @{}@
-data Pat 
+data Pat
   = LitP Lit                      -- ^ @{ 5 or 'c' }@
   | VarP Name                     -- ^ @{ x }@
   | TupP [Pat]                    -- ^ @{ (p1,p2) }@
@@ -1061,8 +1174,8 @@
 data Clause = Clause [Pat] Body [Dec]
                                   -- ^ @f { p1 p2 = body where decs }@
     deriving( Show, Eq, Data, Typeable )
- 
-data Exp 
+
+data Exp
   = VarE Name                          -- ^ @{ x }@
   | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @
   | LitE Lit                           -- ^ @{ 5 or 'c'}@
@@ -1091,7 +1204,7 @@
   | LetE [Dec] Exp                     -- ^ @{ let x=e1;   y=e2 in e3 }@
   | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@
   | DoE [Stmt]                         -- ^ @{ do { p <- e1; e2 }  }@
-  | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@ 
+  | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@
       --
       -- The result expression of the comprehension is
       -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.
@@ -1114,8 +1227,8 @@
 -- Omitted: implicit parameters
 
 data Body
-  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2 
-                                 --      | e3 = e4 } 
+  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2
+                                 --      | e3 = e4 }
                                  -- where ds@
   | NormalB Exp              -- ^ @f p { = e } where ds@
   deriving( Show, Eq, Data, Typeable )
@@ -1135,18 +1248,18 @@
 data Range = FromR Exp | FromThenR Exp Exp
            | FromToR Exp Exp | FromThenToR Exp Exp Exp
           deriving( Show, Eq, Data, Typeable )
-  
-data Dec 
+
+data Dec
   = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@
   | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@
-  | DataD Cxt Name [TyVarBndr] 
+  | DataD Cxt Name [TyVarBndr]
          [Con] [Name]             -- ^ @{ data Cxt x => T x = A x | B (T x)
                                   --       deriving (Z,W)}@
-  | NewtypeD Cxt Name [TyVarBndr] 
+  | NewtypeD Cxt Name [TyVarBndr]
          Con [Name]               -- ^ @{ newtype Cxt x => T x = A (B x)
                                   --       deriving (Z,W)}@
   | TySynD Name [TyVarBndr] Type  -- ^ @{ type T x = (x,x) }@
-  | ClassD Cxt Name [TyVarBndr] 
+  | ClassD Cxt Name [TyVarBndr]
          [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@
   | InstanceD Cxt Type [Dec]      -- ^ @{ instance Show w => Show [w]
                                   --       where ds }@
@@ -1160,19 +1273,31 @@
   | PragmaD Pragma                -- ^ @{ {\-# INLINE [1] foo #-\} }@
 
   -- | type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
-  | FamilyD FamFlavour Name 
+  | FamilyD FamFlavour Name
          [TyVarBndr] (Maybe Kind) -- ^ @{ type family T a b c :: * }@
-                                 
+
   | DataInstD Cxt Name [Type]
-         [Con] [Name]             -- ^ @{ data instance Cxt x => T [x] = A x 
+         [Con] [Name]             -- ^ @{ data instance Cxt x => T [x] = A x
                                   --                                | B (T x)
                                   --       deriving (Z,W)}@
   | NewtypeInstD Cxt Name [Type]
          Con [Name]               -- ^ @{ newtype instance Cxt x => T [x] = A (B x)
                                   --       deriving (Z,W)}@
-  | TySynInstD Name [Type] Type   -- ^ @{ type instance T (Maybe x) = (x,x) }@
+  | TySynInstD Name TySynEqn      -- ^ @{ type instance ... }@
+
+  | ClosedTypeFamilyD Name
+      [TyVarBndr] (Maybe Kind)
+      [TySynEqn]                  -- ^ @{ type family F a b :: * where ... }@
+
+  | RoleAnnotD Name [Role]        -- ^ @{ type role T nominal representational }@
   deriving( Show, Eq, Data, Typeable )
 
+-- | One equation of a type family instance or closed type family. The
+-- arguments are the left-hand-side type patterns and the right-hand-side
+-- result.
+data TySynEqn = TySynEqn [Type] Type
+  deriving( Show, Eq, Data, Typeable )
+
 data FunDep = FunDep [Name] [Name]
   deriving( Show, Eq, Data, Typeable )
 
@@ -1193,6 +1318,7 @@
             | 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
@@ -1213,6 +1339,11 @@
               | 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)@
@@ -1259,6 +1390,18 @@
            | StrTyLit String              -- ^ @"Hello"@
   deriving ( Show, Eq, Data, Typeable )
 
+-- | Role annotations
+data Role = NominalR            -- ^ @nominal@
+          | RepresentationalR   -- ^ @representational@
+          | PhantomR            -- ^ @phantom@
+          | InferR              -- ^ @_@
+  deriving( Show, Eq, Data, Typeable )
+
+-- | Annotation target for reifyAnnotations
+data AnnLookup = AnnLookupModule Module
+               | AnnLookupName Name
+               deriving( Show, Eq, Data, Typeable )
+
 -- | To avoid duplication between kinds and types, they
 -- are defined to be the same. Naturally, you would never
 -- have a type be 'StarT' and you would never have a kind
@@ -1267,14 +1410,14 @@
 -- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',
 -- not 'PromotedTupleT'.
 
-type Kind = Type     
+type Kind = Type
 
 {- Note [Representing concrete syntax in types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Haskell has a rich concrete syntax for types, including
   t1 -> t2, (t1,t2), [t], and so on
 In TH we represent all of this using AppT, with a distinguished
-type construtor at the head.  So,
+type constructor at the head.  So,
   Type              TH representation
   -----------------------------------------------
   t1 -> t2          ArrowT `AppT` t2 `AppT` t2
@@ -1295,7 +1438,7 @@
 corresponding to PromotedListT. So we encode HsExplicitListTy with
 PromotedConsT and PromotedNilT (which *do* have underlying type
 constructors):
-  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT` 
+  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`
                     (PromotedConsT  `AppT` IO `AppT` PromotedNilT)
 -}
 
diff --git a/template-haskell.cabal b/template-haskell.cabal
--- a/template-haskell.cabal
+++ b/template-haskell.cabal
@@ -1,31 +1,56 @@
-name:		template-haskell
-version:	2.8.0.0
-license:	BSD3
-license-file:	LICENSE
-maintainer:	libraries@haskell.org
-bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=Template%20Haskell
+name:           template-haskell
+version:        2.9.0.0
+-- GHC 7.6.1 released with 2.8.0.0
+license:        BSD3
+license-file:   LICENSE
+category:       Template Haskell
+maintainer:     libraries@haskell.org
+bug-reports:    http://ghc.haskell.org/trac/ghc/newticket?component=Template%20Haskell
+synopsis:       Support library for Template Haskell
+build-type:     Simple
+Cabal-Version:  >= 1.10
 description:
-    Facilities for manipulating Haskell source code using Template Haskell.
-build-type: Simple
-Cabal-Version: >= 1.6
+    This package provides modules containing facilities for manipulating
+    Haskell source code using Template Haskell.
+    .
+    See <http://www.haskell.org/haskellwiki/Template_Haskell> for more
+    information.
 
+source-repository head
+    type:     git
+    location: http://git.haskell.org/packages/template-haskell.git
+
+source-repository this
+    type:     git
+    location: http://git.haskell.org/packages/template-haskell.git
+    tag:      template-haskell-2.9.0.0-release
+
 Library
-    build-depends: base >= 4.2 && < 5,
-                   pretty, containers
+    default-language: Haskell2010
+    other-extensions:
+        DeriveDataTypeable
+        FlexibleInstances
+        MagicHash
+        PolymorphicComponents
+        RankNTypes
+        RoleAnnotations
+        ScopedTypeVariables
+        TemplateHaskell
+        UnboxedTuples
+
     exposed-modules:
-        Language.Haskell.TH.Syntax
-        Language.Haskell.TH.PprLib
-        Language.Haskell.TH.Ppr
+        Language.Haskell.TH
         Language.Haskell.TH.Lib
+        Language.Haskell.TH.Ppr
+        Language.Haskell.TH.PprLib
         Language.Haskell.TH.Quote
-        Language.Haskell.TH
-    extensions: MagicHash, PatternGuards, PolymorphicComponents,
-                DeriveDataTypeable
-    -- We need to set the package name to template-haskell (without a
-    -- version number) as it's magic.
-    ghc-options: -package-name template-haskell
+        Language.Haskell.TH.Syntax
 
-source-repository head
-    type:     git
-    location: http://darcs.haskell.org/packages/template-haskell.git/
+    build-depends:
+        base       == 4.7.*,
+        containers == 0.5.*,
+        pretty     == 1.1.*
 
+    -- We need to set the package name to template-haskell (without a
+    -- version number) as it's magic.
+    ghc-options: -Wall -package-name template-haskell