Line up kind and type variables correctly when desugaring TH brackets
[ghc.git] / compiler / deSugar / DsMeta.hs
index 9a9f89d..b5d1b0f 100644 (file)
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2006
 -- a Royal Pain (triggers other recompilation).
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module DsMeta( dsBracket,
-              templateHaskellNames, qTyConName, nameTyConName,
-              liftName, liftStringName, expQTyConName, patQTyConName,
+               templateHaskellNames, qTyConName, nameTyConName,
+               liftName, liftStringName, expQTyConName, patQTyConName,
                decQTyConName, decsQTyConName, typeQTyConName,
-              decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
-              quoteExpName, quotePatName, quoteDecName, quoteTypeName
-               ) where
+               decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
+               quoteExpName, quotePatName, quoteDecName, quoteTypeName,
+               tExpTyConName, tExpDataConName, unTypeName, unTypeQName,
+               unsafeTExpCoerceName
+                ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}  DsExpr ( dsExpr )
+import {-# SOURCE #-}   DsExpr ( dsExpr )
 
 import MatchLit
 import DsMonad
@@ -66,13 +63,14 @@ import DynFlags
 import FastString
 import ForeignCall
 import Util
+import TcRnMonad( traceOptIf )
 
 import Data.Maybe
 import Control.Monad
 import Data.List
 
 -----------------------------------------------------------------------------
-dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
+dsBracket :: HsBracket Name -> [PendingTcSplice] -> DsM CoreExpr
 -- Returns a CoreExpr of type TH.ExpQ
 -- The quoted thing is parameterised over Name, even though it has
 -- been type checked.  We don't want all those type decorations!
@@ -80,7 +78,7 @@ dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
 dsBracket brack splices
   = dsExtendMetaEnv new_bit (do_brack brack)
   where
-    new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
+    new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n, e) <- splices]
 
     do_brack (VarBr _ n) = do { MkC e1  <- lookupOcc n ; return e1 }
     do_brack (ExpBr e)   = do { MkC e1  <- repLE e     ; return e1 }
@@ -88,6 +86,7 @@ dsBracket brack splices
     do_brack (TypBr t)   = do { MkC t1  <- repLTy t    ; return t1 }
     do_brack (DecBrG gp) = do { MkC ds1 <- repTopDs gp ; return ds1 }
     do_brack (DecBrL _)  = panic "dsBracket: unexpected DecBrL"
