Line up kind and type variables correctly when desugaring TH brackets
[ghc.git] / compiler / deSugar / DsMeta.hs
index 98aec5f..b5d1b0f 100644 (file)
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2006
 -- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
 --
 -- It also defines a bunch of knownKeyNames, in the same way as is done
--- in prelude/PrelNames.  It's much more convenient to do it here, becuase
+-- in prelude/PrelNames.  It's much more convenient to do it here, because
 -- otherwise we have to recompile PrelNames whenever we add a Name, which is
 -- 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, 
+module DsMeta( dsBracket,
+               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
@@ -44,16 +41,16 @@ import PrelNames
 -- OccName.varName we do this by removing varName from the import of
 -- OccName above, making a qualified instance of OccName and using
 -- OccNameAlias.varName where varName ws previously used in this file.
-import qualified OccName( isDataOcc, isVarOcc, isTcOcc, varName, tcName ) 
+import qualified OccName( isDataOcc, isVarOcc, isTcOcc, varName, tcName, dataName )
 
 import Module
 import Id
-import Name hiding( isVarOcc, isTcOcc, varName, tcName ) 
+import Name hiding( isVarOcc, isTcOcc, varName, tcName )
 import NameEnv
 import TcType
 import TyCon
 import TysWiredIn
-import TysPrim ( liftedTypeKindTyConName )
+import TysPrim ( liftedTypeKindTyConName, constraintKindTyConName )
 import CoreSyn
 import MkCore
 import CoreUtils
@@ -62,17 +59,18 @@ import Unique
 import BasicTypes
 import Outputable
 import Bag
+import DynFlags
 import FastString
 import ForeignCall
-import MonadUtils
-import Util( equalLength, filterOut )
+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,11 +104,11 @@ dsBracket brack splices
 
 
 -------------------------------------------------------
---                     Declarations
+--                      Declarations
 -------------------------------------------------------
 
 repTopP :: LPat Name -> DsM (Core TH.PatQ)
-repTopP pat = do { ss <- mkGenSyms (collectPatBinders pat) 
+repTopP pat = do { ss <- mkGenSyms (collectPatBinders pat)
                  ; pat' <- addBinds ss (repLP pat)
                  ; wrapGenSyms ss pat' }
 
@@ -117,33 +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 ;
-
-       -- 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 {
+        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
+
+        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) ;
-                       for_ds <- mapM repForD (hs_fords group) ;
-                       -- more needed
-                       return (de_loc $ sort_by_loc $ 
-                                val_ds ++ catMaybes tycl_ds ++ fix_ds
-                                       ++ inst_ds ++ for_ds) }) ;
-
-       decl_ty <- lookupType decQTyConName ;
-       let { core_list = coreList' decl_ty decls } ;
-
-       dec_ty <- lookupType decTyConName ;
-       q_decs  <- repSequenceQ dec_ty core_list ;
-
-       wrapGenSyms ss q_decs
+                        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 } ;
+
+        dec_ty <- lookupType decTyConName ;
+        q_decs  <- repSequenceQ dec_ty core_list ;
+
+        wrapGenSyms ss q_decs
       }
 
 
@@ -154,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
@@ -166,7 +167,7 @@ Consider
    f :: forall a. a -> a
    f x = x::a
 Here the 'forall a' brings 'a' into scope over the binding group.
-To achieve this we 
+To achieve this we
 
   a) Gensym a binding for 'a' at the same time as we do one for 'f'
      collecting the relevant binders with hsSigTvBinders
@@ -179,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
@@ -201,86 +202,117 @@ in repTyClD and repC.
 
 -- represent associated family instances
 --
-repTyClDs :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
-repTyClDs ds = liftM de_loc (mapMaybeM repTyClD ds)
-
-
 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 
-repTyClD (L loc (TyFamily { tcdFlavour = flavour,
-                           tcdLName   = tc, tcdTyVars = tvs, 
-                           tcdKindSig = opt_kind }))
-  = do { tc1 <- lookupLOcc tc          -- See note [Binders and occurrences] 
+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 ->
-           do { flav   <- repFamilyFlavour flavour
-             ; case opt_kind of 
-                  Nothing -> repFamilyNoKind flav tc1 bndrs
-                  Just ki -> do { ki1 <- repKind ki 
-                                ; repFamilyKind flav tc1 bndrs ki1 }
-              }
-       ; return $ Just (loc, dec)
-       }
+                repSynDecl tc1 bndrs rhs
+       ; return (Just (loc, dec)) }
 
-repTyClD (L loc (TyDecl { tcdLName = tc, tcdTyVars = tvs, tcdTyDefn = defn }))
-  = do { tc1 <- lookupLOcc tc          -- See note [Binders and occurrences]  
+repTyClD (L loc (DataDecl { tcdLName = tc, tcdTyVars = tvs, tcdDataDefn = defn }))
+  = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
        ; tc_tvs <- mk_extra_tvs tc tvs defn
-       ; dec <- addTyClTyVarBinds tc_tvs $ \bndrs -> 
-               repTyDefn 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
-              ; ats1   <- repTyClDs ats
-             ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
-             ; repClass cxt1 cls1 bndrs fds1 decls1 
+              ; 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
               }
-       ; 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 }
 
 -------------------------
-repTyDefn :: Core TH.Name -> Core [TH.TyVarBndr] 
-          -> Maybe (Core [TH.TypeQ])
-          -> [Name] -> HsTyDefn Name
-          -> DsM (Core TH.DecQ)
-repTyDefn tc bndrs opt_tys tv_names
-          (TyData { td_ND = new_or_data, td_ctxt = cxt
-                 , td_cons = cons, td_derivs = mb_derivs })
+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]
+            -> Maybe (Core [TH.TypeQ])
+            -> [Name] -> HsDataDefn Name
+            -> 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 })
   = do { cxt1     <- repLContext cxt
        ; derivs1  <- repDerivs mb_derivs
        ; case new_or_data of
            NewType  -> do { con1 <- repC tv_names (head cons)
                           ; repNewtype cxt1 tc bndrs opt_tys con1 derivs1 }
-           DataType -> do { cons1 <- mapM (repC tv_names) cons
-                          ; cons2 <- coreList conQTyConName cons1
-                          ; repData cxt1 tc bndrs opt_tys cons2 derivs1 } }
+           DataType -> do { cons1 <- repList conQTyConName (repC tv_names) cons
+                          ; repData cxt1 tc bndrs opt_tys cons1 derivs1 } }
 
-repTyDefn tc bndrs opt_tys _ (TySynonym { td_synRhs = ty })
+repSynDecl :: Core TH.Name -> Core [TH.TyVarBndr]
+          -> LHsType Name
+          -> DsM (Core TH.DecQ)
+repSynDecl tc bndrs ty
   = do { ty1 <- repLTy ty
-       ; repTySyn tc bndrs opt_tys ty1 }
+       ; repTySyn tc bndrs ty1 }
+
+repFamilyDecl :: LFamilyDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repFamilyDecl (L loc (FamilyDecl { fdInfo    = info,
+                                   fdLName   = tc,
+                                   fdTyVars  = tvs,
+                                   fdKindSig = opt_kind }))
+  = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
+       ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
+           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)
+       }
+
+repFamilyDecls :: [LFamilyDecl Name] -> DsM [Core TH.DecQ]
+repFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds)
 
 -------------------------
-mk_extra_tvs :: Located Name -> LHsTyVarBndrs Name 
-             -> HsTyDefn Name -> DsM (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 -> *
 -- Return type variables [tv1:k1, tv2:k2, .., tvn:kn]
 mk_extra_tvs tc tvs defn
-  | TyData { td_kindSig = Just hs_kind } <- defn
+  | HsDataDefn { dd_kindSig = Just hs_kind } <- defn
   = do { extra_tvs <- go hs_kind
-       ; return (mkHsQTvs (hsQTvBndrs tvs ++ extra_tvs)) }
+       ; return (tvs { hsq_tvs = hsq_tvs tvs ++ extra_tvs }) }
   | otherwise
   = return tvs
   where
@@ -296,75 +328,97 @@ mk_extra_tvs tc tvs defn
     go (L _ (HsTyVar n))
       | n == liftedTypeKindTyConName
       = return []
-   
+
     go _ = failWithDs (ptext (sLit "Malformed kind signature for") <+> ppr tc)
 
 -------------------------
 -- represent fundeps
 --
 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
-repLFunDeps fds = do fds' <- mapM repLFunDep fds
-                     fdList <- coreList funDepTyConName fds'
-                     return fdList
+repLFunDeps fds = repList funDepTyConName repLFunDep fds
 
 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
-repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
-                               ys' <- mapM lookupBinder ys
-                               xs_list <- coreList nameTyConName xs'
-                               ys_list <- coreList nameTyConName ys'
-                               repFunDep xs_list ys_list
+repLFunDep (L _ (xs, ys)) = do xs' <- repList nameTyConName lookupBinder xs
+                               ys' <- repList nameTyConName lookupBinder ys
+                               repFunDep xs' ys'
 
 -- 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
 --
 repInstD :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ)
-repInstD (L loc (FamInstD { lid_inst = fi_decl }))
-  = do { dec <- repFamInstD fi_decl
+repInstD (L loc (TyFamInstD { tfid_inst = fi_decl }))
+  = do { dec <- repTyFamInstD fi_decl
+       ; return (loc, dec) }
+repInstD (L loc (DataFamInstD { dfid_inst = fi_decl }))
+  = do { dec <- repDataFamInstD fi_decl
+       ; return (loc, dec) }
+repInstD (L loc (ClsInstD { cid_inst = cls_decl }))
+  = do { dec <- repClsInstD cls_decl
        ; return (loc, dec) }
 
-repInstD (L loc (ClsInstD { cid_poly_ty = ty, cid_binds = binds
-                          , cid_sigs = prags, cid_fam_insts = ats }))
-  = do { dec <- addTyVarBinds tvs $ \_ ->
-           -- We must bring the type variables into scope, so their
-           -- occurrences don't fail, even though the binders don't 
+repClsInstD :: ClsInstDecl Name -> DsM (Core TH.DecQ)
+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
             -- appear in the resulting data structure
-           --
-           -- But we do NOT bring the binders of 'binds' into scope
-           -- becuase 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
                ; inst_ty1 <- repTapps cls_tcon cls_tys
                ; binds1 <- rep_binds binds
                ; prags1 <- rep_sigs prags
-               ; ats1 <- mapM (repFamInstD . unLoc) ats
-               ; decls <- coreList decQTyConName (ats1 ++ binds1 ++ prags1)
+               ; ats1 <- mapM (repTyFamInstD . unLoc) ats
+               ; adts1 <- mapM (repDataFamInstD . unLoc) adts
+               ; decls <- coreList decQTyConName (ats1 ++ adts1 ++ binds1 ++ prags1)
                ; repInst cxt1 inst_ty1 decls }
-       ; return (loc, dec) }
  where
    Just (tvs, cxt, cls, tys) = splitLHsInstDeclTy_maybe ty
 
