Refactor PackageTarget back into StaticTarget

[ghc-hetmet.git] / compiler / deSugar / DsMeta.hs

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 5c3486a..e95df4d 100644 (file)
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -13,17 +13,9 @@
 -- a Royal Pain (triggers other recompilation).
 -----------------------------------------------------------------------------
 
 -- a Royal Pain (triggers other recompilation).
 -----------------------------------------------------------------------------
 

-{-# OPTIONS -fno-warn-unused-imports #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
--- The kludge is only needed in this module because of trac #2267.
-

 module DsMeta( dsBracket, 
               templateHaskellNames, qTyConName, nameTyConName,
 module DsMeta( dsBracket, 
               templateHaskellNames, qTyConName, nameTyConName,

-              liftName, expQTyConName, patQTyConName, decQTyConName, typeQTyConName,
+              liftName, liftStringName, expQTyConName, patQTyConName, decQTyConName, typeQTyConName,

               decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
               quoteExpName, quotePatName
                ) where
               decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
               quoteExpName, quotePatName
                ) where

@@ -33,7 +25,6 @@ module DsMeta( dsBracket,
 import {-# SOURCE #-}  DsExpr ( dsExpr )
 
 import MatchLit
 import {-# SOURCE #-}  DsExpr ( dsExpr )
 
 import MatchLit

-import DsUtils

 import DsMonad
 
 import qualified Language.Haskell.TH as TH
 import DsMonad
 
 import qualified Language.Haskell.TH as TH

@@ -45,11 +36,11 @@ 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.
 -- 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
+import qualified OccName( isDataOcc, isVarOcc, isTcOcc, varName, tcName ) 

 
 import Module
 import Id
 
 import Module
 import Id

-import Name
+import Name hiding( isVarOcc, isTcOcc, varName, tcName ) 

 import NameEnv
 import TcType
 import TyCon
 import NameEnv
 import TcType
 import TyCon

@@ -188,7 +179,7 @@ repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
               ; cons1    <- mapM repC cons
              ; cons2    <- coreList conQTyConName cons1
              ; derivs1  <- repDerivs mb_derivs
               ; cons1    <- mapM repC cons
              ; cons2    <- coreList conQTyConName cons1
              ; derivs1  <- repDerivs mb_derivs

-             ; bndrs1   <- coreList nameTyConName bndrs
+             ; bndrs1   <- coreList tyVarBndrTyConName bndrs

              ; repData cxt1 tc1 bndrs1 opt_tys2 cons2 derivs1 
               }
        ; return $ Just (loc, dec) 
              ; repData cxt1 tc1 bndrs1 opt_tys2 cons2 derivs1 
               }
        ; return $ Just (loc, dec) 

@@ -204,7 +195,7 @@ repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt,
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
               ; con1     <- repC con
              ; derivs1  <- repDerivs mb_derivs
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
               ; con1     <- repC con
              ; derivs1  <- repDerivs mb_derivs

-             ; bndrs1   <- coreList nameTyConName bndrs
+             ; bndrs1   <- coreList tyVarBndrTyConName bndrs

              ; repNewtype cxt1 tc1 bndrs1 opt_tys2 con1 derivs1
               }
        ; return $ Just (loc, dec) 
              ; repNewtype cxt1 tc1 bndrs1 opt_tys2 con1 derivs1
               }
        ; return $ Just (loc, dec) 

@@ -217,7 +208,7 @@ repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys
            do { opt_tys1 <- maybeMapM repLTys opt_tys   -- only for family insts
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
              ; ty1      <- repLTy ty
            do { opt_tys1 <- maybeMapM repLTys opt_tys   -- only for family insts
               ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
              ; ty1      <- repLTy ty

-             ; bndrs1   <- coreList nameTyConName bndrs
+             ; bndrs1   <- coreList tyVarBndrTyConName bndrs

              ; repTySyn tc1 bndrs1 opt_tys2 ty1 
               }
        ; return (Just (loc, dec)) 
              ; repTySyn tc1 bndrs1 opt_tys2 ty1 
               }
        ; return (Just (loc, dec)) 

@@ -235,7 +226,7 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
              ; fds1   <- repLFunDeps fds
               ; ats1   <- repLAssocFamilys ats
              ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
              ; fds1   <- repLFunDeps fds
               ; ats1   <- repLAssocFamilys ats
              ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)

-             ; bndrs1 <- coreList nameTyConName bndrs
+             ; bndrs1 <- coreList tyVarBndrTyConName bndrs

              ; repClass cxt1 cls1 bndrs1 fds1 decls1 
               }
        ; return $ Just (loc, dec) 
              ; repClass cxt1 cls1 bndrs1 fds1 decls1 
               }
        ; return $ Just (loc, dec) 

@@ -255,13 +246,17 @@ repTyFamily :: LTyClDecl Name
             -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 repTyFamily (L loc (TyFamily { tcdFlavour = flavour,
                               tcdLName = tc, tcdTyVars = tvs, 
             -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 repTyFamily (L loc (TyFamily { tcdFlavour = flavour,
                               tcdLName = tc, tcdTyVars = tvs, 

-                              tcdKind = _kind }))
+                              tcdKind = opt_kind }))

             tyVarBinds
   = do { tc1 <- lookupLOcc tc          -- See note [Binders and occurrences] 
        ; dec <- tyVarBinds tvs $ \bndrs ->
            do { flav   <- repFamilyFlavour flavour
             tyVarBinds
   = do { tc1 <- lookupLOcc tc          -- See note [Binders and occurrences] 
        ; dec <- tyVarBinds tvs $ \bndrs ->
            do { flav   <- repFamilyFlavour flavour

-             ; bndrs1 <- coreList nameTyConName bndrs
-              ; repFamily flav tc1 bndrs1
+             ; bndrs1 <- coreList tyVarBndrTyConName bndrs
+              ; case opt_kind of 
+                  Nothing -> repFamilyNoKind flav tc1 bndrs1
+                  Just ki -> do { ki1 <- repKind ki 
+                                ; repFamilyKind flav tc1 bndrs1 ki1
+                                }

               }
        ; return $ Just (loc, dec)
        }
               }
        ; return $ Just (loc, dec)
        }

