Match changes for Trees that Grow in GHC

4 files changed, 86 insertions, 85 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index f1d8ddb2..ae993aba 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -73,22 +73,22 @@ dropHsDocTy :: HsType a -> HsType a
 dropHsDocTy = f
     where
         g (L src x) = L src (f x)
-        f (HsForAllTy a e) = HsForAllTy a (g e)
-        f (HsQualTy a e) = HsQualTy a (g e)
-        f (HsBangTy a b) = HsBangTy a (g b)
-        f (HsAppTy a b) = HsAppTy (g a) (g b)
-        f (HsFunTy a b) = HsFunTy (g a) (g b)
-        f (HsListTy a) = HsListTy (g a)
-        f (HsPArrTy a) = HsPArrTy (g a)
-        f (HsTupleTy a b) = HsTupleTy a (map g b)
-        f (HsOpTy a b c) = HsOpTy (g a) b (g c)
-        f (HsParTy a) = HsParTy (g a)
-        f (HsKindSig a b) = HsKindSig (g a) b
-        f (HsDocTy a _) = f $ unL a
+        f (HsForAllTy x a e) = HsForAllTy x a (g e)
+        f (HsQualTy x a e) = HsQualTy x a (g e)
+        f (HsBangTy x a b) = HsBangTy x a (g b)
+        f (HsAppTy x a b) = HsAppTy x (g a) (g b)
+        f (HsFunTy x a b) = HsFunTy x (g a) (g b)
+        f (HsListTy x a) = HsListTy x (g a)
+        f (HsPArrTy x a) = HsPArrTy x (g a)
+        f (HsTupleTy x a b) = HsTupleTy x a (map g b)
+        f (HsOpTy x a b c) = HsOpTy x (g a) b (g c)
+        f (HsParTy x a) = HsParTy x (g a)
+        f (HsKindSig x a b) = HsKindSig x (g a) b
+        f (HsDocTy _ a _) = f $ unL a
         f x = x
 
-outHsType :: (SourceTextX a, OutputableBndrId a)
-          => DynFlags -> HsType a -> String
+outHsType :: (SourceTextX (GhcPass a), OutputableBndrId (GhcPass a))
+          => DynFlags -> HsType (GhcPass a) -> String
 outHsType dflags = out dflags . dropHsDocTy
 
 
@@ -236,12 +236,12 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
         f (PrefixCon args) = [typeSig name $ args ++ [resType]]
         f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
         f (RecCon (L _ recs)) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