-repFamInstD :: FamInstDecl Name -> DsM (Core TH.DecQ)
-repFamInstD (FamInstDecl { fid_tycon = tc_name
-                         , fid_pats = HsWB { hswb_cts = tys, hswb_kvs = kv_names, hswb_tvs = tv_names }
-                         , fid_defn = defn })
-  = WARN( not (null kv_names), ppr kv_names )   -- We have not yet dealt with kind 
-                                                -- polymorphism in Template Haskell (sigh)
-    do { tc <- lookupLOcc tc_name              -- See note [Binders and occurrences]  
-       ; let loc = getLoc tc_name
-             hs_tvs = mkHsQTvs (userHsTyVarBndrs loc tv_names)   -- Yuk
-       ; addTyClTyVarBinds hs_tvs $ \ bndrs ->
+repTyFamInstD :: TyFamInstDecl Name -> DsM (Core TH.DecQ)
+repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
+  = do { let tc_name = tyFamInstDeclLName decl
+       ; 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
+                                                    , hswb_kvs = kv_names
+                                                    , hswb_tvs = tv_names }
+                                 , tfie_rhs = rhs }))
+  = do { let hs_tvs = HsQTvs { hsq_kvs = kv_names
+                             , hsq_tvs = userHsTyVarBndrs loc tv_names }   -- Yuk
+       ; addTyClTyVarBinds hs_tvs $ \ _ ->
          do { tys1 <- repLTys tys
             ; tys2 <- coreList typeQTyConName tys1
-            ; repTyDefn tc bndrs (Just tys2) tv_names defn } }
+            ; rhs1 <- repLTy rhs
+            ; repTySynEqn tys2 rhs1 } }
+
+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]
+       ; let loc = getLoc tc_name
+             hs_tvs = HsQTvs { hsq_kvs = kv_names, hsq_tvs = userHsTyVarBndrs loc tv_names }   -- Yuk
+       ; addTyClTyVarBinds hs_tvs $ \ bndrs ->
+         do { tys1 <- repList typeQTyConName repLTy tys
+            ; repDataDefn tc bndrs (Just tys1) tv_names defn } }
 
 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
 repForD (L loc (ForeignImport name typ _ (CImport cc s mch cis)))
@@ -404,75 +458,105 @@ repFixD :: LFixitySig Name -> DsM (SrcSpan, Core TH.DecQ)
 repFixD (L loc (FixitySig name (Fixity prec dir)))
   = do { MkC name' <- lookupLOcc name
        ; MkC prec' <- coreIntLit prec
-       ; let rep_fn = case dir of 
+       ; let rep_fn = case dir of
                         InfixL -> infixLDName
                         InfixR -> infixRDName
                         InfixN -> infixNDName
        ; dec <- rep2 rep_fn [prec', name']
        ; return (loc, dec) }
 
+repRuleD :: LRuleDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repRuleD (L loc (HsRule n act bndrs lhs _ rhs _))
+  = do { let bndr_names = concatMap ruleBndrNames bndrs
+       ; ss <- mkGenSyms bndr_names
+       ; rule1 <- addBinds ss $
+                  do { bndrs' <- repList ruleBndrQTyConName repRuleBndr bndrs
+                     ; n'   <- coreStringLit $ unpackFS n
+                     ; act' <- repPhases act
+                     ; lhs' <- repLE lhs
+                     ; rhs' <- repLE rhs
+                     ; repPragRule n' bndrs' lhs' rhs' act' }
+       ; rule2 <- wrapGenSyms ss rule1
+       ; return (loc, rule2) }
+
+ruleBndrNames :: RuleBndr Name -> [Name]
+ruleBndrNames (RuleBndr n)      = [unLoc n]
+ruleBndrNames (RuleBndrSig n (HsWB { hswb_kvs = kvs, hswb_tvs = tvs }))
+  = unLoc n : kvs ++ tvs
+
+repRuleBndr :: RuleBndr Name -> DsM (Core TH.RuleBndrQ)
+repRuleBndr (RuleBndr n)
+  = do { MkC n' <- lookupLBinder n
+       ; rep2 ruleVarName [n'] }
+repRuleBndr (RuleBndrSig n (HsWB { hswb_cts = ty }))
+  = do { MkC n'  <- lookupLBinder n
+       ; MkC ty' <- repLTy ty
+       ; rep2 typedRuleVarName [n', ty'] }
+
 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 }))
+                     , 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
                        , con_qvars = con_tvs, con_cxt = L _ ctxt
                        , con_details = details
                        , con_res = res_ty }))
   = do { (eq_ctxt, con_tv_subst) <- mkGadtCtxt tvs res_ty
-       ; let ex_tvs = mkHsQTvs [ tv | tv <- hsQTvBndrs con_tvs, not (hsLTyVarName tv `in_subst` con_tv_subst)]
-       ; binds <- mapM dupBinder con_tv_subst 
+       ; 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
        ; 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'] } }
 
-in_subst :: Name -> [(Name,Name)] -> Bool
-in_subst _ []          = False
-in_subst n ((n',_):ns) = n==n' || in_subst n ns
+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)])
--- Given a data type in GADT syntax, figure out the equality 
--- context, so that we can represent it with an explicit 
+           -> 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
 -- the GADT in TH syntax
 --
--- Example:   
+-- Example:
 -- data T a b c where { MkT :: forall d e. d -> e -> T d [e] e
 --     mkGadtCtxt [a,b,c] [d,e] (T d [e] e)
---   returns 
---     (b~[e], c~e), [d->a] 
--- 
+--   returns
+--     (b~[e], c~e), [d->a]
+--
 -- This function is fiddly, but not really hard
 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))
 
-  | otherwise 
+  | otherwise
   = failWithDs (ptext (sLit "Malformed constructor result type:") <+> ppr res_ty)
   where
     go cxt subst [] = (cxt, subst)
     go cxt subst ((data_tv, ty) : rest)
        | Just con_tv <- is_hs_tyvar ty
        , isTyVarName con_tv
-       , not (in_subst con_tv subst)
+       , not (in_subst subst con_tv)
        = go cxt ((con_tv, data_tv) : subst) rest
        | otherwise
        = go (eq_pred : cxt) subst rest
@@ -484,30 +568,29 @@ mkGadtCtxt data_tvs (ResTyGADT res_ty)
     is_hs_tyvar (L _ (HsParTy ty)) = is_hs_tyvar ty
     is_hs_tyvar _                  = Nothing
 
-    
+
 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
-repBangTy ty= do 
+repBangTy ty= do
   MkC s <- rep2 str []
   MkC t <- repLTy ty'
   rep2 strictTypeName [s, t]
-  where 
+  where
     (str, ty') = case ty of
-                  L _ (HsBangTy HsUnpack ty) -> (unpackedName,  ty)
-                  L _ (HsBangTy _ 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])
 repDerivs Nothing = coreList nameTyConName []
 repDerivs (Just ctxt)
-  = do { strs <- mapM rep_deriv ctxt ; 
-        coreList nameTyConName strs }
+  = 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
@@ -524,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)
@@ -538,11 +621,12 @@ rep_sig (L _   (GenericSig nm _))     = failWithDs msg
 
 rep_sig (L loc (InlineSig nm ispec))  = rep_inline nm ispec loc
 rep_sig (L loc (SpecSig nm ty ispec)) = rep_specialise nm ty ispec loc
+rep_sig (L loc (SpecInstSig ty))      = rep_specialiseInst ty loc
 rep_sig _                             = return []
 
 rep_ty_sig :: SrcSpan -> LHsType Name -> Located Name
            -> DsM (SrcSpan, Core TH.DecQ)
-rep_ty_sig loc (L _ ty) nm 
+rep_ty_sig loc (L _ ty) nm
   = do { nm1 <- lookupLOcc nm
        ; ty1 <- rep_ty ty
        ; sig <- repProto nm1 ty1
@@ -553,84 +637,85 @@ rep_ty_sig loc (L _ ty) nm
     rep_ty (HsForAllTy Explicit tvs ctxt ty)
       = do { let rep_in_scope_tv tv = do { name <- lookupBinder (hsLTyVarName tv)
                                          ; repTyVarBndrWithKind tv name }
-           ; bndrs1 <- mapM rep_in_scope_tv (hsQTvBndrs tvs)
-           ; bndrs2 <- coreList tyVarBndrTyConName bndrs1
+           ; bndrs1 <- repList tyVarBndrTyConName rep_in_scope_tv (hsQTvBndrs tvs)
            ; ctxt1  <- repLContext ctxt
            ; ty1    <- repLTy ty
-           ; repTForall bndrs2 ctxt1 ty1 }
+           ; repTForall bndrs1 ctxt1 ty1 }
 
-    rep_ty ty = repTy ty  
+    rep_ty ty = repTy ty
 
 
-rep_inline :: Located Name 
-           -> InlinePragma     -- Never defaultInlinePragma
-           -> SrcSpan 
+rep_inline :: Located Name
+           -> InlinePragma      -- Never defaultInlinePragma
+           -> SrcSpan
            -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_inline nm ispec loc
