Refactor LHsTyVarBndrs to fix Trac #6081

This is really a small change, but it touches a lot of files quite
significantly. The real goal is to put the implicitly-bound kind
variables of a data/class decl in the right place, namely on the
LHsTyVarBndrs type, which now looks like

  data LHsTyVarBndrs name
    = HsQTvs { hsq_kvs :: [Name]
             , hsq_tvs :: [LHsTyVarBndr name]
      }

This little change made the type checker neater in a number of
ways, but it was fiddly to push through the changes.

3 files changed, 22 insertions, 21 deletions

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index a9cb1d34b7..759d5449f9 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -728,9 +728,9 @@ data_or_newtype :: { Located NewOrData }
         : 'data'        { L1 DataType }
         | 'newtype'     { L1 NewType }
 
-opt_kind_sig :: { Located (Maybe (HsBndrSig (LHsKind RdrName))) }
+opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) }
         :                               { noLoc Nothing }
-        | '::' kind                     { LL (Just (mkHsBSig $2)) }
+        | '::' kind                     { LL (Just $2) }
 
 -- tycl_hdr parses the header of a class or data type decl,
 -- which takes the form
@@ -877,7 +877,7 @@ rule_var_list :: { [RuleBndr RdrName] }
 
 rule_var :: { RuleBndr RdrName }
         : varid                                 { RuleBndr $1 }
-        | '(' varid '::' ctype ')'              { RuleBndrSig $2 (mkHsBSig $4) }
+        | '(' varid '::' ctype ')'              { RuleBndrSig $2 (mkHsWithBndrs $4) }
 
 -----------------------------------------------------------------------------
 -- Warnings and deprecations (c.f. rules)
@@ -1113,7 +1113,7 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] }
 
 tv_bndr :: { LHsTyVarBndr RdrName }
         : tyvar                         { L1 (UserTyVar (unLoc $1)) }
-        | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) (mkHsBSig $4)) }
+        | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) $4) }
 
 fds :: { Located [Located (FunDep RdrName)] }
         : {- empty -}                   { noLoc [] }
diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
index eee8831065..0382fcae7d 100644
--- a/compiler/parser/ParserCore.y
+++ b/compiler/parser/ParserCore.y
@@ -128,14 +128,14 @@ tdefs	:: { [TyClDecl RdrName] }
 tdef	:: { TyClDecl RdrName }
 	: '%data' q_tc_name tv_bndrs '=' '{' cons '}' ';'
 	{ TyDecl { tcdLName = noLoc (ifaceExtRdrName $2)
-                 , tcdTyVars = map toHsTvBndr $3
+                 , tcdTyVars = mkHsQTvs (map toHsTvBndr $3)
                  , tcdTyDefn = TyData { td_ND = DataType, td_ctxt = noLoc [] 
      	                              , td_kindSig = Nothing
                                       , td_cons = $6, td_derivs = Nothing } } }
 	| '%newtype' q_tc_name tv_bndrs trep ';'
 	{ let tc_rdr = ifaceExtRdrName $2 in
           TyDecl { tcdLName = noLoc tc_rdr
-		 , tcdTyVars = map toHsTvBndr $3
+	         , tcdTyVars = mkHsQTvs (map toHsTvBndr $3)
                  , tcdTyDefn = TyData { td_ND = NewType, td_ctxt = noLoc []
 		                      , td_kindSig = Nothing
                                       , td_cons = $4 (rdrNameOcc tc_rdr), td_derivs = Nothing } } }
@@ -377,16 +377,16 @@ ifaceArrow ifT1 ifT2 = IfaceFunTy ifT1 ifT2
 toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName
 toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOccFS tv)) bsig
                   where
-                    bsig = mkHsBSig (toHsKind k)
+                    bsig = toHsKind k
 
 ifaceExtRdrName :: Name -> RdrName
 ifaceExtRdrName name = mkOrig (nameModule name) (nameOccName name)
 ifaceExtRdrName other = pprPanic "ParserCore.ifaceExtRdrName" (ppr other)
 
 add_forall tv (L _ (HsForAllTy exp tvs cxt t))
-  = noLoc $ HsForAllTy exp (tv:tvs) cxt t
+  = noLoc $ HsForAllTy exp (mkHsQTvs (tv : hsQTvBndrs tvs)) cxt t
 add_forall tv t
-  = noLoc $ HsForAllTy Explicit [tv] (noLoc []) t
+  = noLoc $ HsForAllTy Explicit (mkHsQTvs [tv]) (noLoc []) t
   
 happyError :: P a 
 happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 95b65de192..350aedb6f0 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -122,7 +122,7 @@ mkTyData :: SrcSpan
          -> NewOrData
          -> Maybe CType
          -> Located (Maybe (LHsContext RdrName), LHsType RdrName)
-         -> Maybe (HsBndrSig (LHsKind RdrName))
+         -> Maybe (LHsKind RdrName)
          -> [LConDecl RdrName]
          -> Maybe [LHsType RdrName]
          -> P (LTyClDecl RdrName)