+    do_brack (TExpBr e)  = do { MkC e1  <- repLE e     ; return e1 }
 
 {- -------------- Examples --------------------
 
@@ -105,7 +104,7 @@ dsBracket brack splices
 
 
 -------------------------------------------------------
---                     Declarations
+--                      Declarations
 -------------------------------------------------------
 
 repTopP :: LPat Name -> DsM (Core TH.PatQ)
@@ -117,34 +116,35 @@ repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
 repTopDs group
  = do { let { tv_bndrs = hsSigTvBinders (hs_valds group)
             ; bndrs = tv_bndrs ++ hsGroupBinders group } ;
-       ss <- mkGenSyms bndrs ;
+        ss <- mkGenSyms bndrs ;
 
-       -- Bind all the names mainly to avoid repeated use of explicit strings.
-       -- Thus we get
-       --      do { t :: String <- genSym "T" ;
-       --           return (Data t [] ...more t's... }
-       -- The other important reason is that the output must mention
-       -- only "T", not "Foo:T" where Foo is the current module
+        -- Bind all the names mainly to avoid repeated use of explicit strings.
+        -- Thus we get
+        --      do { t :: String <- genSym "T" ;
+        --           return (Data t [] ...more t's... }
+        -- The other important reason is that the output must mention
+        -- only "T", not "Foo:T" where Foo is the current module
 
-       decls <- addBinds ss (do {
+        decls <- addBinds ss (do {
                         fix_ds  <- mapM repFixD (hs_fixds group) ;
-                       val_ds  <- rep_val_binds (hs_valds group) ;
-                       tycl_ds <- mapM repTyClD (concat (hs_tyclds group)) ;
-                       inst_ds <- mapM repInstD (hs_instds group) ;
-                       rule_ds <- mapM repRuleD (hs_ruleds group) ;
-                       for_ds  <- mapM repForD  (hs_fords group) ;
-                       -- more needed
-                       return (de_loc $ sort_by_loc $
-                                val_ds ++ catMaybes tycl_ds ++ fix_ds
+                        val_ds  <- rep_val_binds (hs_valds group) ;
+                        tycl_ds <- mapM repTyClD (tyClGroupConcat (hs_tyclds group)) ;
+                        role_ds <- mapM repRoleD (concatMap group_roles (hs_tyclds group)) ;
+                        inst_ds <- mapM repInstD (hs_instds group) ;
+                        rule_ds <- mapM repRuleD (hs_ruleds group) ;
+                        for_ds  <- mapM repForD  (hs_fords group) ;
+                        -- more needed
+                        return (de_loc $ sort_by_loc $
+                                val_ds ++ catMaybes tycl_ds ++ role_ds ++ fix_ds
                                        ++ inst_ds ++ rule_ds ++ for_ds) }) ;
 
-       decl_ty <- lookupType decQTyConName ;
-       let { core_list = coreList' decl_ty decls } ;
+        decl_ty <- lookupType decQTyConName ;
+        let { core_list = coreList' decl_ty decls } ;
 
-       dec_ty <- lookupType decTyConName ;
-       q_decs  <- repSequenceQ dec_ty core_list ;
+        dec_ty <- lookupType decTyConName ;
+        q_decs  <- repSequenceQ dec_ty core_list ;
 
-       wrapGenSyms ss q_decs
+        wrapGenSyms ss q_decs
       }
 
 
@@ -155,8 +155,8 @@ hsSigTvBinders binds
                      , tv <- hsQTvBndrs qtvs]
   where
     sigs = case binds of
-            ValBindsIn  _ sigs -> sigs
-            ValBindsOut _ sigs -> sigs
+             ValBindsIn  _ sigs -> sigs
+             ValBindsOut _ sigs -> sigs
 
 
 {- Notes
@@ -180,19 +180,19 @@ Note [Binders and occurrences]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When we desugar [d| data T = MkT |]
 we want to get
-       Data "T" [] [Con "MkT" []] []
+        Data "T" [] [Con "MkT" []] []
 and *not*
-       Data "Foo:T" [] [Con "Foo:MkT" []] []
+        Data "Foo:T" [] [Con "Foo:MkT" []] []
 That is, the new data decl should fit into whatever new module it is
 asked to fit in.   We do *not* clone, though; no need for this:
-       Data "T79" ....
+        Data "T79" ....
 
 But if we see this:
-       data T = MkT
-       foo = reifyDecl T
+        data T = MkT
+        foo = reifyDecl T
 
 then we must desugar to
-       foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
+        foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
 
 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
 And we use lookupOcc, rather than lookupBinder
@@ -207,39 +207,48 @@ repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 repTyClD (L loc (FamDecl { tcdFam = fam })) = liftM Just $ repFamilyDecl (L loc fam)
 
 repTyClD (L loc (SynDecl { tcdLName = tc, tcdTyVars = tvs, tcdRhs = rhs }))
-  = do { tc1 <- lookupLOcc tc          -- See note [Binders and occurrences]  
-       ; dec <- addTyClTyVarBinds tvs $ \bndrs -> 
-               repSynDecl tc1 bndrs rhs
+  = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
+       ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
+                repSynDecl tc1 bndrs rhs
        ; return (Just (loc, dec)) }
 
 repTyClD (L loc (DataDecl { tcdLName = tc, tcdTyVars = tvs, tcdDataDefn = defn }))
-  = do { tc1 <- lookupLOcc tc          -- See note [Binders and occurrences]  
+  = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
        ; tc_tvs <- mk_extra_tvs tc tvs defn
-       ; dec <- addTyClTyVarBinds tc_tvs $ \bndrs -> 
-               repDataDefn tc1 bndrs Nothing (hsLTyVarNames tc_tvs) defn
+       ; dec <- addTyClTyVarBinds tc_tvs $ \bndrs ->
+                repDataDefn tc1 bndrs Nothing (hsLTyVarNames tc_tvs) defn
        ; return (Just (loc, dec)) }
 
-repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, 
-                            tcdTyVars = tvs, tcdFDs = fds,
-                            tcdSigs = sigs, tcdMeths = meth_binds, 
+repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
+                             tcdTyVars = tvs, tcdFDs = fds,
+                             tcdSigs = sigs, tcdMeths = meth_binds,
                              tcdATs = ats, tcdATDefs = [] }))
-  = do { cls1 <- lookupLOcc cls        -- See note [Binders and occurrences] 
-       ; dec  <- addTyVarBinds tvs $ \bndrs -> 
+  = do { cls1 <- lookupLOcc cls         -- See note [Binders and occurrences]
+       ; dec  <- addTyVarBinds tvs $ \bndrs ->
            do { cxt1   <- repLContext cxt
-             ; sigs1  <- rep_sigs sigs
-             ; binds1 <- rep_binds meth_binds
-             ; fds1   <- repLFunDeps fds
+              ; sigs1  <- rep_sigs sigs
+              ; binds1 <- rep_binds meth_binds
+              ; fds1   <- repLFunDeps fds
               ; ats1   <- repFamilyDecls ats
-             ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
-             ; repClass cxt1 cls1 bndrs fds1 decls1 
+              ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
+              ; repClass cxt1 cls1 bndrs fds1 decls1
               }
-       ; return $ Just (loc, dec) 
+       ; return $ Just (loc, dec)
        }
 
 -- Un-handled cases
 repTyClD (L loc d) = putSrcSpanDs loc $
-                    do { warnDs (hang ds_msg 4 (ppr d))
-                       ; return Nothing }
+                     do { warnDs (hang ds_msg 4 (ppr d))
+                        ; return Nothing }
+
+-------------------------
+repRoleD :: LRoleAnnotDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repRoleD (L loc (RoleAnnotDecl tycon roles))
+  = do { tycon1 <- lookupLOcc tycon
+       ; roles1 <- mapM repRole roles
+       ; roles2 <- coreList roleTyConName roles1
+       ; dec <- repRoleAnnotD tycon1 roles2
+       ; return (loc, dec) }
 
 -------------------------
 repDataDefn :: Core TH.Name -> Core [TH.TyVarBndr]
@@ -248,7 +257,7 @@ repDataDefn :: Core TH.Name -> Core [TH.TyVarBndr]
             -> DsM (Core TH.DecQ)
 repDataDefn tc bndrs opt_tys tv_names
           (HsDataDefn { dd_ND = new_or_data, dd_ctxt = cxt
-                     , dd_cons = cons, dd_derivs = mb_derivs })
+                      , dd_cons = cons, dd_derivs = mb_derivs })
   = do { cxt1     <- repLContext cxt
        ; derivs1  <- repDerivs mb_derivs
        ; case new_or_data of
@@ -265,18 +274,29 @@ repSynDecl tc bndrs ty
        ; repTySyn tc bndrs ty1 }
 
 repFamilyDecl :: LFamilyDecl Name -> DsM (SrcSpan, Core TH.DecQ)
-repFamilyDecl (L loc (FamilyDecl { fdFlavour = flavour,
+repFamilyDecl (L loc (FamilyDecl { fdInfo    = info,
                                    fdLName   = tc,
-                                   fdTyVars  = tvs, 
-                                  fdKindSig = opt_kind }))
-  = do { tc1 <- lookupLOcc tc          -- See note [Binders and occurrences] 
+                                   fdTyVars  = tvs,
+                                   fdKindSig = opt_kind }))
+  = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
        ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
-           do { flav <- repFamilyFlavour flavour
-             ; case opt_kind of 
-                  Nothing -> repFamilyNoKind flav tc1 bndrs
-                  Just ki -> do { ki1 <- repLKind ki 
-                                ; repFamilyKind flav tc1 bndrs ki1 }
-              }
+           case (opt_kind, info) of
+                  (Nothing, ClosedTypeFamily eqns) ->
+                    do { eqns1 <- mapM repTyFamEqn eqns
+                       ; eqns2 <- coreList tySynEqnQTyConName eqns1
+                       ; repClosedFamilyNoKind tc1 bndrs eqns2 }
+                  (Just ki, ClosedTypeFamily eqns) ->
+                    do { eqns1 <- mapM repTyFamEqn eqns
+                       ; eqns2 <- coreList tySynEqnQTyConName eqns1
+                       ; ki1 <- repLKind ki
+                       ; repClosedFamilyKind tc1 bndrs ki1 eqns2 }
+                  (Nothing, _) ->
+                    do { info' <- repFamilyInfo info
+                       ; repFamilyNoKind info' tc1 bndrs }
+                  (Just ki, _) ->
+                    do { info' <- repFamilyInfo info
+                       ; ki1 <- repLKind ki
+                       ; repFamilyKind info' tc1 bndrs ki1 }
        ; return (loc, dec)
        }
 
@@ -284,7 +304,7 @@ repFamilyDecls :: [LFamilyDecl Name] -> DsM [Core TH.DecQ]
 repFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds)
 
 -------------------------
-mk_extra_tvs :: Located Name -> LHsTyVarBndrs Name 
+mk_extra_tvs :: Located Name -> LHsTyVarBndrs Name
              -> HsDataDefn Name -> DsM (LHsTyVarBndrs Name)
 -- If there is a kind signature it must be of form
 --    k1 -> .. -> kn -> *
@@ -324,9 +344,10 @@ repLFunDep (L _ (xs, ys)) = do xs' <- repList nameTyConName lookupBinder xs
 
 -- represent family declaration flavours
 --
-repFamilyFlavour :: FamilyFlavour -> DsM (Core TH.FamFlavour)
-repFamilyFlavour TypeFamily = rep2 typeFamName []
-repFamilyFlavour DataFamily = rep2 dataFamName []
+repFamilyInfo :: FamilyInfo Name -> DsM (Core TH.FamFlavour)
+repFamilyInfo OpenTypeFamily      = rep2 typeFamName []
+repFamilyInfo DataFamily          = rep2 dataFamName []
+repFamilyInfo ClosedTypeFamily {} = panic "repFamilyInfo"
 
 -- Represent instance declarations
 --
@@ -346,15 +367,15 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
                          , cid_sigs = prags, cid_tyfam_insts = ats
                          , cid_datafam_insts = adts })
   = addTyVarBinds tvs $ \_ ->
-           -- We must bring the type variables into scope, so their
-           -- occurrences don't fail, even though the binders don't
+            -- We must bring the type variables into scope, so their
+            -- occurrences don't fail, even though the binders don't
             -- appear in the resulting data structure
-           --
-           -- But we do NOT bring the binders of 'binds' into scope
-           -- because they are properly regarded as occurrences
-           -- For example, the method names should be bound to
-           -- the selector Ids, not to fresh names (Trac #5410)
-           --
+            --
+            -- But we do NOT bring the binders of 'binds' into scope
+            -- because they are properly regarded as occurrences
+            -- For example, the method names should be bound to
+            -- the selector Ids, not to fresh names (Trac #5410)
+            --
             do { cxt1 <- repContext cxt
                ; cls_tcon <- repTy (HsTyVar (unLoc cls))
                ; cls_tys <- repLTys tys
@@ -369,12 +390,11 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
    Just (tvs, cxt, cls, tys) = splitLHsInstDeclTy_maybe ty
 
 repTyFamInstD :: TyFamInstDecl Name -> DsM (Core TH.DecQ)
-repTyFamInstD decl@(TyFamInstDecl { tfid_eqns = eqns })
+repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
   = do { let tc_name = tyFamInstDeclLName decl
-       ; tc <- lookupLOcc tc_name              -- See note [Binders and occurrences]  
-       ; eqns1 <- mapM repTyFamEqn eqns
-       ; eqns2 <- coreList tySynEqnQTyConName eqns1
-       ; repTySynInst tc eqns2 }
+       ; tc <- lookupLOcc tc_name               -- See note [Binders and occurrences]
+       ; eqn1 <- repTyFamEqn eqn
+       ; repTySynInst tc eqn1 }
 
 repTyFamEqn :: LTyFamInstEqn Name -> DsM (Core TH.TySynEqnQ)
 repTyFamEqn (L loc (TyFamInstEqn { tfie_pats = HsWB { hswb_cts = tys
@@ -393,7 +413,7 @@ repDataFamInstD :: DataFamInstDecl Name -> DsM (Core TH.DecQ)
 repDataFamInstD (DataFamInstDecl { dfid_tycon = tc_name
                                  , dfid_pats = HsWB { hswb_cts = tys, hswb_kvs = kv_names, hswb_tvs = tv_names }
                                  , dfid_defn = defn })
-  = do { tc <- lookupLOcc tc_name              -- See note [Binders and occurrences]  
+  = do { tc <- lookupLOcc tc_name               -- See note [Binders and occurrences]
        ; let loc = getLoc tc_name
              hs_tvs = HsQTvs { hsq_kvs = kv_names, hsq_tvs = userHsTyVarBndrs loc tv_names }   -- Yuk
        ; addTyClTyVarBinds hs_tvs $ \ bndrs ->
@@ -461,7 +481,7 @@ repRuleD (L loc (HsRule n act bndrs lhs _ rhs _))
 
 ruleBndrNames :: RuleBndr Name -> [Name]
 ruleBndrNames (RuleBndr n)      = [unLoc n]
-ruleBndrNames (RuleBndrSig n (HsWB { hswb_kvs = kvs, hswb_tvs = tvs })) 
+ruleBndrNames (RuleBndrSig n (HsWB { hswb_kvs = kvs, hswb_tvs = tvs }))
   = unLoc n : kvs ++ tvs
 
 repRuleBndr :: RuleBndr Name -> DsM (Core TH.RuleBndrQ)
@@ -477,14 +497,14 @@ ds_msg :: SDoc
 ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:")
 
 -------------------------------------------------------
---                     Constructors
+--                      Constructors
 -------------------------------------------------------
 
 repC :: [Name] -> LConDecl Name -> DsM (Core TH.ConQ)
 repC _ (L _ (ConDecl { con_name = con, con_qvars = con_tvs, con_cxt = L _ []
                      , con_details = details, con_res = ResTyH98 }))
   | null (hsQTvBndrs con_tvs)
-  = do { con1 <- lookupLOcc con        -- See Note [Binders and occurrences] 
+  = do { con1 <- lookupLOcc con         -- See Note [Binders and occurrences]
        ; repConstr con1 details  }
 
 repC tvs (L _ (ConDecl { con_name = con
@@ -495,10 +515,10 @@ repC tvs (L _ (ConDecl { con_name = con
        ; let ex_tvs = HsQTvs { hsq_kvs = filterOut (in_subst con_tv_subst) (hsq_kvs con_tvs)
                              , hsq_tvs = filterOut (in_subst con_tv_subst . hsLTyVarName) (hsq_tvs con_tvs) }
 
-       ; binds <- mapM dupBinder con_tv_subst 
+       ; binds <- mapM dupBinder con_tv_subst
        ; dsExtendMetaEnv (mkNameEnv binds) $     -- Binds some of the con_tvs
          addTyVarBinds ex_tvs $ \ ex_bndrs ->   -- Binds the remaining con_tvs
-    do { con1      <- lookupLOcc con   -- See Note [Binders and occurrences] 
+    do { con1      <- lookupLOcc con    -- See Note [Binders and occurrences]
        ; c'        <- repConstr con1 details
        ; ctxt'     <- repContext (eq_ctxt ++ ctxt)
        ; rep2 forallCName [unC ex_bndrs, unC ctxt', unC c'] } }
@@ -507,9 +527,9 @@ in_subst :: [(Name,Name)] -> Name -> Bool
 in_subst []          _ = False
 in_subst ((n',_):ns) n = n==n' || in_subst ns n
 
-mkGadtCtxt :: [Name]           -- Tyvars of the data type
+mkGadtCtxt :: [Name]            -- Tyvars of the data type
            -> ResType (LHsType Name)
-          -> DsM (HsContext Name, [(Name,Name)])
+           -> DsM (HsContext Name, [(Name,Name)])
 -- Given a data type in GADT syntax, figure out the equality
 -- context, so that we can represent it with an explicit
 -- equality context, because that is the only way to express
@@ -525,8 +545,7 @@ mkGadtCtxt :: [Name]                -- Tyvars of the data type
 mkGadtCtxt _ ResTyH98
   = return ([], [])
 mkGadtCtxt data_tvs (ResTyGADT res_ty)
-  | let (head_ty, tys) = splitHsAppTys res_ty []
-  , Just _ <- is_hs_tyvar head_ty
+  | Just (_, tys) <- hsTyGetAppHead_maybe res_ty
   , data_tvs `equalLength` tys
   = return (go [] [] (data_tvs `zip` tys))
 
@@ -557,12 +576,12 @@ repBangTy ty= do
   rep2 strictTypeName [s, t]
   where
     (str, ty') = case ty of
-                  L _ (HsBangTy (HsUserBang (Just True) True) ty) -> (unpackedName,  ty)
-                  L _ (HsBangTy (HsUserBang _     True) ty)       -> (isStrictName,  ty)
-                  _                               -> (notStrictName, ty)
+                   L _ (HsBangTy (HsUserBang (Just True) True) ty) -> (unpackedName,  ty)
+                   L _ (HsBangTy (HsUserBang _     True) ty)       -> (isStrictName,  ty)
+                   _                               -> (notStrictName, ty)
 
 -------------------------------------------------------
---                     Deriving clause
+--                      Deriving clause
 -------------------------------------------------------
 
 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
@@ -571,7 +590,7 @@ repDerivs (Just ctxt)
   = repList nameTyConName rep_deriv ctxt
   where
     rep_deriv :: LHsType Name -> DsM (Core TH.Name)
-       -- Deriving clauses must have the simple H98 form
+        -- Deriving clauses must have the simple H98 form
     rep_deriv ty
       | Just (cls, []) <- splitHsClassTy_maybe (unLoc ty)
       = lookupOcc cls
@@ -588,13 +607,13 @@ rep_sigs sigs = do locs_cores <- rep_sigs' sigs
                    return $ de_loc $ sort_by_loc locs_cores
 
 rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
-       -- We silently ignore ones we don't recognise
+        -- We silently ignore ones we don't recognise
 rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
-                    return (concat sigs1) }
+                     return (concat sigs1) }
 
 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
-       -- Singleton => Ok
-       -- Empty     => Too hard, signature ignored
+        -- Singleton => Ok
+        -- Empty     => Too hard, signature ignored
 rep_sig (L loc (TypeSig nms ty))      = mapM (rep_ty_sig loc ty) nms
 rep_sig (L _   (GenericSig nm _))     = failWithDs msg
   where msg = vcat  [ ptext (sLit "Illegal default signature for") <+> quotes (ppr nm)
@@ -627,7 +646,7 @@ rep_ty_sig loc (L _ ty) nm
 
 
 rep_inline :: Located Name
-           -> InlinePragma     -- Never defaultInlinePragma
+           -> InlinePragma      -- Never defaultInlinePragma
            -> SrcSpan
            -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_inline nm ispec loc
@@ -679,22 +698,24 @@ repPhases (ActiveAfter i)  = do { MkC arg <- coreIntLit i
 repPhases _                = dataCon allPhasesDataConName
 
 -------------------------------------------------------
---                     Types
+--                      Types
 -------------------------------------------------------
 
-addTyVarBinds :: LHsTyVarBndrs Name                           -- the binders to be added
+addTyVarBinds :: LHsTyVarBndrs Name                            -- the binders to be added
               -> (Core [TH.TyVarBndr] -> DsM (Core (TH.Q a)))  -- action in the ext env
               -> DsM (Core (TH.Q a))
 -- gensym a list of type variables and enter them into the meta environment;
 -- the computations passed as the second argument is executed in that extended
 -- meta environment and gets the *new* names on Core-level as an argument
 
-addTyVarBinds tvs m
-  = do { freshNames <- mkGenSyms (hsLKiTyVarNames tvs)
-       ; term <- addBinds freshNames $ 
-                do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs `zip` freshNames)
-                   ; m kbs }
-       ; wrapGenSyms freshNames term }
+addTyVarBinds (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs }) m
+  = do { fresh_kv_names <- mkGenSyms kvs
+       ; fresh_tv_names <- mkGenSyms (map hsLTyVarName tvs)
+       ; let fresh_names = fresh_kv_names ++ fresh_tv_names
+       ; term <- addBinds fresh_names $
+                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (tvs `zip` fresh_tv_names)
+                    ; m kbs }
+       ; wrapGenSyms fresh_names term }
   where
     mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v)
 
@@ -711,12 +732,12 @@ addTyClTyVarBinds tvs m
   = do { let tv_names = hsLKiTyVarNames tvs
        ; env <- dsGetMetaEnv
        ; freshNames <- mkGenSyms (filterOut (`elemNameEnv` env) tv_names)
-                   -- Make fresh names for the ones that are not already in scope
+            -- Make fresh names for the ones that are not already in scope
             -- This makes things work for family declarations
 
-       ; term <- addBinds freshNames $ 
-                do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs)
-                   ; m kbs }
+       ; term <- addBinds freshNames $
+                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs)
+                    ; m kbs }
 
        ; wrapGenSyms freshNames term }
   where
@@ -725,9 +746,9 @@ addTyClTyVarBinds tvs m
 
 -- Produce kinded binder constructors from the Haskell tyvar binders
 --
-repTyVarBndrWithKind :: LHsTyVarBndr Name 
+repTyVarBndrWithKind :: LHsTyVarBndr Name
                      -> Core TH.Name -> DsM (Core TH.TyVarBndr)
-repTyVarBndrWithKind (L _ (UserTyVar {})) nm
+repTyVarBndrWithKind (L _ (UserTyVar _)) nm
   = repPlainTV nm
 repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) nm
   = repLKind ki >>= repKindedTV nm
@@ -738,28 +759,8 @@ repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
 repLContext (L _ ctxt) = repContext ctxt
 
 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
-repContext ctxt = do preds <- repList predQTyConName repLPred ctxt
-                    repCtxt preds
-
--- represent a type predicate
---
-repLPred :: LHsType Name -> DsM (Core TH.PredQ)
-repLPred (L _ p) = repPred p
-
-repPred :: HsType Name -> DsM (Core TH.PredQ)
-repPred ty
-  | Just (cls, tys) <- splitHsClassTy_maybe ty
-  = do
-      cls1 <- lookupOcc cls
-      tys1 <- repList typeQTyConName repLTy tys
-      repClassP cls1 tys1
-repPred (HsEqTy tyleft tyright)
-  = do
-      tyleft1  <- repLTy tyleft
-      tyright1 <- repLTy tyright
-      repEqualP tyleft1 tyright1
-repPred ty
-  = notHandled "Exotic predicate type" (ppr ty)
+repContext ctxt = do preds <- repList typeQTyConName repLTy ctxt
+                     repCtxt preds
 
 -- yield the representation of a list of types
 --
@@ -780,46 +781,51 @@ repTy (HsForAllTy _ tvs ctxt ty)  =
 
 repTy (HsTyVar n)
   | isTvOcc occ   = do tv1 <- lookupOcc n
-                      repTvar tv1
+                       repTvar tv1
   | isDataOcc occ = do tc1 <- lookupOcc n
                        repPromotedTyCon tc1
-  | otherwise    = do tc1 <- lookupOcc n
-                      repNamedTyCon tc1
+  | otherwise     = do tc1 <- lookupOcc n
+                       repNamedTyCon tc1
   where
     occ = nameOccName n
 
 repTy (HsAppTy f a)         = do
-                               f1 <- repLTy f
-                               a1 <- repLTy a
-                               repTapp f1 a1
+                                f1 <- repLTy f
+                                a1 <- repLTy a
+                                repTapp f1 a1
 repTy (HsFunTy f a)         = do
-                               f1   <- repLTy f
-                               a1   <- repLTy a
-                               tcon <- repArrowTyCon
-                               repTapps tcon [f1, a1]
-repTy (HsListTy t)         = do
-                               t1   <- repLTy t
-                               tcon <- repListTyCon
-                               repTapp tcon t1
+                                f1   <- repLTy f
+                                a1   <- repLTy a
+                                tcon <- repArrowTyCon
+                                repTapps tcon [f1, a1]
+repTy (HsListTy t)          = do
+                                t1   <- repLTy t
+                                tcon <- repListTyCon
+                                repTapp tcon t1
 repTy (HsPArrTy t)          = do
-                               t1   <- repLTy t
-                               tcon <- repTy (HsTyVar (tyConName parrTyCon))
-                               repTapp tcon t1
+                                t1   <- repLTy t
+                                tcon <- repTy (HsTyVar (tyConName parrTyCon))
+                                repTapp tcon t1
 repTy (HsTupleTy HsUnboxedTuple tys) = do
-                               tys1 <- repLTys tys
-                               tcon <- repUnboxedTupleTyCon (length tys)
-                               repTapps tcon tys1
+                                tys1 <- repLTys tys
+                                tcon <- repUnboxedTupleTyCon (length tys)
+                                repTapps tcon tys1
 repTy (HsTupleTy _ tys)     = do tys1 <- repLTys tys
                                  tcon <- repTupleTyCon (length tys)
                                  repTapps tcon tys1
 repTy (HsOpTy ty1 (_, n) ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
-                                  `nlHsAppTy` ty2)
-repTy (HsParTy t)          = repLTy t
+                                   `nlHsAppTy` ty2)
+repTy (HsParTy t)           = repLTy t
+repTy (HsEqTy t1 t2) = do
+                         t1' <- repLTy t1
+                         t2' <- repLTy t2
+                         eq  <- repTequality
+                         repTapps eq [t1', t2']
 repTy (HsKindSig t k)       = do
                                 t1 <- repLTy t
                                 k1 <- repLKind k
                                 repTSig t1 k1
-repTy (HsSpliceTy splice _ _) = repSplice splice
+repTy (HsSpliceTy splice _)     = repSplice splice
 repTy (HsExplicitListTy _ tys)  = do
                                     tys1 <- repLTys tys
                                     repTPromotedList tys1
@@ -830,11 +836,12 @@ repTy (HsExplicitTupleTy _ tys) = do
 repTy (HsTyLit lit) = do
                         lit' <- repTyLit lit
                         repTLit lit'
-repTy ty                     = notHandled "Exotic form of type" (ppr ty)
+                          
+repTy ty                      = notHandled "Exotic form of type" (ppr ty)
 
 repTyLit :: HsTyLit -> DsM (Core TH.TyLitQ)
-repTyLit (HsNumTy i) = do dflags <- getDynFlags
-                          rep2 numTyLitName [mkIntExpr dflags i]
+repTyLit (HsNumTy i) = do iExpr <- mkIntegerExpr i
+                          rep2 numTyLitName [iExpr]
 repTyLit (HsStrTy s) = do { s' <- mkStringExprFS s
                          ; rep2 strTyLitName [s']
                          }
@@ -874,8 +881,14 @@ repNonArrowKind (HsTupleTy _ ks)    = do  { ks' <- mapM repLKind ks
                                           }
 repNonArrowKind k                   = notHandled "Exotic form of kind" (ppr k)
 
+repRole :: Located (Maybe Role) -> DsM (Core TH.Role)
+repRole (L _ (Just Nominal))          = rep2 nominalRName []
+repRole (L _ (Just Representational)) = rep2 representationalRName []
+repRole (L _ (Just Phantom))          = rep2 phantomRName []
+repRole (L _ Nothing)                 = rep2 inferRName []
+
 -----------------------------------------------------------------------------
---             Splices
+--              Splices
 -----------------------------------------------------------------------------
 
 repSplice :: HsSplice Name -> DsM (Core a)
@@ -884,21 +897,21 @@ repSplice :: HsSplice Name -> DsM (Core a)
 repSplice (HsSplice n _)
  = do { mb_val <- dsLookupMetaEnv n
        ; case mb_val of
-          Just (Splice e) -> do { e' <- dsExpr e
-                                ; return (MkC e') }
-          _ -> pprPanic "HsSplice" (ppr n) }
-                       -- Should not happen; statically checked
+           Just (Splice e) -> do { e' <- dsExpr e
+                                 ; return (MkC e') }
+           _ -> pprPanic "HsSplice" (ppr n) }
+                        -- Should not happen; statically checked
 
 -----------------------------------------------------------------------------
---             Expressions
+--              Expressions
 -----------------------------------------------------------------------------
 
 repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
 repLEs es = repList expQTyConName repLE es
 
 -- FIXME: some of these panics should be converted into proper error messages
---       unless we can make sure that constructs, which are plainly not
---       supported in TH already lead to error messages at an earlier stage
+--        unless we can make sure that constructs, which are plainly not
+--        supported in TH already lead to error messages at an earlier stage
 repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
 repLE (L loc e) = putSrcSpanDs loc (repE e)
 
@@ -906,21 +919,22 @@ repE :: HsExpr Name -> DsM (Core TH.ExpQ)
 repE (HsVar x)            =
   do { mb_val <- dsLookupMetaEnv x
      ; case mb_val of
-       Nothing          -> do { str <- globalVar x
-                              ; repVarOrCon x str }
-       Just (Bound y)   -> repVarOrCon x (coreVar y)
-       Just (Splice e)  -> do { e' <- dsExpr e
-                              ; return (MkC e') } }
+        Nothing          -> do { str <- globalVar x
+                               ; repVarOrCon x str }
+        Just (Bound y)   -> repVarOrCon x (coreVar y)
+        Just (Splice e)  -> do { e' <- dsExpr e
+                               ; return (MkC e') } }
 repE e@(HsIPVar _) = notHandled "Implicit parameters" (ppr e)
 
-       -- Remember, we're desugaring renamer output here, so
-       -- HsOverlit can definitely occur
+        -- Remember, we're desugaring renamer output here, so
+        -- HsOverlit can definitely occur
 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
 repE (HsLit l)     = do { a <- repLiteral l;           repLit a }
 repE (HsLam (MG { mg_alts = [m] })) = repLambda m
 repE (HsLamCase _ (MG { mg_alts = ms }))
                    = do { ms' <- mapM repMatchTup ms
-                        ; repLamCase (nonEmptyCoreList ms') }
+                        ; core_ms <- coreList matchQTyConName ms'
+                        ; repLamCase core_ms }
 repE (HsApp x y)   = do {a <- repLE x; b <- repLE y; repApp a b}
 
 repE (OpApp e1 op _ e2) =
@@ -929,29 +943,30 @@ repE (OpApp e1 op _ e2) =
        the_op <- repLE op ;
        repInfixApp arg1 the_op arg2 }
 repE (NegApp x _)        = do
-                             a         <- repLE x
-                             negateVar <- lookupOcc negateName >>= repVar
-                             negateVar `repApp` a
+                              a         <- repLE x
+                              negateVar <- lookupOcc negateName >>= repVar
+                              negateVar `repApp` a
 repE (HsPar x)            = repLE x
 repE (SectionL x y)       = do { a <- repLE x; b <- repLE y; repSectionL a b }
 repE (SectionR x y)       = do { a <- repLE x; b <- repLE y; repSectionR a b }
 repE (HsCase e (MG { mg_alts = ms }))
                           = do { arg <- repLE e
                                ; ms2 <- mapM repMatchTup ms
-                               ; repCaseE arg (nonEmptyCoreList ms2) }
+                               ; core_ms2 <- coreList matchQTyConName ms2
+                               ; repCaseE arg core_ms2 }
 repE (HsIf _ x y z)         = do
-                             a <- repLE x
-                             b <- repLE y
-                             c <- repLE z
-                             repCond a b c
+                              a <- repLE x
+                              b <- repLE y
+                              c <- repLE z
+                              repCond a b c
 repE (HsMultiIf _ alts)
   = do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts
        ; expr' <- repMultiIf (nonEmptyCoreList alts')
        ; wrapGenSyms (concat binds) expr' }
 repE (HsLet bs e)         = do { (ss,ds) <- repBinds bs
-                              ; e2 <- addBinds ss (repLE e)
-                              ; z <- repLetE ds e2
-                              ; wrapGenSyms ss z }
+                               ; e2 <- addBinds ss (repLE e)
+                               ; z <- repLetE ds e2
+                               ; wrapGenSyms ss z }
 
 -- FIXME: I haven't got the types here right yet
 repE e@(HsDo ctxt sts _)
@@ -968,7 +983,7 @@ repE e@(HsDo ctxt sts _)
   | otherwise
   = notHandled "mdo, monad comprehension and [: :]" (ppr e)
 
-repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
+repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
 repE e@(ExplicitTuple es boxed)
   | not (all tupArgPresent es) = notHandled "Tuple sections" (ppr e)
@@ -985,30 +1000,30 @@ repE (RecordUpd e flds _ _ _)
         repRecUpd x fs }
 
 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
-repE (ArithSeq _ aseq) =
+repE (ArithSeq _ aseq) =
   case aseq of
     From e              -> do { ds1 <- repLE e; repFrom ds1 }
     FromThen e1 e2      -> do
-                            ds1 <- repLE e1
-                            ds2 <- repLE e2
-                            repFromThen ds1 ds2
+                             ds1 <- repLE e1
+                             ds2 <- repLE e2
+                             repFromThen ds1 ds2
     FromTo   e1 e2      -> do
-                            ds1 <- repLE e1
-                            ds2 <- repLE e2
-                            repFromTo ds1 ds2
+                             ds1 <- repLE e1
+                             ds2 <- repLE e2
+                             repFromTo ds1 ds2
     FromThenTo e1 e2 e3 -> do
-                            ds1 <- repLE e1
-                            ds2 <- repLE e2
-                            ds3 <- repLE e3
-                            repFromThenTo ds1 ds2 ds3
-
-repE (HsSpliceE splice)  = repSplice splice
-repE e@(PArrSeq {})      = notHandled "Parallel arrays" (ppr e)
-repE e@(HsCoreAnn {})    = notHandled "Core annotations" (ppr e)
-repE e@(HsSCC {})        = notHandled "Cost centres" (ppr e)
-repE e@(HsTickPragma {}) = notHandled "Tick Pragma" (ppr e)
-repE e@(HsBracketOut {}) = notHandled "TH brackets" (ppr e)
-repE e                          = notHandled "Expression form" (ppr e)
+                             ds1 <- repLE e1
+                             ds2 <- repLE e2
+                             ds3 <- repLE e3
+                             repFromThenTo ds1 ds2 ds3
+
+repE (HsSpliceE splice)  = repSplice splice
+repE e@(PArrSeq {})        = notHandled "Parallel arrays" (ppr e)
+repE e@(HsCoreAnn {})      = notHandled "Core annotations" (ppr e)
+repE e@(HsSCC {})          = notHandled "Cost centres" (ppr e)
+repE e@(HsTickPragma {})   = notHandled "Tick Pragma" (ppr e)
+repE e@(HsTcBracketOut {}) = notHandled "TH brackets" (ppr e)
+repE e                     = notHandled "Expression form" (ppr e)
 
 -----------------------------------------------------------------------------
 -- Building representations of auxillary structures like Match, Clause, Stmt,
@@ -1111,6 +1126,19 @@ repSts (BodyStmt e _ _ _ : ss) =
       ; z <- repNoBindSt e2
       ; (ss2,zs) <- repSts ss
       ; return (ss2, z : zs) }
+repSts (ParStmt stmt_blocks _ _ : ss) =
+   do { (ss_s, stmt_blocks1) <- mapAndUnzipM rep_stmt_block stmt_blocks
+      ; let stmt_blocks2 = nonEmptyCoreList stmt_blocks1
+            ss1 = concat ss_s
+      ; z <- repParSt stmt_blocks2
+      ; (ss2, zs) <- addBinds ss1 (repSts ss)
+      ; return (ss1++ss2, z : zs) }
+   where
+     rep_stmt_block :: ParStmtBlock Name Name -> DsM ([GenSymBind], Core [TH.StmtQ])
+     rep_stmt_block (ParStmtBlock stmts _ _) =
+       do { (ss1, zs) <- repSts (map unLoc stmts)
+          ; zs1 <- coreList stmtQTyConName zs
+          ; return (ss1, zs1) }
 repSts [LastStmt e _]
   = do { e2 <- repLE e
        ; z <- repNoBindSt e2
@@ -1120,44 +1148,44 @@ repSts other = notHandled "Exotic statement" (ppr other)
 
 
 -----------------------------------------------------------
---                     Bindings
+--                      Bindings
 -----------------------------------------------------------
 
 repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
 repBinds EmptyLocalBinds
-  = do { core_list <- coreList decQTyConName []
-       ; return ([], core_list) }
+  = do  { core_list <- coreList decQTyConName []
+        ; return ([], core_list) }
 
 repBinds b@(HsIPBinds _) = notHandled "Implicit parameters" (ppr b)
 
 repBinds (HsValBinds decs)
- = do  { let { bndrs = hsSigTvBinders decs ++ collectHsValBinders decs }
-               -- No need to worrry about detailed scopes within
-               -- the binding group, because we are talking Names
-               -- here, so we can safely treat it as a mutually
-               -- recursive group
+ = do   { let { bndrs = hsSigTvBinders decs ++ collectHsValBinders decs }
+                -- No need to worrry about detailed scopes within
+                -- the binding group, because we are talking Names
+                -- here, so we can safely treat it as a mutually
+                -- recursive group
                 -- For hsSigTvBinders see Note [Scoped type variables in bindings]
-       ; ss        <- mkGenSyms bndrs
-       ; prs       <- addBinds ss (rep_val_binds decs)
-       ; core_list <- coreList decQTyConName
-                               (de_loc (sort_by_loc prs))
-       ; return (ss, core_list) }
+        ; ss        <- mkGenSyms bndrs
+        ; prs       <- addBinds ss (rep_val_binds decs)
+        ; core_list <- coreList decQTyConName
+                                (de_loc (sort_by_loc prs))
+        ; return (ss, core_list) }
 
 rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
 -- Assumes: all the binders of the binding are alrady in the meta-env
 rep_val_binds (ValBindsOut binds sigs)
  = do { core1 <- rep_binds' (unionManyBags (map snd binds))
-      ;        core2 <- rep_sigs' sigs
-      ;        return (core1 ++ core2) }
+      ; core2 <- rep_sigs' sigs
+      ; return (core1 ++ core2) }
 rep_val_binds (ValBindsIn _ _)
  = panic "rep_val_binds: ValBindsIn"
 
 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
 rep_binds binds = do { binds_w_locs <- rep_binds' binds
-                    ; return (de_loc (sort_by_loc binds_w_locs)) }
+                     ; return (de_loc (sort_by_loc binds_w_locs)) }
 
 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
-rep_binds' binds = mapM rep_bind (bagToList binds)
+rep_binds' = mapM rep_bind . bagToList
 
 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
 -- Assumes: all the binders of the binding are alrady in the meta-env
@@ -1166,40 +1194,40 @@ rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
 -- e.g.  x = g 5 as a Fun MonoBinds. This is indicated by a single match
 -- with an empty list of patterns
 rep_bind (L loc (FunBind { fun_id = fn,
-                          fun_matches = MG { mg_alts = [L _ (Match [] _ (GRHSs guards wheres))] } }))
+                           fun_matches = MG { mg_alts = [L _ (Match [] _ (GRHSs guards wheres))] } }))
  = do { (ss,wherecore) <- repBinds wheres
-       ; guardcore <- addBinds ss (repGuards guards)
-       ; fn'  <- lookupLBinder fn
-       ; p    <- repPvar fn'
-       ; ans  <- repVal p guardcore wherecore
-       ; ans' <- wrapGenSyms ss ans
-       ; return (loc, ans') }
+        ; guardcore <- addBinds ss (repGuards guards)
+        ; fn'  <- lookupLBinder fn
+        ; p    <- repPvar fn'
+        ; ans  <- repVal p guardcore wherecore
+        ; ans' <- wrapGenSyms ss ans
+        ; return (loc, ans') }
 
 rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MG { mg_alts = ms } }))
  =   do { ms1 <- mapM repClauseTup ms
-       ; fn' <- lookupLBinder fn
+        ; fn' <- lookupLBinder fn
         ; ans <- repFun fn' (nonEmptyCoreList ms1)
         ; return (loc, ans) }
 
 rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
  =   do { patcore <- repLP pat
         ; (ss,wherecore) <- repBinds wheres
-       ; guardcore <- addBinds ss (repGuards guards)
+        ; guardcore <- addBinds ss (repGuards guards)
         ; ans  <- repVal patcore guardcore wherecore
-       ; ans' <- wrapGenSyms ss ans
+        ; ans' <- wrapGenSyms ss ans
         ; return (loc, ans') }
 
 rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
  =   do { v' <- lookupBinder v
-       ; e2 <- repLE e
+        ; e2 <- repLE e
         ; x <- repNormal e2
         ; patcore <- repPvar v'
-       ; empty_decls <- coreList decQTyConName []
+        ; empty_decls <- coreList decQTyConName []
         ; ans <- repVal patcore x empty_decls
         ; return (srcLocSpan (getSrcLoc v), ans) }
 
 rep_bind (L _ (AbsBinds {}))  = panic "rep_bind: AbsBinds"
-
+rep_bind (L _ dec@(PatSynBind {})) = notHandled "pattern synonyms" (ppr dec)
 -----------------------------------------------------------------------------
 -- Since everything in a Bind is mutually recursive we need rename all
 -- all the variables simultaneously. For example:
@@ -1229,14 +1257,14 @@ repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
  = do { let bndrs = collectPatsBinders ps ;
       ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
-               do { xs <- repLPs ps; body <- repLE e; repLam xs body })
+                do { xs <- repLPs ps; body <- repLE e; repLam xs body })
       ; wrapGenSyms ss lam }
 
 repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch (LambdaExpr :: HsMatchContext Name) m)
 
 
 -----------------------------------------------------------------------------
---                     Patterns
+--                      Patterns
 -- repP deals with patterns.  It assumes that we have already
 -- walked over the pattern(s) once to collect the binders, and
 -- have extended the environment.  So every pattern-bound
@@ -1257,7 +1285,8 @@ repP (LazyPat p)       = do { p1 <- repLP p; repPtilde p1 }
 repP (BangPat p)       = do { p1 <- repLP p; repPbang p1 }
 repP (AsPat x p)       = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
 repP (ParPat p)        = repLP p
-repP (ListPat ps _)    = do { qs <- repLPs ps; repPlist qs }
+repP (ListPat ps _ Nothing)    = do { qs <- repLPs ps; repPlist qs }
+repP (ListPat ps ty1 (Just (_,e))) = do { p <- repP (ListPat ps ty1 Nothing); e' <- repE e; repPview e' p}
 repP (TuplePat ps boxed _)
   | isBoxed boxed       = do { qs <- repLPs ps; repPtup qs }
   | otherwise           = do { qs <- repLPs ps; repPunboxedTup qs }
@@ -1275,17 +1304,19 @@ repP (ConPatIn dc details)
    rep_fld fld = do { MkC v <- lookupLOcc (hsRecFieldId fld)
                     ; MkC p <- repLP (hsRecFieldArg fld)
                     ; rep2 fieldPatName [v,p] }
+
 repP (NPat l Nothing _)  = do { a <- repOverloadedLiteral l; repPlit a }
 repP (ViewPat e p _) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }
 repP p@(NPat _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
 repP p@(SigPatIn {})  = notHandled "Type signatures in patterns" (ppr p)
-       -- The problem is to do with scoped type variables.
-       -- To implement them, we have to implement the scoping rules
-       -- here in DsMeta, and I don't want to do that today!
-       --       do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
-       --      repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
-       --      repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
+        -- The problem is to do with scoped type variables.
+        -- To implement them, we have to implement the scoping rules
+        -- here in DsMeta, and I don't want to do that today!
+        --       do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
+        --      repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
+        --      repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
+
+repP (SplicePat splice) = repSplice splice
 
 repP other = notHandled "Exotic pattern" (ppr other)
 
@@ -1300,20 +1331,20 @@ de_loc :: [(a, b)] -> [b]
 de_loc = map snd
 
 ----------------------------------------------------------
---     The meta-environment
+--      The meta-environment
 
 -- A name/identifier association for fresh names of locally bound entities
-type GenSymBind = (Name, Id)   -- Gensym the string and bind it to the Id
-                               -- I.e.         (x, x_id) means
-                               --      let x_id = gensym "x" in ...
+type GenSymBind = (Name, Id)    -- Gensym the string and bind it to the Id
+                                -- I.e.         (x, x_id) means
+                                --      let x_id = gensym "x" in ...
 
 -- Generate a fresh name for a locally bound entity
 
 mkGenSyms :: [Name] -> DsM [GenSymBind]
 -- We can use the existing name.  For example:
---     [| \x_77 -> x_77 + x_77 |]
+--      [| \x_77 -> x_77 + x_77 |]
 -- desugars to
---     do { x_77 <- genSym "x"; .... }
+--      do { x_77 <- genSym "x"; .... }
 -- We use the same x_77 in the desugared program, but with the type Bndr
 -- instead of Int
 --
@@ -1321,7 +1352,7 @@ mkGenSyms :: [Name] -> DsM [GenSymBind]
 --
 -- Nevertheless, it's monadic because we have to generate nameTy
 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
-                 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
+                  ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
 
 
 addBinds :: [GenSymBind] -> DsM a -> DsM a
@@ -1363,73 +1394,73 @@ lookupOcc :: Name -> DsM (Core TH.Name)
 lookupOcc n
   = do {  mb_val <- dsLookupMetaEnv n ;
           case mb_val of
-               Nothing         -> globalVar n
-               Just (Bound x)  -> return (coreVar x)
-               Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
+                Nothing         -> globalVar n
+                Just (Bound x)  -> return (coreVar x)
+                Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
     }
 
 globalVar :: Name -> DsM (Core TH.Name)
 -- Not bound by the meta-env
 -- Could be top-level; or could be local
---     f x = $(g [| x |])
+--      f x = $(g [| x |])
 -- Here the x will be local
 globalVar name
   | isExternalName name
-  = do { MkC mod <- coreStringLit name_mod
+  = do  { MkC mod <- coreStringLit name_mod
         ; MkC pkg <- coreStringLit name_pkg
-       ; MkC occ <- occNameLit name
-       ; rep2 mk_varg [pkg,mod,occ] }
+        ; MkC occ <- occNameLit name
+        ; rep2 mk_varg [pkg,mod,occ] }
   | otherwise
-  = do         { MkC occ <- occNameLit name
-       ; MkC uni <- coreIntLit (getKey (getUnique name))
-       ; rep2 mkNameLName [occ,uni] }
+  = do  { MkC occ <- occNameLit name
+        ; MkC uni <- coreIntLit (getKey (getUnique name))
+        ; rep2 mkNameLName [occ,uni] }
   where
       mod = ASSERT( isExternalName name) nameModule name
       name_mod = moduleNameString (moduleName mod)
       name_pkg = packageIdString (modulePackageId mod)
       name_occ = nameOccName name
       mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
-             | OccName.isVarOcc  name_occ = mkNameG_vName
-             | OccName.isTcOcc   name_occ = mkNameG_tcName
-             | otherwise                  = pprPanic "DsMeta.globalVar" (ppr name)
+              | OccName.isVarOcc  name_occ = mkNameG_vName
+              | OccName.isTcOcc   name_occ = mkNameG_tcName
+              | otherwise                  = pprPanic "DsMeta.globalVar" (ppr name)
 
-lookupType :: Name     -- Name of type constructor (e.g. TH.ExpQ)
-          -> DsM Type  -- The type
+lookupType :: Name      -- Name of type constructor (e.g. TH.ExpQ)
+           -> DsM Type  -- The type
 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
-                         return (mkTyConApp tc []) }
+                          return (mkTyConApp tc []) }
 
 wrapGenSyms :: [GenSymBind]
-           -> Core (TH.Q a) -> DsM (Core (TH.Q a))
+            -> Core (TH.Q a) -> DsM (Core (TH.Q a))
 -- wrapGenSyms [(nm1,id1), (nm2,id2)] y
---     --> bindQ (gensym nm1) (\ id1 ->
---         bindQ (gensym nm2 (\ id2 ->
---         y))
+--      --> bindQ (gensym nm1) (\ id1 ->
+--          bindQ (gensym nm2 (\ id2 ->
+--          y))
 
 wrapGenSyms binds body@(MkC b)
   = do  { var_ty <- lookupType nameTyConName
-       ; go var_ty binds }
+        ; go var_ty binds }
   where
     [elt_ty] = tcTyConAppArgs (exprType b)
-       -- b :: Q a, so we can get the type 'a' by looking at the
-       -- argument type. NB: this relies on Q being a data/newtype,
-       -- not a type synonym
+        -- b :: Q a, so we can get the type 'a' by looking at the
+        -- argument type. NB: this relies on Q being a data/newtype,
+        -- not a type synonym
 
     go _ [] = return body
     go var_ty ((name,id) : binds)
       = do { MkC body'  <- go var_ty binds
-          ; lit_str    <- occNameLit name
-          ; gensym_app <- repGensym lit_str
-          ; repBindQ var_ty elt_ty
-                     gensym_app (MkC (Lam id body')) }
+           ; lit_str    <- occNameLit name
+           ; gensym_app <- repGensym lit_str
+           ; repBindQ var_ty elt_ty
+                      gensym_app (MkC (Lam id body')) }
 
 occNameLit :: Name -> DsM (Core String)
 occNameLit n = coreStringLit (occNameString (nameOccName n))
 
 
 -- %*********************************************************************
--- %*                                                                  *
---             Constructing code
--- %*                                                                  *
+-- %*                                                                   *
+--              Constructing code
+-- %*                                                                   *
 -- %*********************************************************************
 
 -----------------------------------------------------------------------------
@@ -1456,9 +1487,9 @@ dataCon n = dataCon' n []
 
 
 -- %*********************************************************************
--- %*                                                                  *
---             The 'smart constructors'
--- %*                                                                  *
+-- %*                                                                   *
+--              The 'smart constructors'
+-- %*                                                                   *
 -- %*********************************************************************
 
 --------------- Patterns -----------------
@@ -1504,7 +1535,7 @@ repPview (MkC e) (MkC p) = rep2 viewPName [e,p]
 --------------- Expressions -----------------
 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
-                  | otherwise                  = repVar str
+                   | otherwise                  = repVar str
 
 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
 repVar (MkC s) = rep2 varEName [s]
@@ -1601,6 +1632,9 @@ repLetSt (MkC ds) = rep2 letSName [ds]
 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
 repNoBindSt (MkC e) = rep2 noBindSName [e]
 
+repParSt :: Core [[TH.StmtQ]] -> DsM (Core TH.StmtQ)
+repParSt (MkC sss) = rep2 parSName [sss]
+
 -------------- Range (Arithmetic sequences) -----------
 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
 repFrom (MkC x) = rep2 fromEName [x]
@@ -1692,14 +1726,32 @@ repFamilyKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
 repFamilyKind (MkC flav) (MkC nm) (MkC tvs) (MkC ki)
     = rep2 familyKindDName [flav, nm, tvs, ki]
 
-repTySynInst :: Core TH.Name -> Core [TH.TySynEqnQ] -> DsM (Core TH.DecQ)
-repTySynInst (MkC nm) (MkC eqns)
-  = rep2 tySynInstDName [nm, eqns]
+repTySynInst :: Core TH.Name -> Core TH.TySynEqnQ -> DsM (Core TH.DecQ)
+repTySynInst (MkC nm) (MkC eqn)
+    = rep2 tySynInstDName [nm, eqn]
+
+repClosedFamilyNoKind :: Core TH.Name
+                      -> Core [TH.TyVarBndr]
+                      -> Core [TH.TySynEqnQ]
+                      -> DsM (Core TH.DecQ)
+repClosedFamilyNoKind (MkC nm) (MkC tvs) (MkC eqns)
+    = rep2 closedTypeFamilyNoKindDName [nm, tvs, eqns]
+
+repClosedFamilyKind :: Core TH.Name
+                    -> Core [TH.TyVarBndr]
+                    -> Core TH.Kind
+                    -> Core [TH.TySynEqnQ]
+                    -> DsM (Core TH.DecQ)
+repClosedFamilyKind (MkC nm) (MkC tvs) (MkC ki) (MkC eqns)
+    = rep2 closedTypeFamilyKindDName [nm, tvs, ki, eqns]
 
 repTySynEqn :: Core [TH.TypeQ] -> Core TH.TypeQ -> DsM (Core TH.TySynEqnQ)
 repTySynEqn (MkC lhs) (MkC rhs)
   = rep2 tySynEqnName [lhs, rhs]
 
+repRoleAnnotD :: Core TH.Name -> Core [TH.Role] -> DsM (Core TH.DecQ)
+repRoleAnnotD (MkC n) (MkC roles) = rep2 roleAnnotDName [n, roles]
+
 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
 
@@ -1709,12 +1761,6 @@ repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
 repCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)
 repCtxt (MkC tys) = rep2 cxtName [tys]
 
-repClassP :: Core TH.Name -> Core [TH.TypeQ] -> DsM (Core TH.PredQ)
-repClassP (MkC cla) (MkC tys) = rep2 classPName [cla, tys]
-
-repEqualP :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.PredQ)
-repEqualP (MkC ty1) (MkC ty2) = rep2 equalPName [ty1, ty2]
-
 repConstr :: Core TH.Name -> HsConDeclDetails Name
           -> DsM (Core TH.ConQ)
 repConstr con (PrefixCon ps)
@@ -1753,6 +1799,9 @@ repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
 repTSig :: Core TH.TypeQ -> Core TH.Kind -> DsM (Core TH.TypeQ)
 repTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki]
 
+repTequality :: DsM (Core TH.TypeQ)
+repTequality = rep2 equalityTName []
+
 repTPromotedList :: [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
 repTPromotedList []     = repPromotedNilTyCon
 repTPromotedList (t:ts) = do  { tcon <- repPromotedConsTyCon
@@ -1836,7 +1885,7 @@ repKConstraint :: DsM (Core TH.Kind)
 repKConstraint = rep2 constraintKName []
 
 ----------------------------------------------------------
---             Literals
+--              Literals
 
 repLiteral :: HsLit -> DsM (Core TH.Lit)
 repLiteral lit
@@ -1849,20 +1898,20 @@ repLiteral lit
                    _ -> return lit
        lit_expr <- dsLit lit'
        case mb_lit_name of
-         Just lit_name -> rep2 lit_name [lit_expr]
-         Nothing -> notHandled "Exotic literal" (ppr lit)
+          Just lit_name -> rep2 lit_name [lit_expr]
+          Nothing -> notHandled "Exotic literal" (ppr lit)
   where
     mb_lit_name = case lit of
-                HsInteger _ _  -> Just integerLName
-                HsInt     _    -> Just integerLName
-                HsIntPrim _    -> Just intPrimLName
-                HsWordPrim _   -> Just wordPrimLName
-                HsFloatPrim _  -> Just floatPrimLName
-                HsDoublePrim _ -> Just doublePrimLName
-                HsChar _       -> Just charLName
-                HsString _     -> Just stringLName
-                HsRat _ _      -> Just rationalLName
-                _              -> Nothing
+                 HsInteger _ _  -> Just integerLName
+                 HsInt     _    -> Just integerLName
+                 HsIntPrim _    -> Just intPrimLName
+                 HsWordPrim _   -> Just wordPrimLName
+                 HsFloatPrim _  -> Just floatPrimLName
+                 HsDoublePrim _ -> Just doublePrimLName
+                 HsChar _       -> Just charLName
+                 HsString _     -> Just stringLName
+                 HsRat _ _      -> Just rationalLName
+                 _              -> Nothing
 
 mk_integer :: Integer -> DsM HsLit
 mk_integer  i = do integer_ty <- lookupType integerTyConName
@@ -1876,9 +1925,9 @@ mk_string s = return $ HsString s
 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
 repOverloadedLiteral (OverLit { ol_val = val})
   = do { lit <- mk_lit val; repLiteral lit }
-       -- The type Rational will be in the environment, because
-       -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
-       -- and rationalL is sucked in when any TH stuff is used
+        -- The type Rational will be in the environment, because
+        -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
+        -- and rationalL is sucked in when any TH stuff is used
 
 mk_lit :: OverLitVal -> DsM HsLit
 mk_lit (HsIntegral i)   = mk_integer  i
@@ -1890,8 +1939,8 @@ mk_lit (HsIsString s)   = mk_string   s
 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
 
-repBindQ :: Type -> Type       -- a and b
-        -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
+repBindQ :: Type -> Type        -- a and b
+         -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
 repBindQ ty_a ty_b (MkC x) (MkC y)
   = rep2 bindQName [Type ty_a, Type ty_b, x, y]
 
@@ -1902,25 +1951,25 @@ repSequenceQ ty_a (MkC list)
 ------------ Lists and Tuples -------------------
 -- turn a list of patterns into a single pattern matching a list
 
-repList :: Name -> (a  -> DsM (Core b)) 
+repList :: Name -> (a  -> DsM (Core b))
                 -> [a] -> DsM (Core [b])
 repList tc_name f args
   = do { args1 <- mapM f args
        ; coreList tc_name args1 }
 
-coreList :: Name       -- Of the TyCon of the element type
-        -> [Core a] -> DsM (Core [a])
+coreList :: Name        -- Of the TyCon of the element type
+         -> [Core a] -> DsM (Core [a])
 coreList tc_name es
   = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
 
-coreList' :: Type      -- The element type
-         -> [Core a] -> Core [a]
+coreList' :: Type       -- The element type
+          -> [Core a] -> Core [a]
 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
 
 nonEmptyCoreList :: [Core a] -> Core [a]
   -- The list must be non-empty so we can get the element type
   -- Otherwise use coreList
-nonEmptyCoreList []          = panic "coreList: empty argument"
+nonEmptyCoreList []           = panic "coreList: empty argument"
 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
 
 coreStringLit :: String -> DsM (Core String)
@@ -1932,7 +1981,7 @@ coreIntLit :: Int -> DsM (Core Int)
 coreIntLit i = do dflags <- getDynFlags
                   return (MkC (mkIntExprInt dflags i))
 
-coreVar :: Id -> Core TH.Name  -- The Id has type Name
+coreVar :: Id -> Core TH.Name   -- The Id has type Name
 coreVar id = MkC (Var id)
 
 ----------------- Failure -----------------------
@@ -1940,13 +1989,13 @@ notHandled :: String -> SDoc -> DsM a
 notHandled what doc = failWithDs msg
   where
     msg = hang (text what <+> ptext (sLit "not (yet) handled by Template Haskell"))
-            2 doc
+             2 doc
 
 
 -- %************************************************************************
--- %*                                                                  *
---             The known-key names for Template Haskell
--- %*                                                                  *
+-- %*                                                                   *
+--              The known-key names for Template Haskell
+-- %*                                                                   *
 -- %************************************************************************
 
 -- To add a name, do three things
@@ -1963,6 +2012,9 @@ templateHaskellNames = [
     returnQName, bindQName, sequenceQName, newNameName, liftName,
     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
     liftStringName,
+    unTypeName,
+    unTypeQName,
+    unsafeTExpCoerceName,
 
     -- Lit
     charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
@@ -1998,11 +2050,11 @@ templateHaskellNames = [
     pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,
     pragRuleDName,
     familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
-    tySynInstDName, infixLDName, infixRDName, infixNDName,
+    tySynInstDName, closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
+    infixLDName, infixRDName, infixNDName,
+    roleAnnotDName,
     -- Cxt
     cxtName,
-    -- Pred
-    classPName, equalPName,
     -- Strict
     isStrictName, notStrictName, unpackedName,
     -- Con
@@ -2012,13 +2064,15 @@ templateHaskellNames = [
     -- VarStrictType
     varStrictTypeName,
     -- Type
-    forallTName, varTName, conTName, appTName,
+    forallTName, varTName, conTName, appTName, equalityTName,
     tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName, litTName,
     promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
     -- TyLit
     numTyLitName, strTyLitName,
     -- TyVarBndr
     plainTVName, kindedTVName,
+    -- Role
+    nominalRName, representationalRName, phantomRName, inferRName,
     -- Kind
     varKName, conKName, tupleKName, arrowKName, listKName, appKName,
     starKName, constraintKName,
@@ -2034,6 +2088,8 @@ templateHaskellNames = [
     conLikeDataConName, funLikeDataConName,
     -- Phases
     allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName,
+    -- TExp
+    tExpDataConName,
     -- RuleBndr
     ruleVarName, typedRuleVarName,
     -- FunDep
@@ -2051,6 +2107,7 @@ templateHaskellNames = [
     typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
     patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
     predQTyConName, decsQTyConName, ruleBndrQTyConName, tySynEqnQTyConName,
+    roleTyConName, tExpTyConName,
 
     -- Quasiquoting
     quoteDecName, quoteTypeName, quoteExpName, quotePatName]
@@ -2075,7 +2132,7 @@ qqFun  = mk_known_key_name OccName.varName  qqLib
 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
     fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
     tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
-    predTyConName :: Name
+    predTyConName, tExpTyConName :: Name
 qTyConName        = thTc (fsLit "Q")            qTyConKey
 nameTyConName     = thTc (fsLit "Name")         nameTyConKey
 fieldExpTyConName = thTc (fsLit "FieldExp")     fieldExpTyConKey
@@ -2089,10 +2146,12 @@ matchTyConName    = thTc (fsLit "Match")        matchTyConKey
 clauseTyConName   = thTc (fsLit "Clause")       clauseTyConKey
 funDepTyConName   = thTc (fsLit "FunDep")       funDepTyConKey
 predTyConName     = thTc (fsLit "Pred")         predTyConKey
+tExpTyConName     = thTc (fsLit "TExp")         tExpTyConKey
 
 returnQName, bindQName, sequenceQName, newNameName, liftName,
     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
-    mkNameLName, liftStringName :: Name
+    mkNameLName, liftStringName, unTypeName, unTypeQName,
+    unsafeTExpCoerceName :: Name
 returnQName    = thFun (fsLit "returnQ")   returnQIdKey
 bindQName      = thFun (fsLit "bindQ")     bindQIdKey
 sequenceQName  = thFun (fsLit "sequenceQ") sequenceQIdKey
@@ -2104,6 +2163,9 @@ mkNameG_vName  = thFun (fsLit "mkNameG_v")  mkNameG_vIdKey
 mkNameG_dName  = thFun (fsLit "mkNameG_d")  mkNameG_dIdKey
 mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
 mkNameLName    = thFun (fsLit "mkNameL")    mkNameLIdKey
+unTypeName     = thFun (fsLit "unType")     unTypeIdKey
+unTypeQName    = thFun (fsLit "unTypeQ")    unTypeQIdKey
+unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey
 
 
 -------------------- TH.Lib -----------------------
@@ -2211,7 +2273,8 @@ funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
     instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
     pragSpecInlDName, pragSpecInstDName, pragRuleDName, familyNoKindDName,
     familyKindDName, dataInstDName, newtypeInstDName, tySynInstDName,
-    infixLDName, infixRDName, infixNDName :: Name
+    closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
+    infixLDName, infixRDName, infixNDName, roleAnnotDName :: Name
 funDName          = libFun (fsLit "funD")          funDIdKey
 valDName          = libFun (fsLit "valD")          valDIdKey
 dataDName         = libFun (fsLit "dataD")         dataDIdKey
@@ -2231,19 +2294,19 @@ familyKindDName   = libFun (fsLit "familyKindD")   familyKindDIdKey
 dataInstDName     = libFun (fsLit "dataInstD")     dataInstDIdKey
 newtypeInstDName  = libFun (fsLit "newtypeInstD")  newtypeInstDIdKey
 tySynInstDName    = libFun (fsLit "tySynInstD")    tySynInstDIdKey
+closedTypeFamilyKindDName
+                  = libFun (fsLit "closedTypeFamilyKindD") closedTypeFamilyKindDIdKey
+closedTypeFamilyNoKindDName
+                  = libFun (fsLit "closedTypeFamilyNoKindD") closedTypeFamilyNoKindDIdKey
 infixLDName       = libFun (fsLit "infixLD")       infixLDIdKey
 infixRDName       = libFun (fsLit "infixRD")       infixRDIdKey
 infixNDName       = libFun (fsLit "infixND")       infixNDIdKey
+roleAnnotDName    = libFun (fsLit "roleAnnotD")    roleAnnotDIdKey
 
 -- type Ctxt = ...
 cxtName :: Name
 cxtName = libFun (fsLit "cxt") cxtIdKey
 
--- data Pred = ...
-classPName, equalPName :: Name
-classPName = libFun (fsLit "classP") classPIdKey
-equalPName = libFun (fsLit "equalP") equalPIdKey
-
 -- data Strict = ...
 isStrictName, notStrictName, unpackedName :: Name
 isStrictName      = libFun  (fsLit "isStrict")      isStrictKey
@@ -2267,7 +2330,7 @@ varStrictTypeName = libFun  (fsLit "varStrictType") varStrictTKey
 
 -- data Type = ...
 forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
-    listTName, appTName, sigTName, litTName,
+    listTName, appTName, sigTName, equalityTName, litTName,
     promotedTName, promotedTupleTName,
     promotedNilTName, promotedConsTName :: Name
 forallTName         = libFun (fsLit "forallT")        forallTIdKey
@@ -2279,6 +2342,7 @@ arrowTName          = libFun (fsLit "arrowT")         arrowTIdKey
 listTName           = libFun (fsLit "listT")          listTIdKey
 appTName            = libFun (fsLit "appT")           appTIdKey
 sigTName            = libFun (fsLit "sigT")           sigTIdKey
+equalityTName       = libFun (fsLit "equalityT")      equalityTIdKey
 litTName            = libFun (fsLit "litT")           litTIdKey
 promotedTName       = libFun (fsLit "promotedT")      promotedTIdKey
 promotedTupleTName  = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
@@ -2292,8 +2356,15 @@ strTyLitName = libFun (fsLit "strTyLit") strTyLitIdKey
 
 -- data TyVarBndr = ...
 plainTVName, kindedTVName :: Name
-plainTVName  = libFun (fsLit "plainTV")  plainTVIdKey
-kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
+plainTVName       = libFun (fsLit "plainTV")       plainTVIdKey
+kindedTVName      = libFun (fsLit "kindedTV")      kindedTVIdKey
+
+-- data Role = ...
+nominalRName, representationalRName, phantomRName, inferRName :: Name
+nominalRName          = libFun (fsLit "nominalR")          nominalRIdKey
+representationalRName = libFun (fsLit "representationalR") representationalRIdKey
+phantomRName          = libFun (fsLit "phantomR")          phantomRIdKey
+inferRName            = libFun (fsLit "inferR")            inferRIdKey
 
 -- data Kind = ...
 varKName, conKName, tupleKName, arrowKName, listKName, appKName,
@@ -2335,6 +2406,10 @@ allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
 fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
 beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
 
+-- newtype TExp a = ...
+tExpDataConName :: Name
+tExpDataConName = thCon (fsLit "TExp") tExpDataConKey
+
 -- data RuleBndr = ...
 ruleVarName, typedRuleVarName :: Name
 ruleVarName      = libFun (fsLit ("ruleVar"))      ruleVarIdKey
@@ -2357,7 +2432,7 @@ matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
     decQTyConName, conQTyConName, strictTypeQTyConName,
     varStrictTypeQTyConName, typeQTyConName, fieldExpQTyConName,
     patQTyConName, fieldPatQTyConName, predQTyConName, decsQTyConName,
-    ruleBndrQTyConName, tySynEqnQTyConName :: Name
+    ruleBndrQTyConName, tySynEqnQTyConName, roleTyConName :: Name
 matchQTyConName         = libTc (fsLit "MatchQ")         matchQTyConKey
 clauseQTyConName        = libTc (fsLit "ClauseQ")        clauseQTyConKey
 expQTyConName           = libTc (fsLit "ExpQ")           expQTyConKey
@@ -2374,13 +2449,14 @@ fieldPatQTyConName      = libTc (fsLit "FieldPatQ")      fieldPatQTyConKey
 predQTyConName          = libTc (fsLit "PredQ")          predQTyConKey
 ruleBndrQTyConName      = libTc (fsLit "RuleBndrQ")      ruleBndrQTyConKey
 tySynEqnQTyConName      = libTc (fsLit "TySynEqnQ")      tySynEqnQTyConKey
+roleTyConName           = libTc (fsLit "Role")           roleTyConKey
 
 -- quasiquoting
 quoteExpName, quotePatName, quoteDecName, quoteTypeName :: Name
-quoteExpName       = qqFun (fsLit "quoteExp")  quoteExpKey
-quotePatName       = qqFun (fsLit "quotePat")  quotePatKey
-quoteDecName       = qqFun (fsLit "quoteDec")  quoteDecKey
-quoteTypeName      = qqFun (fsLit "quoteType") quoteTypeKey
+quoteExpName        = qqFun (fsLit "quoteExp")  quoteExpKey
+quotePatName        = qqFun (fsLit "quotePat")  quotePatKey
+quoteDecName        = qqFun (fsLit "quoteDec")  quoteDecKey
+quoteTypeName       = qqFun (fsLit "quoteType") quoteTypeKey
 
 -- TyConUniques available: 200-299
 -- Check in PrelNames if you want to change this
@@ -2391,7 +2467,8 @@ expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
     decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
     fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
     fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
-    predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey :: Unique
+    predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey,
+    roleTyConKey, tExpTyConKey :: Unique
 expTyConKey             = mkPreludeTyConUnique 200
 matchTyConKey           = mkPreludeTyConUnique 201
 clauseTyConKey          = mkPreludeTyConUnique 202
@@ -2421,13 +2498,15 @@ tyVarBndrTyConKey       = mkPreludeTyConUnique 225
 decsQTyConKey           = mkPreludeTyConUnique 226
 ruleBndrQTyConKey       = mkPreludeTyConUnique 227
 tySynEqnQTyConKey       = mkPreludeTyConUnique 228
+roleTyConKey            = mkPreludeTyConUnique 229
+tExpTyConKey            = mkPreludeTyConUnique 230
 
 -- IdUniques available: 200-499
 -- If you want to change this, make sure you check in PrelNames
 
 returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
     mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
-    mkNameLIdKey :: Unique
+    mkNameLIdKey, unTypeIdKey, unTypeQIdKey, unsafeTExpCoerceIdKey :: Unique
 returnQIdKey        = mkPreludeMiscIdUnique 200
 bindQIdKey          = mkPreludeMiscIdUnique 201
 sequenceQIdKey      = mkPreludeMiscIdUnique 202
@@ -2438,6 +2517,9 @@ mkNameG_vIdKey       = mkPreludeMiscIdUnique 206
 mkNameG_dIdKey       = mkPreludeMiscIdUnique 207
 mkNameG_tcIdKey      = mkPreludeMiscIdUnique 208
 mkNameLIdKey         = mkPreludeMiscIdUnique 209
+unTypeIdKey          = mkPreludeMiscIdUnique 210
+unTypeQIdKey         = mkPreludeMiscIdUnique 211
+unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 212
 
 
 -- data Lit = ...
@@ -2547,39 +2629,38 @@ funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
     pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey, pragRuleDIdKey,
     familyNoKindDIdKey, familyKindDIdKey,
     dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey,
-    infixLDIdKey, infixRDIdKey, infixNDIdKey :: Unique
-funDIdKey          = mkPreludeMiscIdUnique 330
-valDIdKey          = mkPreludeMiscIdUnique 331
-dataDIdKey         = mkPreludeMiscIdUnique 332
-newtypeDIdKey      = mkPreludeMiscIdUnique 333
-tySynDIdKey        = mkPreludeMiscIdUnique 334
-classDIdKey        = mkPreludeMiscIdUnique 335
-instanceDIdKey     = mkPreludeMiscIdUnique 336
-sigDIdKey          = mkPreludeMiscIdUnique 337
-forImpDIdKey       = mkPreludeMiscIdUnique 338
-pragInlDIdKey      = mkPreludeMiscIdUnique 339
-pragSpecDIdKey     = mkPreludeMiscIdUnique 340
-pragSpecInlDIdKey  = mkPreludeMiscIdUnique 341
-pragSpecInstDIdKey = mkPreludeMiscIdUnique 412
-pragRuleDIdKey     = mkPreludeMiscIdUnique 413
-familyNoKindDIdKey = mkPreludeMiscIdUnique 342
-familyKindDIdKey   = mkPreludeMiscIdUnique 343
-dataInstDIdKey     = mkPreludeMiscIdUnique 344
-newtypeInstDIdKey  = mkPreludeMiscIdUnique 345
-tySynInstDIdKey    = mkPreludeMiscIdUnique 346
-infixLDIdKey       = mkPreludeMiscIdUnique 347
-infixRDIdKey       = mkPreludeMiscIdUnique 348
-infixNDIdKey       = mkPreludeMiscIdUnique 349
+    closedTypeFamilyKindDIdKey, closedTypeFamilyNoKindDIdKey,
+    infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey :: Unique
+funDIdKey                    = mkPreludeMiscIdUnique 330
+valDIdKey                    = mkPreludeMiscIdUnique 331
+dataDIdKey                   = mkPreludeMiscIdUnique 332
+newtypeDIdKey                = mkPreludeMiscIdUnique 333
+tySynDIdKey                  = mkPreludeMiscIdUnique 334
+classDIdKey                  = mkPreludeMiscIdUnique 335
+instanceDIdKey               = mkPreludeMiscIdUnique 336
+sigDIdKey                    = mkPreludeMiscIdUnique 337
+forImpDIdKey                 = mkPreludeMiscIdUnique 338
+pragInlDIdKey                = mkPreludeMiscIdUnique 339
+pragSpecDIdKey               = mkPreludeMiscIdUnique 340
+pragSpecInlDIdKey            = mkPreludeMiscIdUnique 341
+pragSpecInstDIdKey           = mkPreludeMiscIdUnique 417
+pragRuleDIdKey               = mkPreludeMiscIdUnique 418
+familyNoKindDIdKey           = mkPreludeMiscIdUnique 342
+familyKindDIdKey             = mkPreludeMiscIdUnique 343
+dataInstDIdKey               = mkPreludeMiscIdUnique 344
+newtypeInstDIdKey            = mkPreludeMiscIdUnique 345
+tySynInstDIdKey              = mkPreludeMiscIdUnique 346
+closedTypeFamilyKindDIdKey   = mkPreludeMiscIdUnique 347
+closedTypeFamilyNoKindDIdKey = mkPreludeMiscIdUnique 348
+infixLDIdKey                 = mkPreludeMiscIdUnique 349
+infixRDIdKey                 = mkPreludeMiscIdUnique 350
+infixNDIdKey                 = mkPreludeMiscIdUnique 351
+roleAnnotDIdKey              = mkPreludeMiscIdUnique 352
 
 -- type Cxt = ...
 cxtIdKey :: Unique
 cxtIdKey            = mkPreludeMiscIdUnique 360
 
--- data Pred = ...
-classPIdKey, equalPIdKey :: Unique
-classPIdKey         = mkPreludeMiscIdUnique 361
-equalPIdKey         = mkPreludeMiscIdUnique 362
-
 -- data Strict = ...
 isStrictKey, notStrictKey, unpackedKey :: Unique
 isStrictKey         = mkPreludeMiscIdUnique 363
@@ -2603,7 +2684,7 @@ varStrictTKey     = mkPreludeMiscIdUnique 375
 
 -- data Type = ...
 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey,
-    listTIdKey, appTIdKey, sigTIdKey, litTIdKey,
+    listTIdKey, appTIdKey, sigTIdKey, equalityTIdKey, litTIdKey,
     promotedTIdKey, promotedTupleTIdKey,
     promotedNilTIdKey, promotedConsTIdKey :: Unique
 forallTIdKey        = mkPreludeMiscIdUnique 380
@@ -2615,44 +2696,52 @@ arrowTIdKey         = mkPreludeMiscIdUnique 385
 listTIdKey          = mkPreludeMiscIdUnique 386
 appTIdKey           = mkPreludeMiscIdUnique 387
 sigTIdKey           = mkPreludeMiscIdUnique 388
-litTIdKey           = mkPreludeMiscIdUnique 389
-promotedTIdKey      = mkPreludeMiscIdUnique 390
-promotedTupleTIdKey = mkPreludeMiscIdUnique 391
-promotedNilTIdKey   = mkPreludeMiscIdUnique 392
-promotedConsTIdKey  = mkPreludeMiscIdUnique 393
+equalityTIdKey      = mkPreludeMiscIdUnique 389
+litTIdKey           = mkPreludeMiscIdUnique 390
+promotedTIdKey      = mkPreludeMiscIdUnique 391
+promotedTupleTIdKey = mkPreludeMiscIdUnique 392
+promotedNilTIdKey   = mkPreludeMiscIdUnique 393
+promotedConsTIdKey  = mkPreludeMiscIdUnique 394
 
 -- data TyLit = ...
 numTyLitIdKey, strTyLitIdKey :: Unique
-numTyLitIdKey = mkPreludeMiscIdUnique 394
-strTyLitIdKey = mkPreludeMiscIdUnique 395
+numTyLitIdKey = mkPreludeMiscIdUnique 395
+strTyLitIdKey = mkPreludeMiscIdUnique 396
 
 -- data TyVarBndr = ...
 plainTVIdKey, kindedTVIdKey :: Unique
-plainTVIdKey      = mkPreludeMiscIdUnique 396
-kindedTVIdKey     = mkPreludeMiscIdUnique 397
+plainTVIdKey       = mkPreludeMiscIdUnique 397
+kindedTVIdKey      = mkPreludeMiscIdUnique 398
+
+-- data Role = ...
+nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
+nominalRIdKey          = mkPreludeMiscIdUnique 400
+representationalRIdKey = mkPreludeMiscIdUnique 401
+phantomRIdKey          = mkPreludeMiscIdUnique 402
+inferRIdKey            = mkPreludeMiscIdUnique 403
 
 -- data Kind = ...
 varKIdKey, conKIdKey, tupleKIdKey, arrowKIdKey, listKIdKey, appKIdKey,
   starKIdKey, constraintKIdKey :: Unique
-varKIdKey         = mkPreludeMiscIdUnique 398
-conKIdKey         = mkPreludeMiscIdUnique 399
-tupleKIdKey       = mkPreludeMiscIdUnique 400
-arrowKIdKey       = mkPreludeMiscIdUnique 401
-listKIdKey        = mkPreludeMiscIdUnique 402
-appKIdKey         = mkPreludeMiscIdUnique 403
-starKIdKey        = mkPreludeMiscIdUnique 404
-constraintKIdKey  = mkPreludeMiscIdUnique 405
+varKIdKey         = mkPreludeMiscIdUnique 404
+conKIdKey         = mkPreludeMiscIdUnique 405
+tupleKIdKey       = mkPreludeMiscIdUnique 406
+arrowKIdKey       = mkPreludeMiscIdUnique 407
+listKIdKey        = mkPreludeMiscIdUnique 408
+appKIdKey         = mkPreludeMiscIdUnique 409
+starKIdKey        = mkPreludeMiscIdUnique 410
+constraintKIdKey  = mkPreludeMiscIdUnique 411
 
 -- data Callconv = ...
 cCallIdKey, stdCallIdKey :: Unique
-cCallIdKey      = mkPreludeMiscIdUnique 406
-stdCallIdKey    = mkPreludeMiscIdUnique 407
+cCallIdKey      = mkPreludeMiscIdUnique 412
+stdCallIdKey    = mkPreludeMiscIdUnique 413
 
 -- data Safety = ...
 unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
-unsafeIdKey        = mkPreludeMiscIdUnique 408
-safeIdKey          = mkPreludeMiscIdUnique 409
-interruptibleIdKey = mkPreludeMiscIdUnique 411
+unsafeIdKey        = mkPreludeMiscIdUnique 414
+safeIdKey          = mkPreludeMiscIdUnique 415
+interruptibleIdKey = mkPreludeMiscIdUnique 416
 
 -- data Inline = ...
 noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
@@ -2671,27 +2760,31 @@ allPhasesDataConKey   = mkPreludeDataConUnique 45
 fromPhaseDataConKey   = mkPreludeDataConUnique 46
 beforePhaseDataConKey = mkPreludeDataConUnique 47
 
+-- newtype TExp a = ...
+tExpDataConKey :: Unique
+tExpDataConKey = mkPreludeDataConUnique 48
+
 -- data FunDep = ...
 funDepIdKey :: Unique
-funDepIdKey = mkPreludeMiscIdUnique 414
+funDepIdKey = mkPreludeMiscIdUnique 419
 
 -- data FamFlavour = ...
 typeFamIdKey, dataFamIdKey :: Unique
-typeFamIdKey = mkPreludeMiscIdUnique 415
-dataFamIdKey = mkPreludeMiscIdUnique 416
+typeFamIdKey = mkPreludeMiscIdUnique 420
+dataFamIdKey = mkPreludeMiscIdUnique 421
 
 -- data TySynEqn = ...
 tySynEqnIdKey :: Unique
-tySynEqnIdKey = mkPreludeMiscIdUnique 417
+tySynEqnIdKey = mkPreludeMiscIdUnique 422
 
 -- quasiquoting
 quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique
-quoteExpKey  = mkPreludeMiscIdUnique 418
-quotePatKey  = mkPreludeMiscIdUnique 419
-quoteDecKey  = mkPreludeMiscIdUnique 420
-quoteTypeKey = mkPreludeMiscIdUnique 421
+quoteExpKey  = mkPreludeMiscIdUnique 423
+quotePatKey  = mkPreludeMiscIdUnique 424
+quoteDecKey  = mkPreludeMiscIdUnique 425
+quoteTypeKey = mkPreludeMiscIdUnique 426
 
 -- data RuleBndr = ...
 ruleVarIdKey, typedRuleVarIdKey :: Unique
-ruleVarIdKey      = mkPreludeMiscIdUnique 422
-typedRuleVarIdKey = mkPreludeMiscIdUnique 423
+ruleVarIdKey      = mkPreludeMiscIdUnique 427
+typedRuleVarIdKey = mkPreludeMiscIdUnique 428