@@ -329,7 +324,7 @@ repInstD' (L loc (InstDecl ty binds _ ats)) -- Ignore user pragmas for now
    (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
 
 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
    (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
 
 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)

-repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis)))
+repForD (L loc (ForeignImport name typ (CImport cc s ch cis)))

  = do MkC name' <- lookupLOcc name
       MkC typ' <- repLTy typ
       MkC cc' <- repCCallConv cc
  = do MkC name' <- lookupLOcc name
       MkC typ' <- repLTy typ
       MkC cc' <- repCCallConv cc

@@ -337,24 +332,23 @@ repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis)))
       cis' <- conv_cimportspec cis
       MkC str <- coreStringLit $ static
                               ++ unpackFS ch ++ " "
       cis' <- conv_cimportspec cis
       MkC str <- coreStringLit $ static
                               ++ unpackFS ch ++ " "

-                              ++ unpackFS cn ++ " "

                               ++ cis'
       dec <- rep2 forImpDName [cc', s', str, name', typ']
       return (loc, dec)
  where
     conv_cimportspec (CLabel cls) = notHandled "Foreign label" (doubleQuotes (ppr cls))
     conv_cimportspec (CFunction DynamicTarget) = return "dynamic"
                               ++ cis'
       dec <- rep2 forImpDName [cc', s', str, name', typ']
       return (loc, dec)
  where
     conv_cimportspec (CLabel cls) = notHandled "Foreign label" (doubleQuotes (ppr cls))
     conv_cimportspec (CFunction DynamicTarget) = return "dynamic"

-    conv_cimportspec (CFunction (StaticTarget fs)) = return (unpackFS fs)
+    conv_cimportspec (CFunction (StaticTarget fs _)) = return (unpackFS fs)

     conv_cimportspec CWrapper = return "wrapper"
     static = case cis of
     conv_cimportspec CWrapper = return "wrapper"
     static = case cis of

-                 CFunction (StaticTarget _) -> "static "
+                 CFunction (StaticTarget _ _) -> "static "

                  _ -> ""
 repForD decl = notHandled "Foreign declaration" (ppr decl)
 
 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
 repCCallConv CCallConv = rep2 cCallName []
 repCCallConv StdCallConv = rep2 stdCallName []
                  _ -> ""
 repForD decl = notHandled "Foreign declaration" (ppr decl)
 
 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
 repCCallConv CCallConv = rep2 cCallName []
 repCCallConv StdCallConv = rep2 stdCallName []

-repCCallConv CmmCallConv = notHandled "repCCallConv" (ppr CmmCallConv)
+repCCallConv callConv    = notHandled "repCCallConv" (ppr callConv)

 
 repSafety :: Safety -> DsM (Core TH.Safety)
 repSafety PlayRisky = rep2 unsafeName []
 
 repSafety :: Safety -> DsM (Core TH.Safety)
 repSafety PlayRisky = rep2 unsafeName []

@@ -369,17 +363,18 @@ ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:")
 -------------------------------------------------------
 
 repC :: LConDecl Name -> DsM (Core TH.ConQ)
 -------------------------------------------------------
 
 repC :: LConDecl Name -> DsM (Core TH.ConQ)

-repC (L _ (ConDecl con _ [] (L _ []) details ResTyH98 _))
-  = do { con1 <- lookupLOcc con ;              -- See note [Binders and occurrences] 
-        repConstr con1 details }
-repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98 doc))
-  = do { addTyVarBinds tvs $ \bndrs -> do {
-             c' <- repC (L loc (ConDecl con expl [] (L cloc []) details ResTyH98 doc));
-             ctxt' <- repContext ctxt;
-             bndrs' <- coreList nameTyConName bndrs;
-             rep2 forallCName [unC bndrs', unC ctxt', unC c']
-         }
+repC (L _ (ConDecl { con_name = con, con_qvars = [], con_cxt = L _ []
+                  , con_details = details, con_res = ResTyH98 }))
+  = do { con1 <- lookupLOcc con        -- See note [Binders and occurrences] 
+       ; repConstr con1 details 

        }
        }

+repC (L loc con_decl@(ConDecl { con_qvars = tvs, con_cxt = L cloc ctxt, con_res = ResTyH98 }))
+  = addTyVarBinds tvs $ \bndrs -> 
+      do { c' <- repC (L loc (con_decl { con_qvars = [], con_cxt = L cloc [] }))
+         ; ctxt' <- repContext ctxt
+         ; bndrs' <- coreList tyVarBndrTyConName bndrs
+         ; rep2 forallCName [unC bndrs', unC ctxt', unC c']
+         }

 repC (L loc con_decl)          -- GADTs
   = putSrcSpanDs loc $
     notHandled "GADT declaration" (ppr con_decl) 
 repC (L loc con_decl)          -- GADTs
   = putSrcSpanDs loc $
     notHandled "GADT declaration" (ppr con_decl) 

@@ -440,35 +435,38 @@ rep_proto nm ty loc
        ; return [(loc, sig)]
        }
 
        ; return [(loc, sig)]
        }
 