@@ -138,20 +138,20 @@ mkFamInstData :: SrcSpan
          -> NewOrData
          -> Maybe CType
          -> Located (Maybe (LHsContext RdrName), LHsType RdrName)
-         -> Maybe (HsBndrSig (LHsKind RdrName))
+         -> Maybe (LHsKind RdrName)
          -> [LConDecl RdrName]
          -> Maybe [LHsType RdrName]
          -> P (LFamInstDecl RdrName)
 mkFamInstData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
   = do { (tc, tparams) <- checkTyClHdr tycl_hdr
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
-       ; return (L loc (FamInstDecl { fid_tycon = tc, fid_pats = mkHsBSig tparams
+       ; return (L loc (FamInstDecl { fid_tycon = tc, fid_pats = mkHsWithBndrs tparams
                                     , fid_defn = defn, fid_fvs = placeHolderNames })) }
 
 mkDataDefn :: NewOrData
            -> Maybe CType
            -> Maybe (LHsContext RdrName)
-           -> Maybe (HsBndrSig (LHsKind RdrName))
+           -> Maybe (LHsKind RdrName)
            -> [LConDecl RdrName]
            -> Maybe [LHsType RdrName]
            -> P (HsTyDefn RdrName)
@@ -181,14 +181,14 @@ mkFamInstSynonym :: SrcSpan
             -> P (LFamInstDecl RdrName)
 mkFamInstSynonym loc lhs rhs
   = do { (tc, tparams) <- checkTyClHdr lhs
-       ; return (L loc (FamInstDecl { fid_tycon = tc, fid_pats = mkHsBSig tparams
+       ; return (L loc (FamInstDecl { fid_tycon = tc, fid_pats = mkHsWithBndrs tparams
                                     , fid_defn = TySynonym { td_synRhs = rhs }
                                     , fid_fvs = placeHolderNames })) }
 
 mkTyFamily :: SrcSpan
            -> FamilyFlavour
            -> LHsType RdrName   -- LHS
-           -> Maybe (HsBndrSig (LHsKind RdrName)) -- Optional kind signature
+           -> Maybe (LHsKind RdrName) -- Optional kind signature
            -> P (LTyClDecl RdrName)
 mkTyFamily loc flavour lhs ksig
   = do { (tc, tparams) <- checkTyClHdr lhs
@@ -367,7 +367,7 @@ mkDeprecatedGadtRecordDecl loc (L con_loc con) flds res_ty
        ; return (L loc (ConDecl { con_old_rec  = True
                                 , con_name     = data_con
                                 , con_explicit = Implicit
-                                , con_qvars    = []
+                                , con_qvars    = mkHsQTvs []
                                 , con_cxt      = noLoc []
                                 , con_details  = RecCon flds
                                 , con_res      = ResTyGADT res_ty
@@ -381,7 +381,7 @@ mkSimpleConDecl name qvars cxt details
   = ConDecl { con_old_rec  = False
             , con_name     = name
             , con_explicit = Explicit
-            , con_qvars    = qvars
+            , con_qvars    = mkHsQTvs qvars
             , con_cxt      = cxt
             , con_details  = details
             , con_res      = ResTyH98
@@ -444,17 +444,18 @@ we can bring x,y into scope.  So:
    * For RecCon we do not
 
 \begin{code}
-checkTyVars :: LHsType RdrName -> [LHsType RdrName] -> P [LHsTyVarBndr RdrName]
+checkTyVars :: LHsType RdrName -> [LHsType RdrName] -> P (LHsTyVarBndrs RdrName)
 -- Check whether the given list of type parameters are all type variables
 -- (possibly with a kind signature).  If the second argument is `False',
 -- only type variables are allowed and we raise an error on encountering a
 -- non-variable; otherwise, we allow non-variable arguments and return the
 -- entire list of parameters.
-checkTyVars tycl_hdr tparms = mapM chk tparms
+checkTyVars tycl_hdr tparms = do { tvs <- mapM chk tparms
+                                 ; return (mkHsQTvs tvs) }
   where
         -- Check that the name space is correct!
     chk (L l (HsKindSig (L _ (HsTyVar tv)) k))
-        | isRdrTyVar tv    = return (L l (KindedTyVar tv (mkHsBSig k)))
+        | isRdrTyVar tv    = return (L l (KindedTyVar tv k))
     chk (L l (HsTyVar tv))
         | isRdrTyVar tv    = return (L l (UserTyVar tv))
     chk t@(L l _)
@@ -579,7 +580,7 @@ checkAPat dynflags loc e0 = case e0 of
                             let t' = case t of
                                        L _ (HsForAllTy Implicit _ (L _ []) ty) -> ty
                                        other -> other
-                            return (SigPatIn e (mkHsBSig t'))
+                            return (SigPatIn e (mkHsWithBndrs t'))
 
    -- n+k patterns
    OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _