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.

5 files changed, 97 insertions, 92 deletions

diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 7e8ceb6695..8d5ad6b4f0 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -275,7 +275,7 @@ cvt_ci_decs doc decs
 cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr]
              -> CvtM ( LHsContext RdrName
                      , Located RdrName
-                     , [LHsTyVarBndr RdrName])
+                     , LHsTyVarBndrs RdrName)
 cvt_tycl_hdr cxt tc tvs
   = do { cxt' <- cvtContext cxt
        ; tc'  <- tconNameL tc
@@ -286,12 +286,12 @@ cvt_tycl_hdr cxt tc tvs
 cvt_tyinst_hdr :: TH.Cxt -> TH.Name -> [TH.Type]
                -> CvtM ( LHsContext RdrName
                        , Located RdrName
-                       , HsBndrSig [LHsType RdrName])
+                       , HsWithBndrs [LHsType RdrName])
 cvt_tyinst_hdr cxt tc tys
   = do { cxt' <- cvtContext cxt
        ; tc'  <- tconNameL tc
        ; tys' <- mapM cvtType tys
-       ; return (cxt', tc', mkHsBSig tys') }
+       ; return (cxt', tc', mkHsWithBndrs tys') }
 
 -------------------------------------------------------------------
 --		Partitioning declarations
@@ -348,7 +348,7 @@ cvtConstr (ForallC tvs ctxt con)
   = do	{ tvs'  <- cvtTvs tvs
 	; L loc ctxt' <- cvtContext ctxt
 	; L _ con' <- cvtConstr con
-	; returnL $ con' { con_qvars = tvs' ++ con_qvars con'
+	; returnL $ con' { con_qvars = mkHsQTvs (hsQTvBndrs tvs' ++ hsQTvBndrs (con_qvars con'))
                          , con_cxt = L loc (ctxt' ++ (unLoc $ con_cxt con')) } }
 
 cvt_arg :: (TH.Strict, TH.Type) -> CvtM (LHsType RdrName)
@@ -759,7 +759,7 @@ cvtp (RecP c fs)       = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
 		       	    ; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) }
 cvtp (ListP ps)        = do { ps' <- cvtPats ps; return $ ListPat ps' void }
 cvtp (SigP p t)        = do { p' <- cvtPat p; t' <- cvtType t
-                            ; return $ SigPatIn p' (mkHsBSig t') }
+                            ; return $ SigPatIn p' (mkHsWithBndrs t') }
 cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void }
 
 cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (HsRecField RdrName (LPat RdrName))
@@ -784,8 +784,8 @@ cvtOpAppP x op y
 -----------------------------------------------------------
 --	Types and type variables
 
-cvtTvs :: [TH.TyVarBndr] -> CvtM [LHsTyVarBndr RdrName]
-cvtTvs tvs = mapM cvt_tv tvs
+cvtTvs :: [TH.TyVarBndr] -> CvtM (LHsTyVarBndrs RdrName)
+cvtTvs tvs = do { tvs' <- mapM cvt_tv tvs; return (mkHsQTvs tvs') }
 
 cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr RdrName)
 cvt_tv (TH.PlainTV nm) 
@@ -794,7 +794,7 @@ cvt_tv (TH.PlainTV nm)
 cvt_tv (TH.KindedTV nm ki) 
   = do { nm' <- tName nm
        ; ki' <- cvtKind ki
-       ; returnL $ KindedTyVar nm' (mkHsBSig ki') }
+       ; returnL $ KindedTyVar nm' ki' }
 
 cvtContext :: TH.Cxt -> CvtM (LHsContext RdrName)
 cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' }
@@ -845,7 +845,7 @@ cvtType ty
              -> do { tvs' <- cvtTvs tvs
                    ; cxt' <- cvtContext cxt
                    ; ty'  <- cvtType ty
-                   ; returnL $ mkExplicitHsForAllTy tvs' cxt' ty' 
+                   ; returnL $ mkExplicitHsForAllTy (hsQTvBndrs tvs') cxt' ty' 
                    }
 
            SigT ty ki
@@ -875,10 +875,10 @@ cvtKind (ArrowK k1 k2) = do
   k2' <- cvtKind k2
   returnL (HsFunTy k1' k2')
 
-cvtMaybeKind :: Maybe TH.Kind -> CvtM (Maybe (HsBndrSig (LHsKind RdrName)))
+cvtMaybeKind :: Maybe TH.Kind -> CvtM (Maybe (LHsKind RdrName))
 cvtMaybeKind Nothing = return Nothing
 cvtMaybeKind (Just ki) = do { ki' <- cvtKind ki
-                            ; return (Just (mkHsBSig ki')) }
+                            ; return (Just ki') }
 
 -----------------------------------------------------------
 cvtFixity :: TH.Fixity -> Hs.Fixity
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index c789a9efdc..cf1c2c9a8e 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -428,20 +428,20 @@ data TyClDecl name
   | -- | @type/data family T :: *->*@
     TyFamily {  tcdFlavour :: FamilyFlavour,             -- type or data
                 tcdLName   :: Located name,              -- type constructor
-                tcdTyVars  :: [LHsTyVarBndr name],       -- type variables
-                tcdKindSig :: Maybe (HsBndrSig (LHsKind name))  -- result kind
+                tcdTyVars  :: LHsTyVarBndrs name,        -- type variables
+                tcdKindSig :: Maybe (LHsKind name)       -- result kind
     }
 
 
   | -- | @type/data declaration
     TyDecl { tcdLName  :: Located name            -- ^ Type constructor
-           , tcdTyVars :: [LHsTyVarBndr name]
+           , tcdTyVars :: LHsTyVarBndrs name
            , tcdTyDefn :: HsTyDefn name
            , tcdFVs    :: NameSet }
 
   | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
                 tcdLName   :: Located name,             -- ^ Name of the class
-                tcdTyVars  :: [LHsTyVarBndr name],      -- ^ Class type variables
+                tcdTyVars  :: LHsTyVarBndrs name,       -- ^ Class type variables
                 tcdFDs     :: [Located (FunDep name)],  -- ^ Functional deps
                 tcdSigs    :: [LSig name],              -- ^ Methods' signatures
                 tcdMeths   :: LHsBinds name,            -- ^ Default methods
@@ -468,7 +468,7 @@ data HsTyDefn name   -- The payload of a type synonym or data type defn
     TyData { td_ND     :: NewOrData,
              td_ctxt   :: LHsContext name,           -- ^ Context
              td_cType  :: Maybe CType,
-             td_kindSig:: Maybe (HsBndrSig (LHsKind name)),
+             td_kindSig:: Maybe (LHsKind name),
                      -- ^ Optional kind signature.
                      --
                      -- @(Just k)@ for a GADT-style @data@, or @data
@@ -619,18 +619,18 @@ instance OutputableBndr name
 
 pp_vanilla_decl_head :: OutputableBndr name
    => Located name
-   -> [LHsTyVarBndr name]
+   -> LHsTyVarBndrs name
    -> HsContext name
    -> SDoc
 pp_vanilla_decl_head thing tyvars context
- = hsep [pprHsContext context, pprPrefixOcc (unLoc thing), interppSP tyvars]
+ = hsep [pprHsContext context, pprPrefixOcc (unLoc thing), ppr tyvars]
 
 pp_fam_inst_head :: OutputableBndr name
    => Located name
-   -> HsBndrSig [LHsType name]
+   -> HsWithBndrs [LHsType name]
    -> HsContext name
    -> SDoc
-pp_fam_inst_head thing (HsBSig typats _)  context -- explicit type patterns
+pp_fam_inst_head thing (HsWB { hswb_cts = typats }) context -- explicit type patterns
    = hsep [ ptext (sLit "instance"), pprHsContext context, pprPrefixOcc (unLoc thing)
           , hsep (map (pprParendHsType.unLoc) typats)]
 
@@ -660,8 +660,8 @@ pp_ty_defn pp_hdr (TyData { td_ND = new_or_data, td_ctxt = L _ context
        2 (pp_condecls condecls $$ pp_derivings)
   where
     pp_sig = case mb_sig of
-               Nothing              -> empty
-               Just (HsBSig kind _) -> dcolon <+> ppr kind
+               Nothing   -> empty
+               Just kind -> dcolon <+> ppr kind
     pp_derivings = case derivings of
                      Nothing -> empty
                      Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
@@ -715,7 +715,7 @@ data ConDecl name
     , con_explicit  :: HsExplicitFlag
         -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
 
-    , con_qvars     :: [LHsTyVarBndr name]
+    , con_qvars     :: LHsTyVarBndrs name
         -- ^ Type variables.  Depending on 'con_res' this describes the
         -- following entities
         --
@@ -808,8 +808,8 @@ type LFamInstDecl name = Located (FamInstDecl name)
 data FamInstDecl name 
   = FamInstDecl
        { fid_tycon :: Located name
-       , fid_pats  :: HsBndrSig [LHsType name]  -- ^ Type patterns (with bndrs)
-       , fid_defn  :: HsTyDefn name             -- Type or data family instance
+       , fid_pats  :: HsWithBndrs [LHsType name]  -- ^ Type patterns (with kind and type bndrs)
+       , fid_defn  :: HsTyDefn name               -- Type or data family instance
        , fid_fvs   :: NameSet  } 
   deriving( Typeable, Data )
 
@@ -1060,10 +1060,10 @@ data RuleDecl name
 
 data RuleBndr name
   = RuleBndr (Located name)
-  | RuleBndrSig (Located name) (HsBndrSig (LHsType name))
+  | RuleBndrSig (Located name) (HsWithBndrs (LHsType name))
   deriving (Data, Typeable)
 
-collectRuleBndrSigTys :: [RuleBndr name] -> [HsBndrSig (LHsType name)]
+collectRuleBndrSigTys :: [RuleBndr name] -> [HsWithBndrs (LHsType name)]
 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 
 instance OutputableBndr name => Outputable (RuleDecl name) where
diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs
index 1a5e206a54..64bda890db 100644
--- a/compiler/hsSyn/HsPat.lhs
+++ b/compiler/hsSyn/HsPat.lhs
@@ -131,8 +131,8 @@ data Pat id
                     (SyntaxExpr id)     -- Name of '-' (see RnEnv.lookupSyntaxName)
 
         ------------ Pattern type signatures ---------------
-  | SigPatIn        (LPat id)           -- Pattern with a type signature
-                    (HsBndrSig (LHsType id))
+  | SigPatIn        (LPat id)                   -- Pattern with a type signature
+                    (HsWithBndrs (LHsType id))  -- Signature can bind both kind and type vars
 
   | SigPatOut       (LPat id)           -- Pattern with a type signature
                     Type
diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index 9a6679a68e..2504ad892e 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -17,7 +17,9 @@ HsTypes: Abstract syntax: user-defined types
 
 module HsTypes (
         HsType(..), LHsType, HsKind, LHsKind,
-        HsBndrSig(..), HsTyVarBndr(..), LHsTyVarBndr,
+        HsTyVarBndr(..), LHsTyVarBndr, 
+        LHsTyVarBndrs(..),
+        HsWithBndrs(..),
         HsTupleSort(..), HsExplicitFlag(..),
         HsContext, LHsContext,
         HsQuasiQuote(..),
@@ -29,15 +31,14 @@ module HsTypes (
 
         ConDeclField(..), pprConDeclFields,
         
+        mkHsQTvs, hsQTvBndrs,
         mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
-        hsTyVarName, hsTyVarNames, 
+        hsTyVarName, hsTyVarNames, mkHsWithBndrs,
         hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
-        splitHsInstDeclTy_maybe, splitLHsInstDeclTy_maybe,
-        splitHsForAllTy, splitLHsForAllTy,
+        splitLHsInstDeclTy_maybe,
         splitHsClassTy_maybe, splitLHsClassTy_maybe,
         splitHsFunType,
         splitHsAppTys, mkHsAppTys, mkHsOpTy,
-        placeHolderBndrs,
 
         -- Printing
         pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context,
@@ -112,6 +113,17 @@ getBangStrictness _                    = HsNoBang
 
 This is the syntax for types as seen in type signatures.
 
+Note [HsBSig binder lists]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider a binder (or pattern) decoarated with a type or kind, 
+   \ (x :: a -> a). blah
+   forall (a :: k -> *) (b :: k). blah
+Then we use a LHsBndrSig on the binder, so that the
+renamer can decorate it with the variables bound
+by the pattern ('a' in the first example, 'k' in the second),
+assuming that neither of them is in scope already
+See also Note [Kind and type-variable binders] in RnTypes
+
 \begin{code}
 type LHsContext name = Located (HsContext name)
 
@@ -123,29 +135,29 @@ type LHsKind name = Located (HsKind name)
 
 type LHsTyVarBndr name = Located (HsTyVarBndr name)
 
-data HsBndrSig sig 
-  = HsBSig 
-       sig                -- The signature; typically a type
-       ([Name], [Name])   -- The *binding* (kind, type) names of 
-                          -- this signature
-                          -- See Note [HsBSig binder lists]
-                          
+data LHsTyVarBndrs name 
+  = HsQTvs { hsq_kvs :: [Name]                  -- Kind variables
+           , hsq_tvs :: [LHsTyVarBndr name]     -- Type variables
+             -- See Note [HsForAllTy tyvar binders]
+    }
+  deriving( Data, Typeable )
+
+mkHsQTvs :: [LHsTyVarBndr name] -> LHsTyVarBndrs name
+mkHsQTvs tvs = HsQTvs { hsq_kvs = panic "mkHsQTvs", hsq_tvs = tvs }
+
+hsQTvBndrs :: LHsTyVarBndrs name -> [LHsTyVarBndr name]
+hsQTvBndrs = hsq_tvs
+
+data HsWithBndrs thing
+  = HsWB { hswb_cts :: thing           -- Main payload (type or list of types)
+         , hswb_kvs :: [Name]         -- Kind vars
+         , hswb_tvs :: [Name]        -- Type vars
+    }                  
   deriving (Data, Typeable)
 
--- Note [HsBSig binder lists]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Consider a binder (or pattern) decoarated with a type or kind, 
---    \ (x :: a -> a). blah
---    forall (a :: k -> *) (b :: k). blah
--- Then we use a LHsBndrSig on the binder, so that the
--- renamer can decorate it with the variables bound
--- by the pattern ('a' in the first example, 'k' in the second),
--- assuming that neither of them is in scope already
--- See also Note [Kind and type-variable binders] in RnTypes
-
-placeHolderBndrs :: [Name]
--- Used for the NameSet in FunBind and PatBind prior to the renamer
-placeHolderBndrs = panic "placeHolderBndrs"
+mkHsWithBndrs :: thing -> HsWithBndrs thing
+mkHsWithBndrs x = HsWB { hswb_cts = x, hswb_kvs = panic "mkHsTyWithBndrs:kvs"
+                                     , hswb_tvs = panic "mkHsTyWithBndrs:tvs" }
 
 data HsTyVarBndr name
   = UserTyVar           -- No explicit kinding
@@ -153,17 +165,18 @@ data HsTyVarBndr name
 
   | KindedTyVar
          name
-         (HsBndrSig (LHsKind name))   -- The user-supplied kind signature
+         (LHsKind name)   -- The user-supplied kind signature
       --  *** NOTA BENE *** A "monotype" in a pragma can have
       -- for-alls in it, (mostly to do with dictionaries).  These
       -- must be explicitly Kinded.
   deriving (Data, Typeable)
 
+
 data HsType name
   = HsForAllTy  HsExplicitFlag          -- Renamer leaves this flag unchanged, to record the way
                                         -- the user wrote it originally, so that the printer can
                                         -- print it as the user wrote it
-                [LHsTyVarBndr name]     -- See Note [HsForAllTy tyvar binders]
+                (LHsTyVarBndrs name) 
                 (LHsContext name)
                 (LHsType name)
 
@@ -252,11 +265,11 @@ After renaming
   * Implicit => the *type* variables free in the type
     Explicit => the variables the user wrote (renamed)
 
-Note that in neither case do we inclde the kind variables.
-In the explicit case, the [HsTyVarBndr] can bring kind variables
-into scope:    f :: forall (a::k->*) (b::k). a b -> Int
-but we do not record them explicitly, similar to the case
-for the type variables in a pattern type signature.
+The kind variables bound in the hsq_kvs field come both
+  a) from the kind signatures on the kind vars (eg k1)
+  b) from the scope of the forall (eg k2)
+Example:   f :: forall (a::k1) b. T a (b::k2)
+
 
 Note [Unit tuples]
 ~~~~~~~~~~~~~~~~~~
@@ -357,19 +370,19 @@ data ConDeclField name  -- Record fields have Haddoc docs on them
 
 mkImplicitHsForAllTy ::                        LHsContext name -> LHsType name -> HsType name
 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
-mkImplicitHsForAllTy     ctxt ty = mkHsForAllTy Implicit [] ctxt ty
+mkImplicitHsForAllTy     ctxt ty = mkHsForAllTy Implicit []  ctxt ty
 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
 
 mkHsForAllTy :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
 -- Smart constructor for HsForAllTy
 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
-mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
+mkHsForAllTy exp tvs ctxt     ty = HsForAllTy exp (mkHsQTvs tvs) ctxt ty
 
 -- mk_forall_ty makes a pure for-all type (no context)
 mk_forall_ty :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsType name -> HsType name
-mk_forall_ty exp  tvs  (L _ (HsParTy ty))                   = mk_forall_ty exp tvs ty
-mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
-mk_forall_ty exp  tvs  ty                                   = HsForAllTy exp tvs (noLoc []) ty
+mk_forall_ty exp  tvs  (L _ (HsParTy ty))                    = mk_forall_ty exp tvs ty
+mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 qtvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ hsq_tvs qtvs2) ctxt ty
+mk_forall_ty exp  tvs  ty                                    = HsForAllTy exp (mkHsQTvs tvs) (noLoc []) ty
         -- Even if tvs is empty, we still make a HsForAll!
         -- In the Implicit case, this signals the place to do implicit quantification
         -- In the Explicit case, it prevents implicit quantification    
@@ -396,14 +409,14 @@ hsLTyVarName = hsTyVarName . unLoc
 hsTyVarNames :: [HsTyVarBndr name] -> [name]
 hsTyVarNames tvs = map hsTyVarName tvs
 
-hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
-hsLTyVarNames = map hsLTyVarName
+hsLTyVarNames :: LHsTyVarBndrs name -> [name]
+hsLTyVarNames qtvs = map hsLTyVarName (hsQTvBndrs qtvs)
 
 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
 hsLTyVarLocName = fmap hsTyVarName
 
-hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
-hsLTyVarLocNames = map hsLTyVarLocName
+hsLTyVarLocNames :: LHsTyVarBndrs name -> [Located name]
+hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvBndrs qtvs)
 \end{code}
 
 
@@ -421,31 +434,23 @@ mkHsAppTys fun_ty (arg_ty:arg_tys)
        -- Add noLocs for inner nodes of the application; 
        -- they are never used 
 
-splitHsInstDeclTy_maybe :: HsType name 
-                        -> Maybe ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
-splitHsInstDeclTy_maybe ty
-  = fmap (\(tvs, cxt, L _ n, tys) -> (tvs, cxt, n, tys)) $ splitLHsInstDeclTy_maybe (noLoc ty)
-
 splitLHsInstDeclTy_maybe
     :: LHsType name 
-    -> Maybe ([LHsTyVarBndr name], HsContext name, Located name, [LHsType name])
+    -> Maybe (LHsTyVarBndrs name, HsContext name, Located name, [LHsType name])
         -- Split up an instance decl type, returning the pieces
 splitLHsInstDeclTy_maybe inst_ty = do
     let (tvs, cxt, ty) = splitLHsForAllTy inst_ty
     (cls, tys) <- splitLHsClassTy_maybe ty
     return (tvs, cxt, cls, tys)
 
-splitHsForAllTy :: HsType name -> ([LHsTyVarBndr name], HsContext name, HsType name)
-splitHsForAllTy ty = case splitLHsForAllTy (noLoc ty) of (tvs, cxt, L _ ty) -> (tvs, cxt, ty)
-
 splitLHsForAllTy
     :: LHsType name 
-    -> ([LHsTyVarBndr name], HsContext name, LHsType name)
+    -> (LHsTyVarBndrs name, HsContext name, LHsType name)
 splitLHsForAllTy poly_ty
   = case unLoc poly_ty of
         HsParTy ty              -> splitLHsForAllTy ty
         HsForAllTy _ tvs cxt ty -> (tvs, unLoc cxt, ty)
-        _                       -> ([], [], poly_ty)
+        _                       -> (mkHsQTvs [], [], poly_ty)
         -- The type vars should have been computed by now, even if they were implicit
 
 splitHsClassTy_maybe :: HsType name -> Maybe (name, [LHsType name])
@@ -494,22 +499,25 @@ instance (OutputableBndr name) => Outputable (HsType name) where
 instance Outputable HsTyLit where
     ppr = ppr_tylit
 
-instance (Outputable sig) => Outputable (HsBndrSig sig) where
-    ppr (HsBSig ty _) = ppr ty
+instance (OutputableBndr name) => Outputable (LHsTyVarBndrs name) where
+    ppr qtvs = interppSP (hsQTvBndrs qtvs)
 
 instance (OutputableBndr name) => Outputable (HsTyVarBndr name) where
     ppr (UserTyVar name)        = ppr name
     ppr (KindedTyVar name kind) = parens $ hsep [ppr name, dcolon, ppr kind]
 
-pprHsForAll :: OutputableBndr name => HsExplicitFlag -> [LHsTyVarBndr name] ->  LHsContext name -> SDoc
-pprHsForAll exp tvs cxt 
+instance (Outputable thing) => Outputable (HsWithBndrs thing) where
+    ppr (HsWB { hswb_cts = ty }) = ppr ty
+
+pprHsForAll :: OutputableBndr name => HsExplicitFlag -> LHsTyVarBndrs name ->  LHsContext name -> SDoc
+pprHsForAll exp qtvs cxt 
   | show_forall = forall_part <+> pprHsContext (unLoc cxt)
   | otherwise   = pprHsContext (unLoc cxt)
   where
     show_forall =  opt_PprStyle_Debug
-                || (not (null tvs) && is_explicit)
+                || (not (null (hsQTvBndrs qtvs)) && is_explicit)
     is_explicit = case exp of {Explicit -> True; Implicit -> False}
-    forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
+    forall_part = ptext (sLit "forall") <+> ppr qtvs <> dot
 
 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
 pprHsContext []         = empty
diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 8ac04761fe..32fe487609 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -33,7 +33,7 @@ module HsUtils(
 
   nlHsTyApp, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps, 
   nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
-  mkLHsTupleExpr, mkLHsVarTuple, missingTupArg, mkHsBSig, 
+  mkLHsTupleExpr, mkLHsVarTuple, missingTupArg, 
 
   -- Bindings
   mkFunBind, mkVarBind, mkHsVarBind, mk_easy_FunBind, mkTopFunBind,
@@ -265,9 +265,6 @@ unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
 mkHsString :: String -> HsLit
 mkHsString s = HsString (mkFastString s)
 
-mkHsBSig :: a -> HsBndrSig a
-mkHsBSig x = HsBSig x (placeHolderBndrs, placeHolderBndrs)
-
 -------------
 userHsTyVarBndrs :: SrcSpan -> [name] -> [Located (HsTyVarBndr name)]
 -- Caller sets location