-  = do { nm1 <- lookupLOcc nm
-       ; ispec1 <- rep_InlinePrag ispec
-       ; pragma <- repPragInl nm1 ispec1
+  = do { nm1    <- lookupLOcc nm
+       ; inline <- repInline $ inl_inline ispec
+       ; rm     <- repRuleMatch $ inl_rule ispec
+       ; phases <- repPhases $ inl_act ispec
+       ; pragma <- repPragInl nm1 inline rm phases
        ; return [(loc, pragma)]
        }
 
-rep_specialise :: Located Name -> LHsType Name -> InlinePragma -> SrcSpan 
+rep_specialise :: Located Name -> LHsType Name -> InlinePragma -> SrcSpan
                -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_specialise nm ty ispec loc
   = do { nm1 <- lookupLOcc nm
        ; ty1 <- repLTy ty
-       ; pragma <- if isDefaultInlinePragma ispec
-                   then repPragSpec nm1 ty1                  -- SPECIALISE
-                   else do { ispec1 <- rep_InlinePrag ispec  -- SPECIALISE INLINE
-                           ; repPragSpecInl nm1 ty1 ispec1 } 
+       ; phases <- repPhases $ inl_act ispec
+       ; let inline = inl_inline ispec
+       ; pragma <- if isEmptyInlineSpec inline
+                   then -- SPECIALISE
+                     repPragSpec nm1 ty1 phases
+                   else -- SPECIALISE INLINE
+                     do { inline1 <- repInline inline
+                        ; repPragSpecInl nm1 ty1 inline1 phases }
        ; return [(loc, pragma)]
        }
 
--- Extract all the information needed to build a TH.InlinePrag
---
-rep_InlinePrag :: InlinePragma -- Never defaultInlinePragma
-               -> DsM (Core TH.InlineSpecQ)
-rep_InlinePrag (InlinePragma { inl_act = activation, inl_rule = match, inl_inline = inline })
-  | Just (flag, phase) <- activation1 
-  = repInlineSpecPhase inline1 match1 flag phase
-  | otherwise
-  = repInlineSpecNoPhase inline1 match1
-  where
-      match1      = coreBool (rep_RuleMatchInfo match)
-      activation1 = rep_Activation activation
-      inline1     = case inline of 
-                       Inline -> coreBool True
-                      _other -> coreBool False
-                      -- We have no representation for Inlinable
-
-      rep_RuleMatchInfo FunLike = False
-      rep_RuleMatchInfo ConLike = True
-
-      rep_Activation NeverActive          = Nothing    -- We never have NOINLINE/AlwaysActive
-      rep_Activation AlwaysActive         = Nothing    -- or            INLINE/NeverActive
-      rep_Activation (ActiveBefore phase) = Just (coreBool False, 
-                                                  MkC $ mkIntExprInt phase)
-      rep_Activation (ActiveAfter phase)  = Just (coreBool True, 
-                                                  MkC $ mkIntExprInt phase)
-
+rep_specialiseInst :: LHsType Name -> SrcSpan -> DsM [(SrcSpan, Core TH.DecQ)]
+rep_specialiseInst ty loc
+  = do { ty1    <- repLTy ty
+       ; pragma <- repPragSpecInst ty1
+       ; return [(loc, pragma)] }
+
+repInline :: InlineSpec -> DsM (Core TH.Inline)
+repInline NoInline  = dataCon noInlineDataConName
+repInline Inline    = dataCon inlineDataConName
+repInline Inlinable = dataCon inlinableDataConName
+repInline spec      = notHandled "repInline" (ppr spec)
+
+repRuleMatch :: RuleMatchInfo -> DsM (Core TH.RuleMatch)
+repRuleMatch ConLike = dataCon conLikeDataConName
+repRuleMatch FunLike = dataCon funLikeDataConName
+
+repPhases :: Activation -> DsM (Core TH.Phases)
+repPhases (ActiveBefore i) = do { MkC arg <- coreIntLit i
+                                ; dataCon' beforePhaseDataConName [arg] }
+repPhases (ActiveAfter i)  = do { MkC arg <- coreIntLit i
+                                ; dataCon' fromPhaseDataConName [arg] }
+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 (hsLTyVarNames tvs)
-       ; term <- addBinds freshNames $ 
-                do { kbs1 <- mapM mk_tv_bndr (hsQTvBndrs tvs `zip` freshNames)
-                    ; kbs2 <- coreList tyVarBndrTyConName kbs1
-                   ; m kbs2 }
-       ; 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)
 
@@ -644,30 +729,29 @@ addTyClTyVarBinds :: LHsTyVarBndrs Name
 --      type W (T a) = blah
 -- The 'a' in the type instance is the one bound by the instance decl
 addTyClTyVarBinds tvs m
-  = do { let tv_names = hsLTyVarNames tvs
+  = 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 { kbs1 <- mapM mk_tv_bndr (hsQTvBndrs tvs)
-                    ; kbs2 <- coreList tyVarBndrTyConName kbs1
-                   ; m kbs2 }
+       ; term <- addBinds freshNames $
+                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs)
+                    ; m kbs }
 
        ; wrapGenSyms freshNames term }
   where