-                          [(concatMap (lookupCon dflags subdocs . noLoc . selectorFieldOcc . unLoc) (cd_fld_names r)) ++
-                           [out dflags (map (selectorFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
+                          [(concatMap (lookupCon dflags subdocs . noLoc . extFieldOcc . unLoc) (cd_fld_names r)) ++
+                           [out dflags (map (extFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
                           | r <- map unLoc recs]
 
-        funs = foldr1 (\x y -> reL $ HsFunTy x y)
-        apps = foldl1 (\x y -> reL $ HsAppTy x y)
+        funs = foldr1 (\x y -> reL $ HsFunTy PlaceHolder x y)
+        apps = foldl1 (\x y -> reL $ HsAppTy PlaceHolder x y)
 
         typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (unL $ funs flds)
 
@@ -249,8 +249,8 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
         -- docs for con_names on why it is a list to begin with.
         name = commaSeparate dflags . map unL $ getConNames con
 
-        resType = apps $ map (reL . HsTyVar NotPromoted . reL) $
-                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvExplicit $ tyClDeclTyVars dat]
+        resType = apps $ map (reL . HsTyVar PlaceHolder NotPromoted . reL) $
+                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _ _) <- hsQTvExplicit $ tyClDeclTyVars dat]
 
 ppCtor dflags _dat subdocs con@ConDeclGADT {}
    = concatMap (lookupCon dflags subdocs) (getConNames con) ++ f
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 57ff72ff..9388e5c9 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -99,7 +99,7 @@ types :: GHC.RenamedSource -> LTokenDetails
 types = everythingInRenamedSource ty
   where
     ty term = case cast term of
-        (Just ((GHC.L sspan (GHC.HsTyVar _ name)) :: GHC.LHsType GHC.GhcRn)) ->
+        (Just ((GHC.L sspan (GHC.HsTyVar _ _ name)) :: GHC.LHsType GHC.GhcRn)) ->
             pure (sspan, RtkType (GHC.unLoc name))
         _ -> empty
 
@@ -118,11 +118,11 @@ binds = everythingInRenamedSource
             pure (sspan, RtkBind name)
         _ -> empty
     pat term = case cast term of
-        (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) ->
+        (Just ((GHC.L sspan (GHC.VarPat _ name)) :: GHC.LPat GHC.GhcRn)) ->
             pure (sspan, RtkBind (GHC.unLoc name))
         (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
             [(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs
-        (Just (GHC.L _ (GHC.AsPat (GHC.L sspan name) _))) ->
+        (Just (GHC.L _ (GHC.AsPat _ (GHC.L sspan name) _))) ->
             pure (sspan, RtkBind name)
         _ -> empty
     rec term = case cast term of
@@ -130,9 +130,9 @@ binds = everythingInRenamedSource
             pure (sspan, RtkVar name)
         _ -> empty
     tvar term = case cast term of
-        (Just ((GHC.L sspan (GHC.UserTyVar name)) :: GHC.LHsTyVarBndr GHC.GhcRn)) ->
+        (Just ((GHC.L sspan (GHC.UserTyVar _ name)) :: GHC.LHsTyVarBndr GHC.GhcRn)) ->
             pure (sspan, RtkBind (GHC.unLoc name))
-        (Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) ->
+        (Just (GHC.L _ (GHC.KindedTyVar _ (GHC.L sspan name) _))) ->
             pure (sspan, RtkBind name)
         _ -> empty
 
@@ -167,7 +167,7 @@ decls (group, _, _, _) = concatMap ($ group)
         _ -> empty
     fld term = case cast term of
         Just (field :: GHC.ConDeclField GHC.GhcRn)
-          -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
+          -> map (decl . fmap GHC.extFieldOcc) $ GHC.cd_fld_names field
         Nothing -> empty
     sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
     sig _ = []
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index d79e0e6c..856a5f38 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -389,15 +389,15 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
      arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs
 
      do_args :: Int -> LaTeX -> HsType DocNameI -> LaTeX
-     do_args _n leader (HsForAllTy tvs ltype)
+     do_args _n leader (HsForAllTy _ tvs ltype)
        = decltt leader
          <-> decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]))
          <+> ppLType unicode ltype
-     do_args n leader (HsQualTy lctxt ltype)
+     do_args n leader (HsQualTy _ lctxt ltype)
        = decltt leader
          <-> ppLContextNoArrow lctxt unicode <+> nl $$
              do_largs n (darrow unicode) ltype
-     do_args n leader (HsFunTy lt r)
+     do_args n leader (HsFunTy _ lt r)
        = decltt leader <-> decltt (ppLFunLhType unicode lt) <-> arg_doc n <+> nl $$
          do_largs (n+1) (arrow unicode) r
      do_args n leader t
@@ -764,7 +764,7 @@ ppSideBySideField subdocs unicode (ConDeclField names ltype _) =
   where
     -- don't use cd_fld_doc for same reason we don't use con_doc above
     -- Where there is more than one name, they all have the same documentation
-    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
+    mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
 
 -- {-
 -- ppHsFullConstr :: HsConDecl -> LaTeX
@@ -957,57 +957,57 @@ ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode
 
 
 ppr_mono_ty :: Int -> HsType DocNameI -> Bool -> LaTeX
-ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode
+ppr_mono_ty ctxt_prec (HsForAllTy _ tvs ty) unicode
   = maybeParen ctxt_prec pREC_FUN $
     sep [ hsep (forallSymbol unicode : ppTyVars tvs) <> dot
         , ppr_mono_lty pREC_TOP ty unicode ]
-ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode
+ppr_mono_ty ctxt_prec (HsQualTy _ ctxt ty) unicode
   = maybeParen ctxt_prec pREC_FUN $
     sep [ ppLContext ctxt unicode
         , ppr_mono_lty pREC_TOP ty unicode ]
 
-ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty
-ppr_mono_ty _         (HsTyVar NotPromoted (L _ name)) _ = ppDocName name
-ppr_mono_ty _         (HsTyVar Promoted    (L _ name)) _ = char '\'' <> ppDocName name
-ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
-ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
-ppr_mono_ty _         (HsSumTy tys) u       = sumParens (map (ppLType u) tys)
-ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
-ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
-ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
-ppr_mono_ty _         (HsIParamTy (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsBangTy _ b ty)     u = ppBang b <> ppLParendType u ty
+ppr_mono_ty _         (HsTyVar _ NotPromoted (L _ name)) _ = ppDocName name
+ppr_mono_ty _         (HsTyVar _ Promoted    (L _ name)) _ = char '\'' <> ppDocName name
+ppr_mono_ty ctxt_prec (HsFunTy _ ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
+ppr_mono_ty _         (HsTupleTy _ con tys) u = tupleParens con (map (ppLType u) tys)
+ppr_mono_ty _         (HsSumTy _ tys) u       = sumParens (map (ppLType u) tys)
+ppr_mono_ty _         (HsKindSig _ ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
+ppr_mono_ty _         (HsListTy _ ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsPArrTy _ ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsIParamTy _ (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
-ppr_mono_ty _         (HsCoreTy {})       _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
-ppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (XHsType (NHsCoreTy {}))  _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _         (HsExplicitListTy _ Promoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (HsExplicitListTy _ NotPromoted tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
 ppr_mono_ty _         (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
 
-ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
+ppr_mono_ty ctxt_prec (HsEqTy _ ty1 ty2) unicode
   = maybeParen ctxt_prec pREC_OP $
     ppr_mono_lty pREC_OP ty1 unicode <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode
 
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode
+ppr_mono_ty ctxt_prec (HsAppTy _ fun_ty arg_ty) unicode
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]
 
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode
+ppr_mono_ty ctxt_prec (HsOpTy _ ty1 op ty2) unicode
   = maybeParen ctxt_prec pREC_FUN $
     ppr_mono_lty pREC_OP ty1 unicode <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode
   where
     ppr_op = if not (isSymOcc occName) then char '`' <> ppLDocName op <> char '`' else ppLDocName op
     occName = nameOccName . getName . unLoc $ op
 
-ppr_mono_ty ctxt_prec (HsParTy ty) unicode
+ppr_mono_ty ctxt_prec (HsParTy _ ty) unicode
 --  = parens (ppr_mono_lty pREC_TOP ty)
   = ppr_mono_lty ctxt_prec ty unicode
 
-ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
+ppr_mono_ty ctxt_prec (HsDocTy _ ty _) unicode
   = ppr_mono_lty ctxt_prec ty unicode
 
 ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_'
 
-ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
+ppr_mono_ty _ (HsTyLit _ t) u = ppr_tylit t u
 
 ppr_mono_ty _ (HsAppsTy {}) _ = panic "ppr_mono_ty:HsAppsTy"
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 3b85f96c..eb7705d1 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -123,19 +123,19 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
     do_largs n leader (L _ t) = do_args n leader t
 
     do_args :: Int -> Html -> HsType DocNameI -> [SubDecl]
-    do_args n leader (HsForAllTy tvs ltype)
+    do_args n leader (HsForAllTy _ tvs ltype)
       = do_largs n leader' ltype
       where
         leader' = leader <+> ppForAll tvs unicode qual
 
-    do_args n leader (HsQualTy lctxt ltype)
+    do_args n leader (HsQualTy _ lctxt ltype)
       | null (unLoc lctxt)
       = do_largs n leader ltype
       | otherwise
       = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, [])
         : do_largs n (darrow unicode) ltype
 
-    do_args n leader (HsFunTy lt r)
+    do_args n leader (HsFunTy _ lt r)
       = (leader <+> ppLFunLhType unicode qual emptyCtxts lt, argDoc n, [])
         : do_largs (n+1) (arrow unicode) r
     do_args n leader t
@@ -143,7 +143,7 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
 
 ppForAll :: [LHsTyVarBndr DocNameI] -> Unicode -> Qualification -> Html
 ppForAll tvs unicode qual =
-  case [ppKTv n k | L _ (KindedTyVar (L _ n) k) <- tvs] of
+  case [ppKTv n k | L _ (KindedTyVar _ (L _ n) k) <- tvs] of
     [] -> noHtml
     ts -> forallSymbol unicode <+> hsep ts +++ dot
   where ppKTv n k = parens $
@@ -891,7 +891,7 @@ ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =
   where
     -- don't use cd_fld_doc for same reason we don't use con_doc above
     -- Where there is more than one name, they all have the same documentation
-    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst
+    mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst
 
 
 ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html
@@ -978,11 +978,12 @@ ppParendType unicode qual emptyCtxts ty = ppr_mono_ty pREC_CON ty unicode qual e
 ppFunLhType  unicode qual emptyCtxts ty = ppr_mono_ty pREC_FUN ty unicode qual emptyCtxts
 
 ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocNameI -> Html
-ppHsTyVarBndr _       qual (UserTyVar (L _ name)) =
+ppHsTyVarBndr _       qual (UserTyVar _ (L _ name)) =
     ppDocName qual Raw False name
-ppHsTyVarBndr unicode qual (KindedTyVar name kind) =
+ppHsTyVarBndr unicode qual (KindedTyVar _ name kind) =
     parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>
             ppLKind unicode qual kind)
+ppHsTyVarBndr _ _ (XTyVarBndr _) = error "haddock:ppHsTyVarBndr"
 
 ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
 ppLKind unicode qual y = ppKind unicode qual (unLoc y)
@@ -1001,16 +1002,16 @@ ppPatSigType unicode qual typ =
     hasNonEmptyContext :: LHsType name -> Bool
     hasNonEmptyContext t =
       case unLoc t of
-        HsForAllTy _ s -> hasNonEmptyContext s
-        HsQualTy cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True
-        HsFunTy _ s -> hasNonEmptyContext s
+        HsForAllTy _ _ s -> hasNonEmptyContext s
+        HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True
+        HsFunTy _ _ s    -> hasNonEmptyContext s
         _ -> False
     isFirstContextEmpty :: LHsType name -> Bool
     isFirstContextEmpty t =
       case unLoc t of
-        HsForAllTy _ s -> isFirstContextEmpty s
-        HsQualTy cxt _ -> null (unLoc cxt)
-        HsFunTy _ s -> isFirstContextEmpty s
+        HsForAllTy _ _ s -> isFirstContextEmpty s
+        HsQualTy _ cxt _ -> null (unLoc cxt)
+        HsFunTy _ _ s    -> isFirstContextEmpty s
         _ -> False
 
 ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> Html
@@ -1021,50 +1022,50 @@ ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
 
 
 ppr_mono_ty :: Int -> HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
-ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual emptyCtxts
+ppr_mono_ty ctxt_prec (HsForAllTy _ tvs ty) unicode qual emptyCtxts
   = maybeParen ctxt_prec pREC_FUN $
     ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts
 
-ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual emptyCtxts
+ppr_mono_ty ctxt_prec (HsQualTy _ ctxt ty) unicode qual emptyCtxts
   = maybeParen ctxt_prec pREC_FUN $
     ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts
 
 -- UnicodeSyntax alternatives
-ppr_mono_ty _ (HsTyVar _ (L _ name)) True _ _
+ppr_mono_ty _ (HsTyVar _ _ (L _ name)) True _ _
   | getOccString (getName name) == "*"    = toHtml "★"
   | getOccString (getName name) == "(->)" = toHtml "(→)"
 
-ppr_mono_ty _         (HsBangTy b ty)     u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty
-ppr_mono_ty _         (HsTyVar _ (L _ name)) _ q _ = ppDocName q Prefix True name
-ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e
-ppr_mono_ty _         (HsTupleTy con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys)
-ppr_mono_ty _         (HsSumTy tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys)
-ppr_mono_ty _         (HsKindSig ty kind) u q e =
+ppr_mono_ty _         (HsBangTy _ b ty)     u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty
+ppr_mono_ty _         (HsTyVar _ _ (L _ name)) _ q _ = ppDocName q Prefix True name
+ppr_mono_ty ctxt_prec (HsFunTy _ ty1 ty2)   u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e
+ppr_mono_ty _         (HsTupleTy _ con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys)
+ppr_mono_ty _         (HsSumTy _ tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys)
+ppr_mono_ty _         (HsKindSig _ ty kind) u q e =
     parens (ppr_mono_lty pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind)
-ppr_mono_ty _         (HsListTy ty)       u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
-ppr_mono_ty _         (HsPArrTy ty)       u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
-ppr_mono_ty ctxt_prec (HsIParamTy (L _ n) ty) u q _ =
+ppr_mono_ty _         (HsListTy _ ty)       u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
+ppr_mono_ty _         (HsPArrTy _ ty)       u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
+ppr_mono_ty ctxt_prec (HsIParamTy _ (L _ n) ty) u q _ =
     maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q HideEmptyContexts
 ppr_mono_ty _         (HsSpliceTy {})     _ _ _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty _         (HsRecTy {})        _ _ _ = toHtml "{..}"
        -- Can now legally occur in ConDeclGADT, the output here is to provide a
        -- placeholder in the signature, which is followed by the field
        -- declarations.
-ppr_mono_ty _         (HsCoreTy {})       _ _ _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
-ppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (XHsType (NHsCoreTy {})) _ _ _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _         (HsExplicitListTy _ Promoted tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (HsExplicitListTy _ NotPromoted tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
 ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys
 ppr_mono_ty _         (HsAppsTy {})       _ _ _ = error "ppr_mono_ty HsAppsTy"
 
-ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual _
+ppr_mono_ty ctxt_prec (HsEqTy _ ty1 ty2) unicode qual _
   = maybeParen ctxt_prec pREC_CTX $
     ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts
 
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual _
+ppr_mono_ty ctxt_prec (HsAppTy _ fun_ty arg_ty) unicode qual _
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual HideEmptyContexts, ppr_mono_lty pREC_CON arg_ty unicode qual HideEmptyContexts]
 
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual _
+ppr_mono_ty ctxt_prec (HsOpTy _ ty1 op ty2) unicode qual _
   = maybeParen ctxt_prec pREC_FUN $
     ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts
   where
@@ -1075,15 +1076,15 @@ ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual _
         | otherwise = ppr_op'
     ppr_op' = ppLDocName qual Infix op
 
-ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual emptyCtxts
+ppr_mono_ty ctxt_prec (HsParTy _ ty) unicode qual emptyCtxts
 --  = parens (ppr_mono_lty pREC_TOP ty)
   = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts
 
-ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual emptyCtxts
+ppr_mono_ty ctxt_prec (HsDocTy _ ty _) unicode qual emptyCtxts
   = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts
 
 ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ _ = char '_'
-ppr_mono_ty _ (HsTyLit n) _ _ _ = ppr_tylit n
+ppr_mono_ty _ (HsTyLit _ n) _ _ _ = ppr_tylit n
 
 ppr_tylit :: HsTyLit -> Html
 ppr_tylit (HsNumTy _ n) = toHtml (show n)