-rep_inline :: Located Name -> InlineSpec -> SrcSpan 
+rep_inline :: Located Name 
+           -> InlinePragma     -- Never defaultInlinePragma
+           -> SrcSpan 

            -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_inline nm ispec loc
   = do { nm1 <- lookupLOcc nm
            -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_inline nm ispec loc
   = do { nm1 <- lookupLOcc nm

-       ; (_, ispec1) <- rep_InlineSpec ispec
+       ; ispec1 <- rep_InlinePrag ispec

        ; pragma <- repPragInl nm1 ispec1
        ; return [(loc, pragma)]
        }
 
        ; pragma <- repPragInl nm1 ispec1
        ; return [(loc, pragma)]
        }
 

-rep_specialise :: Located Name -> LHsType Name -> InlineSpec -> 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
                -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_specialise nm ty ispec loc
   = do { nm1 <- lookupLOcc nm
        ; ty1 <- repLTy ty

-       ; (hasSpec, ispec1) <- rep_InlineSpec ispec
-       ; pragma <- if hasSpec
-                   then repPragSpecInl nm1 ty1 ispec1
-                   else repPragSpec    nm1 ty1 
+       ; pragma <- if isDefaultInlinePragma ispec
+                   then repPragSpec nm1 ty1                  -- SPECIALISE
+                   else do { ispec1 <- rep_InlinePrag ispec  -- SPECIALISE INLINE
+                           ; repPragSpecInl nm1 ty1 ispec1 } 

        ; return [(loc, pragma)]
        }
 
        ; return [(loc, pragma)]
        }
 

--- extract all the information needed to build a TH.InlineSpec
+-- Extract all the information needed to build a TH.InlinePrag

 --
 --

-rep_InlineSpec :: InlineSpec -> DsM (Bool, Core TH.InlineSpecQ)
-rep_InlineSpec (Inline (InlinePragma activation match) inline)
+rep_InlinePrag :: InlinePragma -- Never defaultInlinePragma
+               -> DsM (Core TH.InlineSpecQ)
+rep_InlinePrag (InlinePragma { inl_act = activation, inl_rule = match, inl_inline = inline })

   | Nothing            <- activation1 
   | Nothing            <- activation1 

-    = liftM ((,) False) $ repInlineSpecNoPhase inline1 match1
+    = repInlineSpecNoPhase inline1 match1

   | Just (flag, phase) <- activation1 
   | Just (flag, phase) <- activation1 

-    = liftM ((,) True)  $ repInlineSpecPhase inline1 match1 flag phase
+    = repInlineSpecPhase inline1 match1 flag phase

   | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec"
     where
       match1      = coreBool (rep_RuleMatchInfo match)
   | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec"
     where
       match1      = coreBool (rep_RuleMatchInfo match)

@@ -478,8 +476,8 @@ rep_InlineSpec (Inline (InlinePragma activation match) inline)
       rep_RuleMatchInfo FunLike = False
       rep_RuleMatchInfo ConLike = True
 
       rep_RuleMatchInfo FunLike = False
       rep_RuleMatchInfo ConLike = True
 