-    mk_tv_bndr tv = do { v <- lookupOcc (hsLTyVarName tv)
+    mk_tv_bndr tv = do { v <- lookupBinder (hsLTyVarName tv)
                        ; repTyVarBndrWithKind tv v }
 
 -- 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
-  = repKind ki >>= repKindedTV nm
+  = repLKind ki >>= repKindedTV nm
 
 -- represent a type context
 --
@@ -675,31 +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    <- mapM repLPred ctxt
-                   predList <- coreList predQTyConName preds
-                   repCtxt predList
-
--- 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 <- repLTys tys
-      tys2 <- coreList typeQTyConName tys1
-      repClassP cls1 tys2
-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
 --
@@ -712,156 +773,219 @@ repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
 repLTy (L _ ty) = repTy ty
 
 repTy :: HsType Name -> DsM (Core TH.TypeQ)
-repTy (HsForAllTy _ tvs ctxt ty)  = 
+repTy (HsForAllTy _ tvs ctxt ty)  =
   addTyVarBinds tvs $ \bndrs -> do
     ctxt1  <- repLContext ctxt
     ty1    <- repLTy ty
     repTForall bndrs ctxt1 ty1
 
 repTy (HsTyVar n)
-  | isTvOcc (nameOccName n) = do 
-                               tv1 <- lookupOcc n
-                               repTvar tv1
-  | otherwise              = do 
-                               tc1 <- lookupOcc n
-                               repNamedTyCon tc1
-repTy (HsAppTy f a)         = do 
-                               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
+  | isTvOcc occ   = do tv1 <- lookupOcc n
+                       repTvar tv1
+  | isDataOcc occ = do tc1 <- lookupOcc n
+                       repPromotedTyCon 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
+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
 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
-repTy (HsTupleTy _ tys)     = do tys1 <- repLTys tys 
+                                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 <- repKind k
+                                k1 <- repLKind k
                                 repTSig t1 k1
-repTy (HsSpliceTy splice _ _) = repSplice splice
-repTy ty                     = notHandled "Exotic form of type" (ppr ty)
+repTy (HsSpliceTy splice _)     = repSplice splice
+repTy (HsExplicitListTy _ tys)  = do
+                                    tys1 <- repLTys tys
+                                    repTPromotedList tys1
+repTy (HsExplicitTupleTy _ tys) = do
+                                    tys1 <- repLTys tys
+                                    tcon <- repPromotedTupleTyCon (length tys)
+                                    repTapps tcon tys1
+repTy (HsTyLit lit) = do
+                        lit' <- repTyLit lit
+                        repTLit lit'
+                          
+repTy ty                      = notHandled "Exotic form of type" (ppr ty)
+
+repTyLit :: HsTyLit -> DsM (Core TH.TyLitQ)
+repTyLit (HsNumTy i) = do iExpr <- mkIntegerExpr i
+                          rep2 numTyLitName [iExpr]
+repTyLit (HsStrTy s) = do { s' <- mkStringExprFS s
+                         ; rep2 strTyLitName [s']
+                         }
 
 -- represent a kind
 --
-repKind :: LHsKind Name -> DsM (Core TH.Kind)
-repKind ki
+repLKind :: LHsKind Name -> DsM (Core TH.Kind)
+repLKind ki
   = do { let (kis, ki') = splitHsFunType ki
-       ; kis_rep <- mapM repKind kis
-       ; ki'_rep <- repNonArrowKind ki'
-       ; foldrM repArrowK ki'_rep kis_rep
+       ; kis_rep <- mapM repLKind kis
+       ; ki'_rep <- repNonArrowLKind ki'
+       ; kcon <- repKArrow
+       ; let f k1 k2 = repKApp kcon k1 >>= flip repKApp k2
+       ; foldrM f ki'_rep kis_rep
        }
-  where
-    repNonArrowKind (L _ (HsTyVar name)) | name == liftedTypeKindTyConName = repStarK
-    repNonArrowKind k = notHandled "Exotic form of kind" (ppr k)
+
+repNonArrowLKind :: LHsKind Name -> DsM (Core TH.Kind)
+repNonArrowLKind (L _ ki) = repNonArrowKind ki
+
+repNonArrowKind :: HsKind Name -> DsM (Core TH.Kind)
+repNonArrowKind (HsTyVar name)
+  | name == liftedTypeKindTyConName = repKStar
+  | name == constraintKindTyConName = repKConstraint
+  | isTvOcc (nameOccName name)      = lookupOcc name >>= repKVar
+  | otherwise                       = lookupOcc name >>= repKCon
+repNonArrowKind (HsAppTy f a)       = do  { f' <- repLKind f
+                                          ; a' <- repLKind a
+                                          ; repKApp f' a'
+                                          }
+repNonArrowKind (HsListTy k)        = do  { k' <- repLKind k
+                                          ; kcon <- repKList
+                                          ; repKApp kcon k'
+                                          }
+repNonArrowKind (HsTupleTy _ ks)    = do  { ks' <- mapM repLKind ks
+                                          ; kcon <- repKTuple (length ks)
+                                          ; repKApps kcon 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)
 -- See Note [How brackets and nested splices are handled] in TcSplice
 -- We return a CoreExpr of any old type; the context should know
-repSplice (HsSplice n _) 
+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 = do { es'  <- mapM repLE es ;
-                coreList expQTyConName es' }
+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)
 
 repE :: HsExpr Name -> DsM (Core TH.ExpQ)
 repE (HsVar x)            =
-  do { mb_val <- dsLookupMetaEnv 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 (MatchGroup [m] _)) = repLambda m
+repE (HsLam (MG { mg_alts = [m] })) = repLambda m
+repE (HsLamCase _ (MG { mg_alts = ms }))
+                   = do { ms' <- mapM repMatchTup 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) =
-  do { arg1 <- repLE e1; 
-       arg2 <- repLE e2; 
+  do { arg1 <- repLE e1;
+       arg2 <- repLE e2;
        the_op <- repLE op ;
-       repInfixApp arg1 the_op arg2 } 
+       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 (MatchGroup ms _)) = do { arg <- repLE e
-                                      ; ms2 <- mapM repMatchTup ms
-                                      ; repCaseE arg (nonEmptyCoreList ms2) }
+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
+                               ; 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 _) 
- | case ctxt of { DoExpr -> True; GhciStmt -> True; _ -> False }
- = do { (ss,zs) <- repLSts sts; 
+repE e@(HsDo ctxt sts _)
+ | case ctxt of { DoExpr -> True; GhciStmtCtxt -> True; _ -> False }
+ = do { (ss,zs) <- repLSts sts;
         e'      <- repDoE (nonEmptyCoreList zs);
         wrapGenSyms ss e' }
 
  | ListComp <- ctxt
- = do { (ss,zs) <- repLSts sts; 
+ = do { (ss,zs) <- repLSts sts;
         e'      <- repComp (nonEmptyCoreList zs);
         wrapGenSyms ss e' }
 
   | 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) 
+repE e@(ExplicitTuple es boxed)
   | not (all tupArgPresent es) = notHandled "Tuple sections" (ppr e)
   | isBoxed boxed              = do { xs <- repLEs [e | Present e <- es]; repTup xs }
   | otherwise                  = do { xs <- repLEs [e | Present e <- es]; repUnboxedTup xs }
@@ -876,37 +1000,37 @@ 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
-    FromTo   e1 e2      -> do 
-                            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)
+    FromThen e1 e2      -> do
+                             ds1 <- repLE e1
+                             ds2 <- repLE e2
+                             repFromThen ds1 ds2
+    FromTo   e1 e2      -> do
+                             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@(HsTcBracketOut {}) = notHandled "TH brackets" (ppr e)
+repE e                     = notHandled "Expression form" (ppr e)
 
 -----------------------------------------------------------------------------
--- Building representations of auxillary structures like Match, Clause, Stmt, 
+-- Building representations of auxillary structures like Match, Clause, Stmt,
 
-repMatchTup ::  LMatch Name -> DsM (Core TH.MatchQ) 
+repMatchTup ::  LMatch Name (LHsExpr Name) -> DsM (Core TH.MatchQ)
 repMatchTup (L _ (Match [p] _ (GRHSs guards wheres))) =
-  do { ss1 <- mkGenSyms (collectPatBinders p) 
+  do { ss1 <- mkGenSyms (collectPatBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p
      ; (ss2,ds) <- repBinds wheres
@@ -916,9 +1040,9 @@ repMatchTup (L _ (Match [p] _ (GRHSs guards wheres))) =
      ; wrapGenSyms (ss1++ss2) match }}}
 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
 
-repClauseTup ::  LMatch Name -> DsM (Core TH.ClauseQ)
+repClauseTup ::  LMatch Name (LHsExpr Name) -> DsM (Core TH.ClauseQ)
 repClauseTup (L _ (Match ps _ (GRHSs guards wheres))) =
-  do { ss1 <- mkGenSyms (collectPatsBinders ps) 
+  do { ss1 <- mkGenSyms (collectPatsBinders ps)
      ; addBinds ss1 $ do {
        ps1 <- repLPs ps
      ; (ss2,ds) <- repBinds wheres
@@ -927,31 +1051,32 @@ repClauseTup (L _ (Match ps _ (GRHSs guards wheres))) =
      ; clause <- repClause ps1 gs ds
      ; wrapGenSyms (ss1++ss2) clause }}}
 
-repGuards ::  [LGRHS Name] ->  DsM (Core TH.BodyQ)
+repGuards ::  [LGRHS Name (LHsExpr Name)] ->  DsM (Core TH.BodyQ)
 repGuards [L _ (GRHS [] e)]
   = do {a <- repLE e; repNormal a }
-repGuards other 
-  = do { zs <- mapM process other;
-     let {(xs, ys) = unzip zs};
-        gd <- repGuarded (nonEmptyCoreList ys);
-     wrapGenSyms (concat xs) gd }
-  where 
-    process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
-    process (L _ (GRHS [L _ (ExprStmt e1 _ _ _)] e2))
-           = do { x <- repLNormalGE e1 e2;
-                  return ([], x) }
-    process (L _ (GRHS ss rhs))
-           = do (gs, ss') <- repLSts ss
-               rhs' <- addBinds gs $ repLE rhs
-                g <- repPatGE (nonEmptyCoreList ss') rhs'
-                return (gs, g)
+repGuards other
+  = do { zs <- mapM repLGRHS other
+       ; let (xs, ys) = unzip zs
+       ; gd <- repGuarded (nonEmptyCoreList ys)
+       ; wrapGenSyms (concat xs) gd }
+
+repLGRHS :: LGRHS Name (LHsExpr Name) -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
+repLGRHS (L _ (GRHS [L _ (BodyStmt e1 _ _ _)] e2))
+  = do { guarded <- repLNormalGE e1 e2
+       ; return ([], guarded) }
+repLGRHS (L _ (GRHS ss rhs))
+  = do { (gs, ss') <- repLSts ss
+       ; rhs' <- addBinds gs $ repLE rhs
+       ; guarded <- repPatGE (nonEmptyCoreList ss') rhs'
+       ; return (gs, guarded) }
 
 repFields :: HsRecordBinds Name -> DsM (Core [TH.Q TH.FieldExp])
 repFields (HsRecFields { rec_flds = flds })
-  = do { fnames <- mapM lookupLOcc (map hsRecFieldId flds)
-       ; es <- mapM repLE (map hsRecFieldArg flds)
-       ; fs <- zipWithM repFieldExp fnames es
-       ; coreList fieldExpQTyConName fs }
+  = repList fieldExpQTyConName rep_fld flds
+  where
+    rep_fld fld = do { fn <- lookupLOcc (hsRecFieldId fld)
+                     ; e  <- repLE (hsRecFieldArg fld)
+                     ; repFieldExp fn e }
 
 
 -----------------------------------------------------------------------------
@@ -963,31 +1088,31 @@ repFields (HsRecFields { rec_flds = flds })
 -- and we could reuse the original names (x and x).
 --
 -- do { x'1 <- gensym "x"
---    ; x'2 <- gensym "x"   
+--    ; x'2 <- gensym "x"
 --    ; doE [ BindSt (pvar x'1) [| f 1 |]
---          , BindSt (pvar x'2) [| f x |] 
---          , NoBindSt [| g x |] 
+--          , BindSt (pvar x'2) [| f x |]
+--          , NoBindSt [| g x |]
 --          ]
 --    }
 
 -- The strategy is to translate a whole list of do-bindings by building a
--- bigger environment, and a bigger set of meta bindings 
+-- bigger environment, and a bigger set of meta bindings
 -- (like:  x'1 <- gensym "x" ) and then combining these with the translations
 -- of the expressions within the Do
-      
+
 -----------------------------------------------------------------------------
 -- The helper function repSts computes the translation of each sub expression
 -- and a bunch of prefix bindings denoting the dynamic renaming.
 
-repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
+repLSts :: [LStmt Name (LHsExpr Name)] -> DsM ([GenSymBind], [Core TH.StmtQ])
 repLSts stmts = repSts (map unLoc stmts)
 
-repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
+repSts :: [Stmt Name (LHsExpr Name)] -> DsM ([GenSymBind], [Core TH.StmtQ])
 repSts (BindStmt p e _ _ : ss) =
-   do { e2 <- repLE e 
-      ; ss1 <- mkGenSyms (collectPatBinders p) 
+   do { e2 <- repLE e
+      ; ss1 <- mkGenSyms (collectPatBinders p)
       ; addBinds ss1 $ do {
-      ; p1 <- repLP p; 
+      ; p1 <- repLP p;
       ; (ss2,zs) <- repSts ss
       ; z <- repBindSt p1 e2
       ; return (ss1++ss2, z : zs) }}
@@ -995,13 +1120,26 @@ repSts (LetStmt bs : ss) =
    do { (ss1,ds) <- repBinds bs
       ; z <- repLetSt ds
       ; (ss2,zs) <- addBinds ss1 (repSts ss)
-      ; return (ss1++ss2, z : zs) } 
-repSts (ExprStmt e _ _ _ : ss) =       
+      ; return (ss1++ss2, z : zs) }
+repSts (BodyStmt e _ _ _ : ss) =
    do { e2 <- repLE e
-      ; z <- repNoBindSt e2 
+      ; z <- repNoBindSt e2
       ; (ss2,zs) <- repSts ss
       ; return (ss2, z : zs) }
-repSts [LastStmt e _] 
+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
        ; return ([], [z]) }
@@ -1010,145 +1148,145 @@ repSts other = notHandled "Exotic statement" (ppr other)
 
 
 -----------------------------------------------------------
---                     Bindings
+--                      Bindings
 -----------------------------------------------------------
 
-repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ]) 
+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
 
--- Note GHC treats declarations of a variable (not a pattern) 
--- e.g.  x = g 5 as a Fun MonoBinds. This is indicated by a single match 
+-- Note GHC treats declarations of a variable (not a pattern)
+-- 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 = MatchGroup [L _ (Match [] _ (GRHSs guards wheres))] _ }))
+rep_bind (L loc (FunBind { fun_id = fn,
+                           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') }
-
-rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MatchGroup ms _ }))
+        ; 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 
+ =   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
+ =   do { v' <- lookupBinder v
+        ; 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: 
+-- all the variables simultaneously. For example:
 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
 -- do { f'1 <- gensym "f"
 --    ; g'2 <- gensym "g"
 --    ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
 --        do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
 --      ]}
--- This requires collecting the bindings (f'1 <- gensym "f"), and the 
--- environment ( f |-> f'1 ) from each binding, and then unioning them 
--- together. As we do this we collect GenSymBinds's which represent the renamed 
--- variables bound by the Bindings. In order not to lose track of these 
--- representations we build a shadow datatype MB with the same structure as 
+-- This requires collecting the bindings (f'1 <- gensym "f"), and the
+-- environment ( f |-> f'1 ) from each binding, and then unioning them
+-- together. As we do this we collect GenSymBinds's which represent the renamed
+-- variables bound by the Bindings. In order not to lose track of these
+-- representations we build a shadow datatype MB with the same structure as
 -- MonoBinds, but which has slots for the representations
 
 
 -----------------------------------------------------------------------------
 -- GHC allows a more general form of lambda abstraction than specified
--- by Haskell 98. In particular it allows guarded lambda's like : 
+-- by Haskell 98. In particular it allows guarded lambda's like :
 -- (\  x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
--- (\ p1 .. pn -> exp) by causing an error.  
+-- (\ p1 .. pn -> exp) by causing an error.
 
-repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
+repLambda :: LMatch Name (LHsExpr Name) -> DsM (Core TH.ExpQ)
 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 
+-- walked over the pattern(s) once to collect the binders, and
+-- have extended the environment.  So every pattern-bound
 -- variable should already appear in the environment.
 
 -- Process a list of patterns
 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
-repLPs ps = do { ps' <- mapM repLP ps ;
-                coreList patQTyConName ps' }
+repLPs ps = repList patQTyConName repLP ps
 
 repLP :: LPat Name -> DsM (Core TH.PatQ)
 repLP (L _ p) = repP p
 
 repP :: Pat Name -> DsM (Core TH.PatQ)
-repP (WildPat _)       = repPwild 
+repP (WildPat _)       = repPwild
 repP (LitPat l)        = do { l2 <- repLiteral l; repPlit l2 }
 repP (VarPat x)        = do { x' <- lookupBinder x; repPvar x' }
 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 (ParPat p)        = repLP p
+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 }
@@ -1156,26 +1294,29 @@ repP (ConPatIn dc details)
  = do { con_str <- lookupLOcc dc
       ; case details of
          PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
-         RecCon rec   -> do { let flds = rec_flds rec
-                           ; vs <- sequence $ map lookupLOcc (map hsRecFieldId flds)
-                            ; ps <- sequence $ map repLP (map hsRecFieldArg flds)
-                            ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
-                            ; fps' <- coreList fieldPatQTyConName fps
-                            ; repPrec con_str fps' }
+         RecCon rec   -> do { fps <- repList fieldPatQTyConName rep_fld (rec_flds rec)
+                            ; repPrec con_str fps }
          InfixCon p1 p2 -> do { p1' <- repLP p1;
                                 p2' <- repLP p2;
                                 repPinfix p1' con_str p2' }
    }
+ where
+   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)
 
@@ -1190,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
 --
@@ -1211,17 +1352,17 @@ 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
--- Add a list of fresh names for locally bound entities to the 
--- meta environment (which is part of the state carried around 
--- by the desugarer monad) 
+-- Add a list of fresh names for locally bound entities to the
+-- meta environment (which is part of the state carried around
+-- by the desugarer monad)
 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
 
 dupBinder :: (Name, Name) -> DsM (Name, DsMetaVal)
-dupBinder (new, old) 
+dupBinder (new, old)
   = do { mb_val <- dsLookupMetaEnv old
        ; case mb_val of
            Just val -> return (new, val)
@@ -1236,7 +1377,7 @@ lookupBinder :: Name -> DsM (Core TH.Name)
 lookupBinder = lookupOcc
   -- Binders are brought into scope before the pattern or what-not is
   -- desugared.  Moreover, in instance declaration the binder of a method
-  -- will be the selector Id and hence a global; so we need the 
+  -- will be the selector Id and hence a global; so we need the
   -- globalVar case of lookupOcc
 
 -- Look up a name that is either locally bound or a global name
@@ -1253,77 +1394,77 @@ 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))
--- wrapGenSyms [(nm1,id1), (nm2,id2)] y 
---     --> bindQ (gensym nm1) (\ id1 -> 
---         bindQ (gensym nm2 (\ id2 -> 
---         y))
+wrapGenSyms :: [GenSymBind]
+            -> Core (TH.Q a) -> DsM (Core (TH.Q a))
+-- wrapGenSyms [(nm1,id1), (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
+    [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
 
     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
+-- %*                                                                   *
 -- %*********************************************************************
 
 -----------------------------------------------------------------------------
--- PHANTOM TYPES for consistency. In order to make sure we do this correct 
+-- PHANTOM TYPES for consistency. In order to make sure we do this correct
 -- we invent a new datatype which uses phantom types.
 
 newtype Core a = MkC CoreExpr
@@ -1334,18 +1475,25 @@ rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
 rep2 n xs = do { id <- dsLookupGlobalId n
                ; return (MkC (foldl App (Var id) xs)) }
 
+dataCon' :: Name -> [CoreExpr] -> DsM (Core a)
+dataCon' n args = do { id <- dsLookupDataCon n
+                     ; return $ MkC $ mkConApp id args }
+
+dataCon :: Name -> DsM (Core a)
+dataCon n = dataCon' n []
+
 -- Then we make "repConstructors" which use the phantom types for each of the
 -- smart constructors of the Meta.Meta datatypes.
 
 
 -- %*********************************************************************
--- %*                                                                  *
---             The 'smart constructors'
--- %*                                                                  *
+-- %*                                                                   *
+--              The 'smart constructors'
+-- %*                                                                   *
 -- %*********************************************************************
 
 --------------- Patterns -----------------
-repPlit   :: Core TH.Lit -> DsM (Core TH.PatQ) 
+repPlit   :: Core TH.Lit -> DsM (Core TH.PatQ)
 repPlit (MkC l) = rep2 litPName [l]
 
 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
@@ -1387,23 +1535,26 @@ 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] 
+repVar (MkC s) = rep2 varEName [s]
 
 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
-repCon (MkC s) = rep2 conEName [s] 
+repCon (MkC s) = rep2 conEName [s]
 
 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
-repLit (MkC c) = rep2 litEName [c] 
+repLit (MkC c) = rep2 litEName [c]
 
 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repApp (MkC x) (MkC y) = rep2 appEName [x,y] 
+repApp (MkC x) (MkC y) = rep2 appEName [x,y]
 
 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
 
+repLamCase :: Core [TH.MatchQ] -> DsM (Core TH.ExpQ)
+repLamCase (MkC ms) = rep2 lamCaseEName [ms]
+
 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
 repTup (MkC es) = rep2 tupEName [es]
 
@@ -1411,10 +1562,13 @@ repUnboxedTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
 repUnboxedTup (MkC es) = rep2 unboxedTupEName [es]
 
 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z] 
+repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
+
+repMultiIf :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.ExpQ)
+repMultiIf (MkC alts) = rep2 multiIfEName [alts]
 
 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e] 
+repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
 
 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
@@ -1478,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]
@@ -1502,10 +1659,10 @@ repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
 
-repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)  
+repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
 
-repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr] 
+repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
         -> Maybe (Core [TH.TypeQ])
         -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
 repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs)
@@ -1513,7 +1670,7 @@ repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs)
 repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC cons) (MkC derivs)
   = rep2 dataInstDName [cxt, nm, tys, cons, derivs]
 
-repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr] 
+repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
            -> Maybe (Core [TH.TypeQ])
            -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
 repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs)
@@ -1521,53 +1678,79 @@ repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs)
 repNewtype (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC con) (MkC derivs)
   = rep2 newtypeInstDName [cxt, nm, tys, con, derivs]
 
-repTySyn :: Core TH.Name -> Core [TH.TyVarBndr] 
-         -> Maybe (Core [TH.TypeQ])
+repTySyn :: Core TH.Name -> Core [TH.TyVarBndr]
          -> Core TH.TypeQ -> DsM (Core TH.DecQ)
-repTySyn (MkC nm) (MkC tvs) Nothing (MkC rhs) 
+repTySyn (MkC nm) (MkC tvs) (MkC rhs)
   = rep2 tySynDName [nm, tvs, rhs]
-repTySyn (MkC nm) (MkC _) (Just (MkC tys)) (MkC rhs) 
-  = rep2 tySynInstDName [nm, tys, rhs]
 
 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
 
-repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr] 
-         -> Core [TH.FunDep] -> Core [TH.DecQ] 
+repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
+         -> Core [TH.FunDep] -> Core [TH.DecQ]
          -> DsM (Core TH.DecQ)
-repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) 
+repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)
   = rep2 classDName [cxt, cls, tvs, fds, ds]
 
-repPragInl :: Core TH.Name -> Core TH.InlineSpecQ -> DsM (Core TH.DecQ)
-repPragInl (MkC nm) (MkC ispec) = rep2 pragInlDName [nm, ispec]
+repPragInl :: Core TH.Name -> Core TH.Inline -> Core TH.RuleMatch
+           -> Core TH.Phases -> DsM (Core TH.DecQ)
+repPragInl (MkC nm) (MkC inline) (MkC rm) (MkC phases)
+  = rep2 pragInlDName [nm, inline, rm, phases]
 
-repPragSpec :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
-repPragSpec (MkC nm) (MkC ty) = rep2 pragSpecDName [nm, ty]
+repPragSpec :: Core TH.Name -> Core TH.TypeQ -> Core TH.Phases
+            -> DsM (Core TH.DecQ)
+repPragSpec (MkC nm) (MkC ty) (MkC phases)
+  = rep2 pragSpecDName [nm, ty, phases]
 
-repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.InlineSpecQ 
-               -> DsM (Core TH.DecQ)
-repPragSpecInl (MkC nm) (MkC ty) (MkC ispec) 
-  = rep2 pragSpecInlDName [nm, ty, ispec]
+repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.Inline
+               -> Core TH.Phases -> DsM (Core TH.DecQ)
+repPragSpecInl (MkC nm) (MkC ty) (MkC inline) (MkC phases)
+  = rep2 pragSpecInlDName [nm, ty, inline, phases]
 
-repFamilyNoKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr] 
+repPragSpecInst :: Core TH.TypeQ -> DsM (Core TH.DecQ)
+repPragSpecInst (MkC ty) = rep2 pragSpecInstDName [ty]
+
+repPragRule :: Core String -> Core [TH.RuleBndrQ] -> Core TH.ExpQ
+            -> Core TH.ExpQ -> Core TH.Phases -> DsM (Core TH.DecQ)
+repPragRule (MkC nm) (MkC bndrs) (MkC lhs) (MkC rhs) (MkC phases)
+  = rep2 pragRuleDName [nm, bndrs, lhs, rhs, phases]
+
+repFamilyNoKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
                 -> DsM (Core TH.DecQ)
 repFamilyNoKind (MkC flav) (MkC nm) (MkC tvs)
     = rep2 familyNoKindDName [flav, nm, tvs]
 
-repFamilyKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr] 
+repFamilyKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
               -> Core TH.Kind
               -> DsM (Core TH.DecQ)
 repFamilyKind (MkC flav) (MkC nm) (MkC tvs) (MkC ki)
     = rep2 familyKindDName [flav, nm, tvs, ki]
 
-repInlineSpecNoPhase :: Core Bool -> Core Bool -> DsM (Core TH.InlineSpecQ)
-repInlineSpecNoPhase (MkC inline) (MkC conlike) 
-  = rep2 inlineSpecNoPhaseName [inline, conlike]
+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]
 
-repInlineSpecPhase :: Core Bool -> Core Bool -> Core Bool -> Core Int
-                   -> DsM (Core TH.InlineSpecQ)
-repInlineSpecPhase (MkC inline) (MkC conlike) (MkC beforeFrom) (MkC phase)
-  = rep2 inlineSpecPhaseName [inline, conlike, beforeFrom, phase]
+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]
@@ -1578,25 +1761,19 @@ 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)
-    = do arg_tys  <- mapM repBangTy ps
-         arg_tys1 <- coreList strictTypeQTyConName arg_tys
-         rep2 normalCName [unC con, unC arg_tys1]
+    = do arg_tys  <- repList strictTypeQTyConName repBangTy ps
+         rep2 normalCName [unC con, unC arg_tys]
 repConstr con (RecCon ips)
-    = do arg_vs   <- mapM lookupLOcc (map cd_fld_name ips)
-         arg_tys  <- mapM repBangTy (map cd_fld_type ips)
-         arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
-                              arg_vs arg_tys
-         arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
-         rep2 recCName [unC con, unC arg_vtys']
+    = do { arg_vtys <- repList varStrictTypeQTyConName rep_ip ips
+         ; rep2 recCName [unC con, unC arg_vtys] }
+    where
+      rep_ip ip = do { MkC v  <- lookupLOcc (cd_fld_name ip)
+                     ; MkC ty <- repBangTy  (cd_fld_type ip)
+                     ; rep2 varStrictTypeName [v,ty] }
+
 repConstr con (InfixCon st1 st2)
     = do arg1 <- repBangTy st1
          arg2 <- repBangTy st2
@@ -1604,7 +1781,7 @@ repConstr con (InfixCon st1 st2)
 
 ------------ Types -------------------
 
-repTForall :: Core [TH.TyVarBndr] -> Core TH.CxtQ -> Core TH.TypeQ 
+repTForall :: Core [TH.TyVarBndr] -> Core TH.CxtQ -> Core TH.TypeQ
            -> DsM (Core TH.TypeQ)
 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
     = rep2 forallTName [tvars, ctxt, ty]
@@ -1622,6 +1799,20 @@ 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
+                              ; f <- repTapp tcon t
+                              ; t' <- repTPromotedList ts
+                              ; repTapp f t'
+                              }
+
+repTLit :: Core TH.TyLitQ -> DsM (Core TH.TypeQ)
+repTLit (MkC lit) = rep2 litTName [lit]
+
 --------- Type constructors --------------
 
 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