-      rep_Activation NeverActive          = Nothing
-      rep_Activation AlwaysActive         = Nothing
+      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, 
       rep_Activation (ActiveBefore phase) = Just (coreBool False, 
                                                   MkC $ mkIntExprInt phase)
       rep_Activation (ActiveAfter phase)  = Just (coreBool True, 

@@ -495,8 +493,8 @@ rep_InlineSpec (Inline (InlinePragma activation match) inline)
 -- families, depending on whether they are associated or not.
 --
 type ProcessTyVarBinds a = 
 -- families, depending on whether they are associated or not.
 --
 type ProcessTyVarBinds a = 

-         [LHsTyVarBndr Name]                    -- the binders to be added
-      -> ([Core TH.Name] -> DsM (Core (TH.Q a))) -- action in the ext env
+         [LHsTyVarBndr 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;
       -> DsM (Core (TH.Q a))
 
 -- gensym a list of type variables and enter them into the meta environment;

@@ -506,11 +504,13 @@ type ProcessTyVarBinds a =
 addTyVarBinds :: ProcessTyVarBinds a
 addTyVarBinds tvs m =
   do
 addTyVarBinds :: ProcessTyVarBinds a
 addTyVarBinds tvs m =
   do

-    let names = map (hsTyVarName.unLoc) tvs
+    let names       = hsLTyVarNames tvs
+        mkWithKinds = map repTyVarBndrWithKind tvs

     freshNames <- mkGenSyms names
     term       <- addBinds freshNames $ do
     freshNames <- mkGenSyms names
     term       <- addBinds freshNames $ do

-                   bndrs <- mapM lookupBinder names 
-                   m bndrs
+                   bndrs       <- mapM lookupBinder names 
+                    kindedBndrs <- zipWithM ($) mkWithKinds bndrs
+                   m kindedBndrs

     wrapGenSyns freshNames term
 
 -- Look up a list of type variables; the computations passed as the second 
     wrapGenSyns freshNames term
 
 -- Look up a list of type variables; the computations passed as the second 

@@ -519,9 +519,19 @@ addTyVarBinds tvs m =
 lookupTyVarBinds :: ProcessTyVarBinds a
 lookupTyVarBinds tvs m =
   do
 lookupTyVarBinds :: ProcessTyVarBinds a
 lookupTyVarBinds tvs m =
   do

-    let names = map (hsTyVarName.unLoc) tvs
-    bndrs <- mapM lookupBinder names 
-    m bndrs
+    let names       = hsLTyVarNames tvs
+        mkWithKinds = map repTyVarBndrWithKind tvs
+    bndrs       <- mapM lookupBinder names 
+    kindedBndrs <- zipWithM ($) mkWithKinds bndrs
+    m kindedBndrs
+
+-- Produce kinded binder constructors from the Haskell tyvar binders
+--
+repTyVarBndrWithKind :: LHsTyVarBndr Name 
+                     -> Core TH.Name -> DsM (Core TH.TyVarBndr)
+repTyVarBndrWithKind (L _ (UserTyVar _))      = repPlainTV
+repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) = 
+  \nm -> repKind ki >>= repKindedTV nm

 
 -- represent a type context
 --
 
 -- represent a type context
 --

@@ -576,44 +586,77 @@ repTy (HsForAllTy _ tvs ctxt ty)  =
   addTyVarBinds tvs $ \bndrs -> do
     ctxt1  <- repLContext ctxt
     ty1    <- repLTy ty
   addTyVarBinds tvs $ \bndrs -> do
     ctxt1  <- repLContext ctxt
     ty1    <- repLTy ty

-    bndrs1 <- coreList nameTyConName bndrs
+    bndrs1 <- coreList tyVarBndrTyConName bndrs

     repTForall bndrs1 ctxt1 ty1
 
 repTy (HsTyVar n)
     repTForall bndrs1 ctxt1 ty1
 
 repTy (HsTyVar n)

-  | isTvOcc (nameOccName n)       = do 
-                                     tv1 <- lookupTvOcc 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
-repTy (HsPArrTy t)                = do
-                                     t1   <- repLTy t
-                                     tcon <- repTy (HsTyVar (tyConName parrTyCon))
-                                     repTapp tcon t1
-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
-repTy (HsPredTy pred)             = repPredTy pred
-repTy ty@(HsNumTy _)              = notHandled "Number types (for generics)" (ppr ty)
-repTy ty                         = notHandled "Exotic form of type" (ppr ty)
+  | isTvOcc (nameOccName n) = do 
+                               tv1 <- lookupTvOcc 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
+repTy (HsPArrTy t)          = do
+                               t1   <- repLTy t
+                               tcon <- repTy (HsTyVar (tyConName parrTyCon))
+                               repTapp tcon t1
+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
+repTy (HsPredTy pred)       = repPredTy pred
+repTy (HsKindSig t k)       = do
+                                t1 <- repLTy t
+                                k1 <- repKind k
+                                repTSig t1 k1
+repTy (HsSpliceTy splice)   = repSplice splice
+repTy ty@(HsNumTy _)        = notHandled "Number types (for generics)" (ppr ty)
+repTy ty                   = notHandled "Exotic form of type" (ppr ty)
+
+-- represent a kind
+--
+repKind :: Kind -> DsM (Core TH.Kind)
+repKind ki
+  = do { let (kis, ki') = splitKindFunTys ki
+       ; kis_rep <- mapM repKind kis
+       ; ki'_rep <- repNonArrowKind ki'
+       ; foldlM repArrowK ki'_rep kis_rep
+       }
+  where
+    repNonArrowKind k | isLiftedTypeKind k = repStarK
+                      | otherwise          = notHandled "Exotic form of kind" 
+                                                        (ppr k)

 
 

+-----------------------------------------------------------------------------
+--             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 _) 
+ = 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

 
 -----------------------------------------------------------------------------
 --             Expressions
 
 -----------------------------------------------------------------------------
 --             Expressions

@@ -688,8 +731,10 @@ repE e@(HsDo _ _ _ _) = notHandled "mdo and [: :]" (ppr e)
 repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
 repE e@(ExplicitTuple es boxed) 
 repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
 repE e@(ExplicitTuple es boxed) 

-  | isBoxed boxed         = do { xs <- repLEs es; repTup xs }
-  | otherwise            = notHandled "Unboxed tuples" (ppr e)
+  | not (isBoxed boxed)        = notHandled "Unboxed tuples" (ppr e)
+  | not (all tupArgPresent es) = notHandled "Tuple sections" (ppr e)
+  | otherwise                  = do { xs <- repLEs [e | Present e <- es]; repTup xs }
+

 repE (RecordCon c _ flds)
  = do { x <- lookupLOcc c;
         fs <- repFields flds;
 repE (RecordCon c _ flds)
  = do { x <- lookupLOcc c;
         fs <- repFields flds;

@@ -716,14 +761,8 @@ repE (ArithSeq _ aseq) =
                             ds2 <- repLE e2
                             ds3 <- repLE e3
                             repFromThenTo ds1 ds2 ds3
                             ds2 <- repLE e2
                             ds3 <- repLE e3
                             repFromThenTo ds1 ds2 ds3

-repE (HsSpliceE (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

 
 

+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@(PArrSeq {})      = notHandled "Parallel arrays" (ppr e)
 repE e@(HsCoreAnn {})    = notHandled "Core annotations" (ppr e)
 repE e@(HsSCC {})        = notHandled "Cost centres" (ppr e)

@@ -970,10 +1009,13 @@ 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 (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 (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 (TuplePat ps _ _) = do { qs <- repLPs ps; repPtup qs }
+repP p@(TuplePat ps boxed _) 
+  | not (isBoxed boxed) = notHandled "Unboxed tuples" (ppr p)
+  | otherwise           = do { qs <- repLPs ps; repPtup qs }

 repP (ConPatIn dc details)
  = do { con_str <- lookupLOcc dc
       ; case details of
 repP (ConPatIn dc details)
  = do { con_str <- lookupLOcc dc
       ; case details of

@@ -1209,6 +1251,9 @@ repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
 repPtilde (MkC p) = rep2 tildePName [p]
 
 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
 repPtilde (MkC p) = rep2 tildePName [p]
 

+repPbang :: Core TH.PatQ -> DsM (Core TH.PatQ)
+repPbang (MkC p) = rep2 bangPName [p]
+

 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
 
 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
 

@@ -1336,7 +1381,7 @@ repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)  
 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
 
 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.Name] 
+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)
         -> 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)

@@ -1344,7 +1389,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]
 
 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.Name] 
+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)
            -> 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)

@@ -1352,7 +1397,7 @@ 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]
 
 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.Name] 