@@ -1629,11 +1820,13 @@ repNamedTyCon (MkC s) = rep2 conTName [s]
 
 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
 -- Note: not Core Int; it's easier to be direct here
-repTupleTyCon i = rep2 tupleTName [mkIntExprInt i]
+repTupleTyCon i = do dflags <- getDynFlags
+                     rep2 tupleTName [mkIntExprInt dflags i]
 
 repUnboxedTupleTyCon :: Int -> DsM (Core TH.TypeQ)
 -- Note: not Core Int; it's easier to be direct here
-repUnboxedTupleTyCon i = rep2 unboxedTupleTName [mkIntExprInt i]
+repUnboxedTupleTyCon i = do dflags <- getDynFlags
+                            rep2 unboxedTupleTName [mkIntExprInt dflags i]
 
 repArrowTyCon :: DsM (Core TH.TypeQ)
 repArrowTyCon = rep2 arrowTName []
@@ -1641,6 +1834,19 @@ repArrowTyCon = rep2 arrowTName []
 repListTyCon :: DsM (Core TH.TypeQ)
 repListTyCon = rep2 listTName []
 
+repPromotedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
+repPromotedTyCon (MkC s) = rep2 promotedTName [s]
+
+repPromotedTupleTyCon :: Int -> DsM (Core TH.TypeQ)
+repPromotedTupleTyCon i = do dflags <- getDynFlags
+                             rep2 promotedTupleTName [mkIntExprInt dflags i]
+
+repPromotedNilTyCon :: DsM (Core TH.TypeQ)
+repPromotedNilTyCon = rep2 promotedNilTName []
+
+repPromotedConsTyCon :: DsM (Core TH.TypeQ)
+repPromotedConsTyCon = rep2 promotedConsTName []
+
 ------------ Kinds -------------------
 
 repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndr)
@@ -1649,17 +1855,40 @@ repPlainTV (MkC nm) = rep2 plainTVName [nm]
 repKindedTV :: Core TH.Name -> Core TH.Kind -> DsM (Core TH.TyVarBndr)
 repKindedTV (MkC nm) (MkC ki) = rep2 kindedTVName [nm, ki]
 
-repStarK :: DsM (Core TH.Kind)
-repStarK = rep2 starKName []
+repKVar :: Core TH.Name -> DsM (Core TH.Kind)
+repKVar (MkC s) = rep2 varKName [s]
+
+repKCon :: Core TH.Name -> DsM (Core TH.Kind)
+repKCon (MkC s) = rep2 conKName [s]
+
+repKTuple :: Int -> DsM (Core TH.Kind)
+repKTuple i = do dflags <- getDynFlags
+                 rep2 tupleKName [mkIntExprInt dflags i]
+
+repKArrow :: DsM (Core TH.Kind)
+repKArrow = rep2 arrowKName []
+
+repKList :: DsM (Core TH.Kind)
+repKList = rep2 listKName []
+
+repKApp :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind)
+repKApp (MkC k1) (MkC k2) = rep2 appKName [k1, k2]
 
-repArrowK :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind)
-repArrowK (MkC ki1) (MkC ki2) = rep2 arrowKName [ki1, ki2]
+repKApps :: Core TH.Kind -> [Core TH.Kind] -> DsM (Core TH.Kind)
+repKApps f []     = return f
+repKApps f (k:ks) = do { f' <- repKApp f k; repKApps f' ks }
+
+repKStar :: DsM (Core TH.Kind)
+repKStar = rep2 starKName []
+
+repKConstraint :: DsM (Core TH.Kind)
+repKConstraint = rep2 constraintKName []
 
 ----------------------------------------------------------
---             Literals
+--              Literals
 
 repLiteral :: HsLit -> DsM (Core TH.Lit)
-repLiteral lit 
+repLiteral lit
   = do lit' <- case lit of
                    HsIntPrim i    -> mk_integer i
                    HsWordPrim w   -> mk_integer w
@@ -1669,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
@@ -1696,24 +1925,24 @@ 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, becuase 
-       -- 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
 mk_lit (HsFractional f) = mk_rational f
 mk_lit (HsIsString s)   = mk_string   s
-              
+
 --------------- Miscellaneous -------------------
 
 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 ty_a ty_b (MkC x) (MkC y) 
-  = rep2 bindQName [Type ty_a, Type ty_b, x, y] 
+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]
 
 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
 repSequenceQ ty_a (MkC list)
@@ -1722,52 +1951,55 @@ repSequenceQ ty_a (MkC list)
 ------------ Lists and Tuples -------------------
 -- turn a list of patterns into a single pattern matching a list
 
-coreList :: Name       -- Of the TyCon of the element type
-        -> [Core a] -> DsM (Core [a])
-coreList tc_name es 
+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 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)
 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
 
------------- Bool, Literals & Variables -------------------
-
-coreBool :: Bool -> Core Bool
-coreBool False = MkC $ mkConApp falseDataCon []
-coreBool True  = MkC $ mkConApp trueDataCon  []
+------------ Literals & Variables -------------------
 
 coreIntLit :: Int -> DsM (Core Int)
-coreIntLit i = return (MkC (mkIntExprInt i))
+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 -----------------------
 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
+    msg = hang (text what <+> ptext (sLit "not (yet) handled by Template Haskell"))
+             2 doc
 
 
 -- %************************************************************************
--- %*                                                                  *
---             The known-key names for Template Haskell
--- %*                                                                  *
+-- %*                                                                   *
+--              The known-key names for Template Haskell
+-- %*                                                                   *
 -- %************************************************************************
 
 -- To add a name, do three things
--- 
+--
 --  1) Allocate a key
 --  2) Make a "Name"
 --  3) Add the name to knownKeyNames