+repTySyn :: Core TH.Name -> Core [TH.TyVarBndr] 

          -> Maybe (Core [TH.TypeQ])
          -> Core TH.TypeQ -> DsM (Core TH.DecQ)
 repTySyn (MkC nm) (MkC tvs) Nothing (MkC rhs) 
          -> Maybe (Core [TH.TypeQ])
          -> Core TH.TypeQ -> DsM (Core TH.DecQ)
 repTySyn (MkC nm) (MkC tvs) Nothing (MkC rhs) 

@@ -1363,7 +1408,7 @@ repTySyn (MkC nm) (MkC _) (Just (MkC tys)) (MkC 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]
 
 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.Name] 
+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) 
          -> Core [TH.FunDep] -> Core [TH.DecQ] 
          -> DsM (Core TH.DecQ)
 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) 

@@ -1380,10 +1425,16 @@ repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.InlineSpecQ
 repPragSpecInl (MkC nm) (MkC ty) (MkC ispec) 
   = rep2 pragSpecInlDName [nm, ty, ispec]
 
 repPragSpecInl (MkC nm) (MkC ty) (MkC ispec) 
   = rep2 pragSpecInlDName [nm, ty, ispec]
 

-repFamily :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.Name] 
-          -> DsM (Core TH.DecQ)
-repFamily (MkC flav) (MkC nm) (MkC tvs)
-    = rep2 familyDName [flav, nm, tvs]
+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] 
+              -> 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) 
 
 repInlineSpecNoPhase :: Core Bool -> Core Bool -> DsM (Core TH.InlineSpecQ)
 repInlineSpecNoPhase (MkC inline) (MkC conlike) 

@@ -1429,7 +1480,8 @@ repConstr con (InfixCon st1 st2)
 
 ------------ Types -------------------
 
 
 ------------ Types -------------------
 

-repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (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]
 
 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
     = rep2 forallTName [tvars, ctxt, ty]
 

@@ -1437,12 +1489,15 @@ repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
 repTvar (MkC s) = rep2 varTName [s]
 
 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
 repTvar (MkC s) = rep2 varTName [s]
 
 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)

-repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2]
+repTapp (MkC t1) (MkC t2) = rep2 appTName [t1, t2]

 
 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
 repTapps f []     = return f
 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
 
 
 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
 repTapps f []     = return f
 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]
+

 --------- Type constructors --------------
 
 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
 --------- Type constructors --------------
 
 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)

@@ -1458,6 +1513,19 @@ repArrowTyCon = rep2 arrowTName []
 repListTyCon :: DsM (Core TH.TypeQ)
 repListTyCon = rep2 listTName []
 
 repListTyCon :: DsM (Core TH.TypeQ)
 repListTyCon = rep2 listTName []
 

+------------ Kinds -------------------
+
+repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndr)
+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 []
+
+repArrowK :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind)
+repArrowK (MkC ki1) (MkC ki2) = rep2 arrowKName [ki1, ki2]

 
 ----------------------------------------------------------
 --             Literals
 
 ----------------------------------------------------------
 --             Literals