@@ -1778,12 +2010,15 @@ templateHaskellNames :: [Name]
 
 templateHaskellNames = [
     returnQName, bindQName, sequenceQName, newNameName, liftName,
-    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName, 
+    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
     liftStringName,
+    unTypeName,
+    unTypeQName,
+    unsafeTExpCoerceName,
+
     -- Lit
     charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
-    floatPrimLName, doublePrimLName, rationalLName, 
+    floatPrimLName, doublePrimLName, rationalLName,
     -- Pat
     litPName, varPName, tupPName, unboxedTupPName,
     conPName, tildePName, bangPName, infixPName,
@@ -1796,9 +2031,9 @@ templateHaskellNames = [
     clauseName,
     -- Exp
     varEName, conEName, litEName, appEName, infixEName,
-    infixAppName, sectionLName, sectionRName, lamEName,
+    infixAppName, sectionLName, sectionRName, lamEName, lamCaseEName,
     tupEName, unboxedTupEName,
-    condEName, letEName, caseEName, doEName, compEName,
+    condEName, multiIfEName, letEName, caseEName, doEName, compEName,
     fromEName, fromThenEName, fromToEName, fromThenToEName,
     listEName, sigEName, recConEName, recUpdEName,
     -- FieldExp
@@ -1811,14 +2046,15 @@ templateHaskellNames = [
     bindSName, letSName, noBindSName, parSName,
     -- Dec
     funDName, valDName, dataDName, newtypeDName, tySynDName,
-    classDName, instanceDName, sigDName, forImpDName, 
-    pragInlDName, pragSpecDName, pragSpecInlDName,
+    classDName, instanceDName, sigDName, forImpDName,
+    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
@@ -1828,24 +2064,40 @@ templateHaskellNames = [
     -- VarStrictType
     varStrictTypeName,
     -- Type
-    forallTName, varTName, conTName, appTName,
-    tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName,
+    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
-    starKName, arrowKName,
+    varKName, conKName, tupleKName, arrowKName, listKName, appKName,
+    starKName, constraintKName,
     -- Callconv
     cCallName, stdCallName,
     -- Safety
     unsafeName,
     safeName,
     interruptibleName,
-    -- InlineSpec
-    inlineSpecNoPhaseName, inlineSpecPhaseName,
+    -- Inline
+    noInlineDataConName, inlineDataConName, inlinableDataConName,
+    -- RuleMatch
+    conLikeDataConName, funLikeDataConName,
+    -- Phases
+    allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName,
+    -- TExp
+    tExpDataConName,
+    -- RuleBndr
+    ruleVarName, typedRuleVarName,
     -- FunDep
     funDepName,
     -- FamFlavour
     typeFamName, dataFamName,
+    -- TySynEqn
+    tySynEqnName,
 
     -- And the tycons
     qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
@@ -1854,7 +2106,8 @@ templateHaskellNames = [
     varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
     typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
     patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
-    predQTyConName, decsQTyConName, 
+    predQTyConName, decsQTyConName, ruleBndrQTyConName, tySynEqnQTyConName,
+    roleTyConName, tExpTyConName,
 
     -- Quasiquoting
     quoteDecName, quoteTypeName, quoteExpName, quotePatName]
@@ -1867,18 +2120,19 @@ qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
 mkTHModule :: FastString -> Module
 mkTHModule m = mkModule thPackageId (mkModuleNameFS m)
 
-libFun, libTc, thFun, thTc, qqFun :: FastString -> Unique -> Name
-libFun = mk_known_key_name OccName.varName thLib
-libTc  = mk_known_key_name OccName.tcName  thLib
-thFun  = mk_known_key_name OccName.varName thSyn
-thTc   = mk_known_key_name OccName.tcName  thSyn
-qqFun  = mk_known_key_name OccName.varName qqLib
+libFun, libTc, thFun, thTc, thCon, qqFun :: FastString -> Unique -> Name
+libFun = mk_known_key_name OccName.varName  thLib
+libTc  = mk_known_key_name OccName.tcName   thLib
+thFun  = mk_known_key_name OccName.varName  thSyn
+thTc   = mk_known_key_name OccName.tcName   thSyn
+thCon  = mk_known_key_name OccName.dataName thSyn
+qqFun  = mk_known_key_name OccName.varName  qqLib
 
 -------------------- TH.Syntax -----------------------
 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
@@ -1892,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
@@ -1907,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 -----------------------
@@ -1954,8 +2213,9 @@ clauseName = libFun (fsLit "clause") clauseIdKey
 
 -- data Exp = ...
 varEName, conEName, litEName, appEName, infixEName, infixAppName,
-    sectionLName, sectionRName, lamEName, tupEName, unboxedTupEName, condEName,
-    letEName, caseEName, doEName, compEName :: Name
+    sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,
+    unboxedTupEName, condEName, multiIfEName, letEName, caseEName,
+    doEName, compEName :: Name
 varEName        = libFun (fsLit "varE")        varEIdKey
 conEName        = libFun (fsLit "conE")        conEIdKey
 litEName        = libFun (fsLit "litE")        litEIdKey
@@ -1965,9 +2225,11 @@ infixAppName    = libFun (fsLit "infixApp")    infixAppIdKey
 sectionLName    = libFun (fsLit "sectionL")    sectionLIdKey
 sectionRName    = libFun (fsLit "sectionR")    sectionRIdKey
 lamEName        = libFun (fsLit "lamE")        lamEIdKey
+lamCaseEName    = libFun (fsLit "lamCaseE")    lamCaseEIdKey
 tupEName        = libFun (fsLit "tupE")        tupEIdKey
 unboxedTupEName = libFun (fsLit "unboxedTupE") unboxedTupEIdKey
 condEName       = libFun (fsLit "condE")       condEIdKey
+multiIfEName    = libFun (fsLit "multiIfE")    multiIfEIdKey
 letEName        = libFun (fsLit "letE")        letEIdKey
 caseEName       = libFun (fsLit "caseE")       caseEIdKey
 doEName         = libFun (fsLit "doE")         doEIdKey
@@ -2009,39 +2271,42 @@ parSName    = libFun (fsLit "parS")    parSIdKey
 -- data Dec = ...
 funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
     instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
-    pragSpecInlDName, familyNoKindDName, familyKindDName, dataInstDName,
-    newtypeInstDName, tySynInstDName, 
-    infixLDName, infixRDName, infixNDName :: Name
-funDName         = libFun (fsLit "funD")         funDIdKey
-valDName         = libFun (fsLit "valD")         valDIdKey
-dataDName        = libFun (fsLit "dataD")        dataDIdKey
-newtypeDName     = libFun (fsLit "newtypeD")     newtypeDIdKey
-tySynDName       = libFun (fsLit "tySynD")       tySynDIdKey
-classDName       = libFun (fsLit "classD")       classDIdKey
-instanceDName    = libFun (fsLit "instanceD")    instanceDIdKey
-sigDName         = libFun (fsLit "sigD")         sigDIdKey
-forImpDName      = libFun (fsLit "forImpD")      forImpDIdKey
-pragInlDName     = libFun (fsLit "pragInlD")     pragInlDIdKey
-pragSpecDName    = libFun (fsLit "pragSpecD")    pragSpecDIdKey
-pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey
-familyNoKindDName= libFun (fsLit "familyNoKindD")familyNoKindDIdKey
-familyKindDName  = libFun (fsLit "familyKindD")  familyKindDIdKey
-dataInstDName    = libFun (fsLit "dataInstD")    dataInstDIdKey
-newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
-tySynInstDName   = libFun (fsLit "tySynInstD")   tySynInstDIdKey
-infixLDName      = libFun (fsLit "infixLD")      infixLDIdKey
-infixRDName      = libFun (fsLit "infixRD")      infixRDIdKey
-infixNDName      = libFun (fsLit "infixND")      infixNDIdKey
+    pragSpecInlDName, pragSpecInstDName, pragRuleDName, familyNoKindDName,
+    familyKindDName, dataInstDName, newtypeInstDName, tySynInstDName,
+    closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
+    infixLDName, infixRDName, infixNDName, roleAnnotDName :: Name
+funDName          = libFun (fsLit "funD")          funDIdKey
+valDName          = libFun (fsLit "valD")          valDIdKey
+dataDName         = libFun (fsLit "dataD")         dataDIdKey
+newtypeDName      = libFun (fsLit "newtypeD")      newtypeDIdKey
+tySynDName        = libFun (fsLit "tySynD")        tySynDIdKey
+classDName        = libFun (fsLit "classD")        classDIdKey
+instanceDName     = libFun (fsLit "instanceD")     instanceDIdKey
+sigDName          = libFun (fsLit "sigD")          sigDIdKey
+forImpDName       = libFun (fsLit "forImpD")       forImpDIdKey
+pragInlDName      = libFun (fsLit "pragInlD")      pragInlDIdKey
+pragSpecDName     = libFun (fsLit "pragSpecD")     pragSpecDIdKey
+pragSpecInlDName  = libFun (fsLit "pragSpecInlD")  pragSpecInlDIdKey
+pragSpecInstDName = libFun (fsLit "pragSpecInstD") pragSpecInstDIdKey
+pragRuleDName     = libFun (fsLit "pragRuleD")     pragRuleDIdKey
+familyNoKindDName = libFun (fsLit "familyNoKindD") familyNoKindDIdKey
+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
@@ -2065,26 +2330,53 @@ varStrictTypeName = libFun  (fsLit "varStrictType") varStrictTKey
 
 -- data Type = ...
 forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
-    listTName, appTName, sigTName :: Name
-forallTName = libFun (fsLit "forallT") forallTIdKey
-varTName    = libFun (fsLit "varT")    varTIdKey
-conTName    = libFun (fsLit "conT")    conTIdKey
-tupleTName  = libFun (fsLit "tupleT")  tupleTIdKey
-unboxedTupleTName = libFun (fsLit "unboxedTupleT")  unboxedTupleTIdKey
-arrowTName  = libFun (fsLit "arrowT")  arrowTIdKey
-listTName   = libFun (fsLit "listT")   listTIdKey
-appTName    = libFun (fsLit "appT")    appTIdKey
-sigTName    = libFun (fsLit "sigT")    sigTIdKey
+    listTName, appTName, sigTName, equalityTName, litTName,
+    promotedTName, promotedTupleTName,
+    promotedNilTName, promotedConsTName :: Name
+forallTName         = libFun (fsLit "forallT")        forallTIdKey
+varTName            = libFun (fsLit "varT")           varTIdKey
+conTName            = libFun (fsLit "conT")           conTIdKey
+tupleTName          = libFun (fsLit "tupleT")         tupleTIdKey
+unboxedTupleTName   = libFun (fsLit "unboxedTupleT")  unboxedTupleTIdKey
+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
+promotedNilTName    = libFun (fsLit "promotedNilT")   promotedNilTIdKey
+promotedConsTName   = libFun (fsLit "promotedConsT")  promotedConsTIdKey
+
+-- data TyLit = ...
+numTyLitName, strTyLitName :: Name
+numTyLitName = libFun (fsLit "numTyLit") numTyLitIdKey
+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 = ...
-starKName, arrowKName :: Name
-starKName  = libFun (fsLit "starK")   starKIdKey
-arrowKName = libFun (fsLit "arrowK")  arrowKIdKey
+varKName, conKName, tupleKName, arrowKName, listKName, appKName,
+  starKName, constraintKName :: Name
+varKName        = libFun (fsLit "varK")         varKIdKey
+conKName        = libFun (fsLit "conK")         conKIdKey
+tupleKName      = libFun (fsLit "tupleK")       tupleKIdKey
+arrowKName      = libFun (fsLit "arrowK")       arrowKIdKey
+listKName       = libFun (fsLit "listK")        listKIdKey
+appKName        = libFun (fsLit "appK")         appKIdKey
+starKName       = libFun (fsLit "starK")        starKIdKey
+constraintKName = libFun (fsLit "constraintK")  constraintKIdKey
 
 -- data Callconv = ...
 cCallName, stdCallName :: Name
@@ -2097,10 +2389,31 @@ unsafeName     = libFun (fsLit "unsafe") unsafeIdKey
 safeName       = libFun (fsLit "safe") safeIdKey
 interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
 
--- data InlineSpec = ...
-inlineSpecNoPhaseName, inlineSpecPhaseName :: Name
-inlineSpecNoPhaseName = libFun (fsLit "inlineSpecNoPhase") inlineSpecNoPhaseIdKey
-inlineSpecPhaseName   = libFun (fsLit "inlineSpecPhase")   inlineSpecPhaseIdKey
+-- data Inline = ...
+noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
+noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
+inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
+inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
+
+-- data RuleMatch = ...
+conLikeDataConName, funLikeDataConName :: Name
+conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
+funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
+
+-- data Phases = ...
+allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name
+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
+typedRuleVarName = libFun (fsLit ("typedRuleVar")) typedRuleVarIdKey
 
 -- data FunDep = ...
 funDepName :: Name
@@ -2111,15 +2424,20 @@ typeFamName, dataFamName :: Name
 typeFamName = libFun (fsLit "typeFam") typeFamIdKey
 dataFamName = libFun (fsLit "dataFam") dataFamIdKey
 
+-- data TySynEqn = ...
+tySynEqnName :: Name
+tySynEqnName = libFun (fsLit "tySynEqn") tySynEqnIdKey
+
 matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
     decQTyConName, conQTyConName, strictTypeQTyConName,
     varStrictTypeQTyConName, typeQTyConName, fieldExpQTyConName,
-    patQTyConName, fieldPatQTyConName, predQTyConName, decsQTyConName :: Name
-matchQTyConName         = libTc (fsLit "MatchQ")        matchQTyConKey
-clauseQTyConName        = libTc (fsLit "ClauseQ")       clauseQTyConKey
-expQTyConName           = libTc (fsLit "ExpQ")          expQTyConKey
-stmtQTyConName          = libTc (fsLit "StmtQ")         stmtQTyConKey
-decQTyConName           = libTc (fsLit "DecQ")          decQTyConKey
+    patQTyConName, fieldPatQTyConName, predQTyConName, decsQTyConName,
+    ruleBndrQTyConName, tySynEqnQTyConName, roleTyConName :: Name
+matchQTyConName         = libTc (fsLit "MatchQ")         matchQTyConKey
+clauseQTyConName        = libTc (fsLit "ClauseQ")        clauseQTyConKey
+expQTyConName           = libTc (fsLit "ExpQ")           expQTyConKey
+stmtQTyConName          = libTc (fsLit "StmtQ")          stmtQTyConKey
+decQTyConName           = libTc (fsLit "DecQ")           decQTyConKey
 decsQTyConName          = libTc (fsLit "DecsQ")          decsQTyConKey  -- Q [Dec]
 conQTyConName           = libTc (fsLit "ConQ")           conQTyConKey
 strictTypeQTyConName    = libTc (fsLit "StrictTypeQ")    strictTypeQTyConKey
@@ -2129,13 +2447,16 @@ fieldExpQTyConName      = libTc (fsLit "FieldExpQ")      fieldExpQTyConKey
 patQTyConName           = libTc (fsLit "PatQ")           patQTyConKey
 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
@@ -2146,7 +2467,8 @@ expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
     decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
     fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
     fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
-    predQTyConKey, decsQTyConKey :: Unique
+    predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey,
+    roleTyConKey, tExpTyConKey :: Unique
 expTyConKey             = mkPreludeTyConUnique 200
 matchTyConKey           = mkPreludeTyConUnique 201
 clauseTyConKey          = mkPreludeTyConUnique 202
@@ -2174,13 +2496,17 @@ predTyConKey            = mkPreludeTyConUnique 223
 predQTyConKey           = mkPreludeTyConUnique 224
 tyVarBndrTyConKey       = mkPreludeTyConUnique 225
 decsQTyConKey           = mkPreludeTyConUnique 226
+ruleBndrQTyConKey       = mkPreludeTyConUnique 227
+tySynEqnQTyConKey       = mkPreludeTyConUnique 228
+roleTyConKey            = mkPreludeTyConUnique 229
+tExpTyConKey            = mkPreludeTyConUnique 230
 
--- IdUniques available: 200-399
+-- 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
@@ -2191,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 = ...
@@ -2241,8 +2570,8 @@ clauseIdKey         = mkPreludeMiscIdUnique 262
 
 -- data Exp = ...
 varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
-    sectionLIdKey, sectionRIdKey, lamEIdKey, tupEIdKey, unboxedTupEIdKey,
-    condEIdKey,
+    sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey, tupEIdKey,
+    unboxedTupEIdKey, condEIdKey, multiIfEIdKey,
     letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
     fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
     listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey :: Unique
@@ -2255,21 +2584,23 @@ infixAppIdKey     = mkPreludeMiscIdUnique 275
 sectionLIdKey     = mkPreludeMiscIdUnique 276
 sectionRIdKey     = mkPreludeMiscIdUnique 277
 lamEIdKey         = mkPreludeMiscIdUnique 278
-tupEIdKey         = mkPreludeMiscIdUnique 279
-unboxedTupEIdKey  = mkPreludeMiscIdUnique 280
-condEIdKey        = mkPreludeMiscIdUnique 281
-letEIdKey         = mkPreludeMiscIdUnique 282
-caseEIdKey        = mkPreludeMiscIdUnique 283
-doEIdKey          = mkPreludeMiscIdUnique 284
-compEIdKey        = mkPreludeMiscIdUnique 285
-fromEIdKey        = mkPreludeMiscIdUnique 286
-fromThenEIdKey    = mkPreludeMiscIdUnique 287
-fromToEIdKey      = mkPreludeMiscIdUnique 288
-fromThenToEIdKey  = mkPreludeMiscIdUnique 289
-listEIdKey        = mkPreludeMiscIdUnique 290
-sigEIdKey         = mkPreludeMiscIdUnique 291
-recConEIdKey      = mkPreludeMiscIdUnique 292
-recUpdEIdKey      = mkPreludeMiscIdUnique 293
+lamCaseEIdKey     = mkPreludeMiscIdUnique 279
+tupEIdKey         = mkPreludeMiscIdUnique 280
+unboxedTupEIdKey  = mkPreludeMiscIdUnique 281
+condEIdKey        = mkPreludeMiscIdUnique 282
+multiIfEIdKey     = mkPreludeMiscIdUnique 283
+letEIdKey         = mkPreludeMiscIdUnique 284
+caseEIdKey        = mkPreludeMiscIdUnique 285
+doEIdKey          = mkPreludeMiscIdUnique 286
+compEIdKey        = mkPreludeMiscIdUnique 287
+fromEIdKey        = mkPreludeMiscIdUnique 288
+fromThenEIdKey    = mkPreludeMiscIdUnique 289
+fromToEIdKey      = mkPreludeMiscIdUnique 290
+fromThenToEIdKey  = mkPreludeMiscIdUnique 291
+listEIdKey        = mkPreludeMiscIdUnique 292
+sigEIdKey         = mkPreludeMiscIdUnique 293
+recConEIdKey      = mkPreludeMiscIdUnique 294
+recUpdEIdKey      = mkPreludeMiscIdUnique 295
 
 -- type FieldExp = ...
 fieldExpIdKey :: Unique
@@ -2295,39 +2626,41 @@ parSIdKey        = mkPreludeMiscIdUnique 323
 -- data Dec = ...
 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
     classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
-    pragSpecDIdKey, pragSpecInlDIdKey, 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
-familyNoKindDIdKey = mkPreludeMiscIdUnique 342
-familyKindDIdKey   = mkPreludeMiscIdUnique 343
-dataInstDIdKey     = mkPreludeMiscIdUnique 344
-newtypeInstDIdKey  = mkPreludeMiscIdUnique 345
-tySynInstDIdKey    = mkPreludeMiscIdUnique 346
-infixLDIdKey       = mkPreludeMiscIdUnique 347
-infixRDIdKey       = mkPreludeMiscIdUnique 348
-infixNDIdKey       = mkPreludeMiscIdUnique 349
+    pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey, pragRuleDIdKey,
+    familyNoKindDIdKey, familyKindDIdKey,
+    dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey,
+    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
@@ -2351,55 +2684,107 @@ varStrictTKey     = mkPreludeMiscIdUnique 375
 
 -- data Type = ...
 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey,
-    listTIdKey, appTIdKey, sigTIdKey :: Unique
-forallTIdKey       = mkPreludeMiscIdUnique 380
-varTIdKey          = mkPreludeMiscIdUnique 381
-conTIdKey          = mkPreludeMiscIdUnique 382
-tupleTIdKey        = mkPreludeMiscIdUnique 383
-unboxedTupleTIdKey = mkPreludeMiscIdUnique 384
-arrowTIdKey        = mkPreludeMiscIdUnique 385
-listTIdKey         = mkPreludeMiscIdUnique 386
-appTIdKey          = mkPreludeMiscIdUnique 387
-sigTIdKey          = mkPreludeMiscIdUnique 388
+    listTIdKey, appTIdKey, sigTIdKey, equalityTIdKey, litTIdKey,
+    promotedTIdKey, promotedTupleTIdKey,
+    promotedNilTIdKey, promotedConsTIdKey :: Unique
+forallTIdKey        = mkPreludeMiscIdUnique 380
+varTIdKey           = mkPreludeMiscIdUnique 381
+conTIdKey           = mkPreludeMiscIdUnique 382
+tupleTIdKey         = mkPreludeMiscIdUnique 383
+unboxedTupleTIdKey  = mkPreludeMiscIdUnique 384
+arrowTIdKey         = mkPreludeMiscIdUnique 385
+listTIdKey          = mkPreludeMiscIdUnique 386
+appTIdKey           = mkPreludeMiscIdUnique 387
+sigTIdKey           = mkPreludeMiscIdUnique 388
+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 395
+strTyLitIdKey = mkPreludeMiscIdUnique 396
 
 -- data TyVarBndr = ...
 plainTVIdKey, kindedTVIdKey :: Unique
-plainTVIdKey      = mkPreludeMiscIdUnique 390
-kindedTVIdKey     = mkPreludeMiscIdUnique 391
+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 = ...
-starKIdKey, arrowKIdKey :: Unique
-starKIdKey        = mkPreludeMiscIdUnique 392
-arrowKIdKey       = mkPreludeMiscIdUnique 393
+varKIdKey, conKIdKey, tupleKIdKey, arrowKIdKey, listKIdKey, appKIdKey,
+  starKIdKey, constraintKIdKey :: Unique
+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 394
-stdCallIdKey    = mkPreludeMiscIdUnique 395
+cCallIdKey      = mkPreludeMiscIdUnique 412
+stdCallIdKey    = mkPreludeMiscIdUnique 413
 
 -- data Safety = ...
 unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
-unsafeIdKey        = mkPreludeMiscIdUnique 400
-safeIdKey          = mkPreludeMiscIdUnique 401
-interruptibleIdKey = mkPreludeMiscIdUnique 403
-
--- data InlineSpec =
-inlineSpecNoPhaseIdKey, inlineSpecPhaseIdKey :: Unique
-inlineSpecNoPhaseIdKey = mkPreludeMiscIdUnique 404
-inlineSpecPhaseIdKey   = mkPreludeMiscIdUnique 405
+unsafeIdKey        = mkPreludeMiscIdUnique 414
+safeIdKey          = mkPreludeMiscIdUnique 415
+interruptibleIdKey = mkPreludeMiscIdUnique 416
+
+-- data Inline = ...
+noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
+noInlineDataConKey  = mkPreludeDataConUnique 40
+inlineDataConKey    = mkPreludeDataConUnique 41
+inlinableDataConKey = mkPreludeDataConUnique 42
+
+-- data RuleMatch = ...
+conLikeDataConKey, funLikeDataConKey :: Unique
+conLikeDataConKey = mkPreludeDataConUnique 43
+funLikeDataConKey = mkPreludeDataConUnique 44
+
+-- data Phases = ...
+allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
+allPhasesDataConKey   = mkPreludeDataConUnique 45
+fromPhaseDataConKey   = mkPreludeDataConUnique 46
+beforePhaseDataConKey = mkPreludeDataConUnique 47
+
+-- newtype TExp a = ...
+tExpDataConKey :: Unique
+tExpDataConKey = mkPreludeDataConUnique 48
 
 -- data FunDep = ...
 funDepIdKey :: Unique
-funDepIdKey = mkPreludeMiscIdUnique 406
+funDepIdKey = mkPreludeMiscIdUnique 419
 
 -- data FamFlavour = ...
 typeFamIdKey, dataFamIdKey :: Unique
-typeFamIdKey = mkPreludeMiscIdUnique 407
-dataFamIdKey = mkPreludeMiscIdUnique 408
+typeFamIdKey = mkPreludeMiscIdUnique 420
+dataFamIdKey = mkPreludeMiscIdUnique 421
+
+-- data TySynEqn = ...
+tySynEqnIdKey :: Unique
+tySynEqnIdKey = mkPreludeMiscIdUnique 422
 
 -- quasiquoting
 quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique
-quoteExpKey  = mkPreludeMiscIdUnique 410
-quotePatKey  = mkPreludeMiscIdUnique 411
-quoteDecKey  = mkPreludeMiscIdUnique 412
-quoteTypeKey = mkPreludeMiscIdUnique 413
+quoteExpKey  = mkPreludeMiscIdUnique 423
+quotePatKey  = mkPreludeMiscIdUnique 424
+quoteDecKey  = mkPreludeMiscIdUnique 425
+quoteTypeKey = mkPreludeMiscIdUnique 426
+
+-- data RuleBndr = ...
+ruleVarIdKey, typedRuleVarIdKey :: Unique
+ruleVarIdKey      = mkPreludeMiscIdUnique 427
+typedRuleVarIdKey = mkPreludeMiscIdUnique 428