@@ -1588,7 +1656,7 @@ templateHaskellNames = [
     charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
     floatPrimLName, doublePrimLName, rationalLName,
     -- Pat
     charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
     floatPrimLName, doublePrimLName, rationalLName,
     -- Pat

-    litPName, varPName, tupPName, conPName, tildePName, infixPName,
+    litPName, varPName, tupPName, conPName, tildePName, bangPName, infixPName,

     asPName, wildPName, recPName, listPName, sigPName,
     -- FieldPat
     fieldPatName,
     asPName, wildPName, recPName, listPName, sigPName,
     -- FieldPat
     fieldPatName,

@@ -1614,7 +1682,8 @@ templateHaskellNames = [
     funDName, valDName, dataDName, newtypeDName, tySynDName,
     classDName, instanceDName, sigDName, forImpDName, 
     pragInlDName, pragSpecDName, pragSpecInlDName,
     funDName, valDName, dataDName, newtypeDName, tySynDName,
     classDName, instanceDName, sigDName, forImpDName, 
     pragInlDName, pragSpecDName, pragSpecInlDName,

-    familyDName, dataInstDName, newtypeInstDName, tySynInstDName,
+    familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
+    tySynInstDName, 

     -- Cxt
     cxtName,
     -- Pred
     -- Cxt
     cxtName,
     -- Pred

@@ -1629,7 +1698,11 @@ templateHaskellNames = [
     varStrictTypeName,
     -- Type
     forallTName, varTName, conTName, appTName,
     varStrictTypeName,
     -- Type
     forallTName, varTName, conTName, appTName,

-    tupleTName, arrowTName, listTName,
+    tupleTName, arrowTName, listTName, sigTName,
+    -- TyVarBndr
+    plainTVName, kindedTVName,
+    -- Kind
+    starKName, arrowKName,

     -- Callconv
     cCallName, stdCallName,
     -- Safety
     -- Callconv
     cCallName, stdCallName,
     -- Safety

@@ -1648,8 +1721,9 @@ templateHaskellNames = [
     clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
     stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName,
     varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
     clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
     stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName,
     varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,

-    typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
-    fieldPatQTyConName, fieldExpQTyConName, funDepTyConName, predQTyConName,
+    typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
+    patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
+    predQTyConName, 

 
     -- Quasiquoting
     quoteExpName, quotePatName]
 
     -- Quasiquoting
     quoteExpName, quotePatName]

@@ -1672,7 +1746,8 @@ qqFun  = mk_known_key_name OccName.varName qqLib
 -------------------- TH.Syntax -----------------------
 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
     fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
 -------------------- TH.Syntax -----------------------
 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
     fieldPatTyConName, expTyConName, decTyConName, typeTyConName,

-    matchTyConName, clauseTyConName, funDepTyConName, predTyConName :: Name
+    tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
+    predTyConName :: Name 

 qTyConName        = thTc (fsLit "Q")            qTyConKey
 nameTyConName     = thTc (fsLit "Name")         nameTyConKey
 fieldExpTyConName = thTc (fsLit "FieldExp")     fieldExpTyConKey
 qTyConName        = thTc (fsLit "Q")            qTyConKey
 nameTyConName     = thTc (fsLit "Name")         nameTyConKey
 fieldExpTyConName = thTc (fsLit "FieldExp")     fieldExpTyConKey

@@ -1681,6 +1756,7 @@ fieldPatTyConName = thTc (fsLit "FieldPat")     fieldPatTyConKey
 expTyConName      = thTc (fsLit "Exp")          expTyConKey
 decTyConName      = thTc (fsLit "Dec")          decTyConKey
 typeTyConName     = thTc (fsLit "Type")         typeTyConKey
 expTyConName      = thTc (fsLit "Exp")          expTyConKey
 decTyConName      = thTc (fsLit "Dec")          decTyConKey
 typeTyConName     = thTc (fsLit "Type")         typeTyConKey

+tyVarBndrTyConName= thTc (fsLit "TyVarBndr")    tyVarBndrTyConKey

 matchTyConName    = thTc (fsLit "Match")        matchTyConKey
 clauseTyConName   = thTc (fsLit "Clause")       clauseTyConKey
 funDepTyConName   = thTc (fsLit "FunDep")       funDepTyConKey
 matchTyConName    = thTc (fsLit "Match")        matchTyConKey
 clauseTyConName   = thTc (fsLit "Clause")       clauseTyConKey
 funDepTyConName   = thTc (fsLit "FunDep")       funDepTyConKey

@@ -1688,12 +1764,13 @@ predTyConName     = thTc (fsLit "Pred")         predTyConKey
 
 returnQName, bindQName, sequenceQName, newNameName, liftName,
     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
 
 returnQName, bindQName, sequenceQName, newNameName, liftName,
     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,

-    mkNameLName :: Name
-returnQName   = thFun (fsLit "returnQ")   returnQIdKey
-bindQName     = thFun (fsLit "bindQ")     bindQIdKey
-sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
+    mkNameLName, liftStringName :: Name
+returnQName    = thFun (fsLit "returnQ")   returnQIdKey
+bindQName      = thFun (fsLit "bindQ")     bindQIdKey
+sequenceQName  = thFun (fsLit "sequenceQ") sequenceQIdKey

 newNameName    = thFun (fsLit "newName")   newNameIdKey
 newNameName    = thFun (fsLit "newName")   newNameIdKey

-liftName      = thFun (fsLit "lift")      liftIdKey
+liftName       = thFun (fsLit "lift")      liftIdKey
+liftStringName = thFun (fsLit "liftString")  liftStringIdKey

 mkNameName     = thFun (fsLit "mkName")     mkNameIdKey
 mkNameG_vName  = thFun (fsLit "mkNameG_v")  mkNameG_vIdKey
 mkNameG_dName  = thFun (fsLit "mkNameG_d")  mkNameG_dIdKey
 mkNameName     = thFun (fsLit "mkName")     mkNameIdKey
 mkNameG_vName  = thFun (fsLit "mkNameG_v")  mkNameG_vIdKey
 mkNameG_dName  = thFun (fsLit "mkNameG_d")  mkNameG_dIdKey

@@ -1715,7 +1792,7 @@ doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
 rationalLName   = libFun (fsLit "rationalL")     rationalLIdKey
 
 -- data Pat = ...
 rationalLName   = libFun (fsLit "rationalL")     rationalLIdKey
 
 -- data Pat = ...

-litPName, varPName, tupPName, conPName, infixPName, tildePName,
+litPName, varPName, tupPName, conPName, infixPName, tildePName, bangPName,

     asPName, wildPName, recPName, listPName, sigPName :: Name
 litPName   = libFun (fsLit "litP")   litPIdKey
 varPName   = libFun (fsLit "varP")   varPIdKey
     asPName, wildPName, recPName, listPName, sigPName :: Name
 litPName   = libFun (fsLit "litP")   litPIdKey
 varPName   = libFun (fsLit "varP")   varPIdKey

@@ -1723,6 +1800,7 @@ tupPName   = libFun (fsLit "tupP")   tupPIdKey
 conPName   = libFun (fsLit "conP")   conPIdKey
 infixPName = libFun (fsLit "infixP") infixPIdKey
 tildePName = libFun (fsLit "tildeP") tildePIdKey
 conPName   = libFun (fsLit "conP")   conPIdKey
 infixPName = libFun (fsLit "infixP") infixPIdKey
 tildePName = libFun (fsLit "tildeP") tildePIdKey

+bangPName  = libFun (fsLit "bangP")  bangPIdKey

 asPName    = libFun (fsLit "asP")    asPIdKey
 wildPName  = libFun (fsLit "wildP")  wildPIdKey
 recPName   = libFun (fsLit "recP")   recPIdKey
 asPName    = libFun (fsLit "asP")    asPIdKey
 wildPName  = libFun (fsLit "wildP")  wildPIdKey
 recPName   = libFun (fsLit "recP")   recPIdKey

@@ -1797,8 +1875,8 @@ parSName    = libFun (fsLit "parS")    parSIdKey
 -- data Dec = ...
 funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
     instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
 -- data Dec = ...
 funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
     instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,

-    pragSpecInlDName, familyDName, dataInstDName, newtypeInstDName, 
-    tySynInstDName :: Name
+    pragSpecInlDName, familyNoKindDName, familyKindDName, dataInstDName,
+    newtypeInstDName, tySynInstDName :: Name

 funDName         = libFun (fsLit "funD")         funDIdKey
 valDName         = libFun (fsLit "valD")         valDIdKey
 dataDName        = libFun (fsLit "dataD")        dataDIdKey
 funDName         = libFun (fsLit "funD")         funDIdKey
 valDName         = libFun (fsLit "valD")         valDIdKey
 dataDName        = libFun (fsLit "dataD")        dataDIdKey

@@ -1811,7 +1889,8 @@ forImpDName      = libFun (fsLit "forImpD")      forImpDIdKey
 pragInlDName     = libFun (fsLit "pragInlD")     pragInlDIdKey
 pragSpecDName    = libFun (fsLit "pragSpecD")    pragSpecDIdKey
 pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey
 pragInlDName     = libFun (fsLit "pragInlD")     pragInlDIdKey
 pragSpecDName    = libFun (fsLit "pragSpecD")    pragSpecDIdKey
 pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey

-familyDName      = libFun (fsLit "familyD")      familyDIdKey
+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
 dataInstDName    = libFun (fsLit "dataInstD")    dataInstDIdKey
 newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
 tySynInstDName   = libFun (fsLit "tySynInstD")   tySynInstDIdKey

@@ -1847,14 +1926,25 @@ varStrictTypeName = libFun  (fsLit "varStrictType") varStrictTKey
 
 -- data Type = ...
 forallTName, varTName, conTName, tupleTName, arrowTName,
 
 -- data Type = ...
 forallTName, varTName, conTName, tupleTName, arrowTName,

-    listTName, appTName :: Name
+    listTName, appTName, sigTName :: Name

 forallTName = libFun (fsLit "forallT") forallTIdKey
 varTName    = libFun (fsLit "varT")    varTIdKey
 conTName    = libFun (fsLit "conT")    conTIdKey
 forallTName = libFun (fsLit "forallT") forallTIdKey
 varTName    = libFun (fsLit "varT")    varTIdKey
 conTName    = libFun (fsLit "conT")    conTIdKey

-tupleTName  = libFun (fsLit "tupleT") tupleTIdKey
-arrowTName  = libFun (fsLit "arrowT") arrowTIdKey
-listTName   = libFun (fsLit "listT")  listTIdKey
+tupleTName  = libFun (fsLit "tupleT")  tupleTIdKey
+arrowTName  = libFun (fsLit "arrowT")  arrowTIdKey
+listTName   = libFun (fsLit "listT")   listTIdKey

 appTName    = libFun (fsLit "appT")    appTIdKey
 appTName    = libFun (fsLit "appT")    appTIdKey

+sigTName    = libFun (fsLit "sigT")    sigTIdKey
+
+-- data TyVarBndr = ...
+plainTVName, kindedTVName :: Name
+plainTVName  = libFun (fsLit "plainTV")  plainTVIdKey
+kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
+
+-- data Kind = ...
+starKName, arrowKName :: Name
+starKName  = libFun (fsLit "starK")   starKIdKey
+arrowKName = libFun (fsLit "arrowK")  arrowKIdKey

 
 -- data Callconv = ...
 cCallName, stdCallName :: Name
 
 -- data Callconv = ...
 cCallName, stdCallName :: Name

@@ -1909,7 +1999,7 @@ quotePatName          = qqFun (fsLit "quotePat") quotePatKey
 
 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
     decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,
 
 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
     decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,

-    stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey,
+    stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, tyVarBndrTyConKey,

     decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
     fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
     fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
     decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
     fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
     fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,

@@ -1927,6 +2017,7 @@ stmtQTyConKey           = mkPreludeTyConUnique 109
 conQTyConKey            = mkPreludeTyConUnique 110
 typeQTyConKey           = mkPreludeTyConUnique 111
 typeTyConKey            = mkPreludeTyConUnique 112
 conQTyConKey            = mkPreludeTyConUnique 110
 typeQTyConKey           = mkPreludeTyConUnique 111
 typeTyConKey            = mkPreludeTyConUnique 112

+tyVarBndrTyConKey       = mkPreludeTyConUnique 125

 decTyConKey             = mkPreludeTyConUnique 113
 varStrictTypeQTyConKey  = mkPreludeTyConUnique 114
 strictTypeQTyConKey     = mkPreludeTyConUnique 115
 decTyConKey             = mkPreludeTyConUnique 113
 varStrictTypeQTyConKey  = mkPreludeTyConUnique 114
 strictTypeQTyConKey     = mkPreludeTyConUnique 115

@@ -1970,8 +2061,11 @@ floatPrimLIdKey   = mkPreludeMiscIdUnique 215
 doublePrimLIdKey  = mkPreludeMiscIdUnique 216
 rationalLIdKey    = mkPreludeMiscIdUnique 217
 
 doublePrimLIdKey  = mkPreludeMiscIdUnique 216
 rationalLIdKey    = mkPreludeMiscIdUnique 217
 

+liftStringIdKey :: Unique
+liftStringIdKey     = mkPreludeMiscIdUnique 218
+

 -- data Pat = ...
 -- data Pat = ...

-litPIdKey, varPIdKey, tupPIdKey, conPIdKey, infixPIdKey, tildePIdKey,
+litPIdKey, varPIdKey, tupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey,

     asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey :: Unique
 litPIdKey         = mkPreludeMiscIdUnique 220
 varPIdKey         = mkPreludeMiscIdUnique 221
     asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey :: Unique
 litPIdKey         = mkPreludeMiscIdUnique 220
 varPIdKey         = mkPreludeMiscIdUnique 221

@@ -1979,6 +2073,7 @@ tupPIdKey         = mkPreludeMiscIdUnique 222
 conPIdKey         = mkPreludeMiscIdUnique 223
 infixPIdKey       = mkPreludeMiscIdUnique 312
 tildePIdKey       = mkPreludeMiscIdUnique 224
 conPIdKey         = mkPreludeMiscIdUnique 223
 infixPIdKey       = mkPreludeMiscIdUnique 312
 tildePIdKey       = mkPreludeMiscIdUnique 224

+bangPIdKey        = mkPreludeMiscIdUnique 359

 asPIdKey          = mkPreludeMiscIdUnique 225
 wildPIdKey        = mkPreludeMiscIdUnique 226
 recPIdKey         = mkPreludeMiscIdUnique 227
 asPIdKey          = mkPreludeMiscIdUnique 225
 wildPIdKey        = mkPreludeMiscIdUnique 226
 recPIdKey         = mkPreludeMiscIdUnique 227

@@ -1997,6 +2092,7 @@ matchIdKey          = mkPreludeMiscIdUnique 231
 clauseIdKey :: Unique
 clauseIdKey         = mkPreludeMiscIdUnique 232
 
 clauseIdKey :: Unique
 clauseIdKey         = mkPreludeMiscIdUnique 232
 

+

 -- data Exp = ...
 varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
     sectionLIdKey, sectionRIdKey, lamEIdKey, tupEIdKey, condEIdKey,
 -- data Exp = ...
 varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
     sectionLIdKey, sectionRIdKey, lamEIdKey, tupEIdKey, condEIdKey,

@@ -2051,8 +2147,8 @@ parSIdKey        = mkPreludeMiscIdUnique 271
 -- data Dec = ...
 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
     classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
 -- data Dec = ...
 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
     classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,

-    pragSpecDIdKey, pragSpecInlDIdKey, familyDIdKey, dataInstDIdKey,
-    newtypeInstDIdKey, tySynInstDIdKey :: Unique 
+    pragSpecDIdKey, pragSpecInlDIdKey, familyNoKindDIdKey, familyKindDIdKey,
+    dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey :: Unique 

 funDIdKey         = mkPreludeMiscIdUnique 272
 valDIdKey         = mkPreludeMiscIdUnique 273
 dataDIdKey        = mkPreludeMiscIdUnique 274
 funDIdKey         = mkPreludeMiscIdUnique 272
 valDIdKey         = mkPreludeMiscIdUnique 273
 dataDIdKey        = mkPreludeMiscIdUnique 274

@@ -2065,7 +2161,8 @@ forImpDIdKey      = mkPreludeMiscIdUnique 297
 pragInlDIdKey     = mkPreludeMiscIdUnique 348
 pragSpecDIdKey    = mkPreludeMiscIdUnique 349
 pragSpecInlDIdKey = mkPreludeMiscIdUnique 352
 pragInlDIdKey     = mkPreludeMiscIdUnique 348
 pragSpecDIdKey    = mkPreludeMiscIdUnique 349
 pragSpecInlDIdKey = mkPreludeMiscIdUnique 352

-familyDIdKey      = mkPreludeMiscIdUnique 340
+familyNoKindDIdKey= mkPreludeMiscIdUnique 340
+familyKindDIdKey  = mkPreludeMiscIdUnique 353

 dataInstDIdKey    = mkPreludeMiscIdUnique 341
 newtypeInstDIdKey = mkPreludeMiscIdUnique 342
 tySynInstDIdKey   = mkPreludeMiscIdUnique 343
 dataInstDIdKey    = mkPreludeMiscIdUnique 341
 newtypeInstDIdKey = mkPreludeMiscIdUnique 342
 tySynInstDIdKey   = mkPreludeMiscIdUnique 343

@@ -2101,7 +2198,7 @@ varStrictTKey     = mkPreludeMiscIdUnique 287
 
 -- data Type = ...
 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, arrowTIdKey,
 
 -- data Type = ...
 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, arrowTIdKey,

-    listTIdKey, appTIdKey :: Unique
+    listTIdKey, appTIdKey, sigTIdKey :: Unique

 forallTIdKey      = mkPreludeMiscIdUnique 290
 varTIdKey         = mkPreludeMiscIdUnique 291
 conTIdKey         = mkPreludeMiscIdUnique 292
 forallTIdKey      = mkPreludeMiscIdUnique 290
 varTIdKey         = mkPreludeMiscIdUnique 291
 conTIdKey         = mkPreludeMiscIdUnique 292

@@ -2109,6 +2206,17 @@ tupleTIdKey       = mkPreludeMiscIdUnique 294
 arrowTIdKey       = mkPreludeMiscIdUnique 295
 listTIdKey        = mkPreludeMiscIdUnique 296
 appTIdKey         = mkPreludeMiscIdUnique 293
 arrowTIdKey       = mkPreludeMiscIdUnique 295
 listTIdKey        = mkPreludeMiscIdUnique 296
 appTIdKey         = mkPreludeMiscIdUnique 293

+sigTIdKey         = mkPreludeMiscIdUnique 358
+
+-- data TyVarBndr = ...
+plainTVIdKey, kindedTVIdKey :: Unique
+plainTVIdKey      = mkPreludeMiscIdUnique 354
+kindedTVIdKey     = mkPreludeMiscIdUnique 355
+
+-- data Kind = ...
+starKIdKey, arrowKIdKey :: Unique
+starKIdKey        = mkPreludeMiscIdUnique 356
+arrowKIdKey       = mkPreludeMiscIdUnique 357

 
 -- data Callconv = ...
 cCallIdKey, stdCallIdKey :: Unique
 
 -- data Callconv = ...
 cCallIdKey, stdCallIdKey :: Unique