Merge pull request #1 from haskell/ghc-head

Ghc head

1 files changed, 147 insertions, 105 deletions

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index c9262c7e..ab6bb41c 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# LANGUAGE RecordWildCards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Backends.LaTeX
@@ -212,9 +213,9 @@ processExports (e : es) =
 
 
 isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName)
-isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames (L _ t) _))
+isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames t))
                        , expItemMbDoc = (Documentation Nothing Nothing, argDocs) }
-  | Map.null argDocs = Just (map unLoc lnames, t)
+  | Map.null argDocs = Just (map unLoc lnames, unLoc (hsSigWcType t))
 isSimpleSig _ = Nothing
 
 
@@ -249,8 +250,8 @@ ppDocGroup lev doc = sec lev <> braces doc
 declNames :: LHsDecl DocName -> [DocName]
 declNames (L _ decl) = case decl of
   TyClD d  -> [tcdName d]
-  SigD (TypeSig lnames _ _) -> map unLoc lnames
-  SigD (PatSynSig lname _ _ _ _) -> [unLoc lname]
+  SigD (TypeSig lnames _ ) -> map unLoc lnames
+  SigD (PatSynSig lname _) -> [unLoc lname]
   ForD (ForeignImport (L _ n) _ _ _) -> [n]
   ForD (ForeignExport (L _ n) _ _ _) -> [n]
   _ -> error "declaration not supported by declNames"
@@ -292,10 +293,11 @@ ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
 --  TyClD d@(TySynonym {})
 --    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
 -- Family instances happen via FamInst now
-  TyClD d@(ClassDecl {})         -> ppClassDecl instances loc doc subdocs d unicode
-  SigD (TypeSig lnames (L _ t) _) -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames) t unicode
-  SigD (PatSynSig lname qtvs prov req ty) ->
-      ppLPatSig loc (doc, fnArgsDoc) lname qtvs prov req ty unicode
+  TyClD d@(ClassDecl {})    -> ppClassDecl instances loc doc subdocs d unicode
+  SigD (TypeSig lnames t)   -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames)
+                                        (hsSigWcType t) unicode
+  SigD (PatSynSig lname ty) ->
+      ppLPatSig loc (doc, fnArgsDoc) lname ty unicode
   ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode
   InstD _                        -> empty
   _                              -> error "declaration not supported by ppDecl"
@@ -310,8 +312,8 @@ ppTyFam _ _ _ _ _ =
 
 
 ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocName -> Bool -> LaTeX
-ppFor loc doc (ForeignImport (L _ name) (L _ typ) _ _) unicode =
-  ppFunSig loc doc [name] typ unicode
+ppFor loc doc (ForeignImport (L _ name) typ _ _) unicode =
+  ppFunSig loc doc [name] (hsSigType typ) unicode
 ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
 --  error "foreign declarations are currently not supported by --latex"
 
@@ -328,7 +330,9 @@ ppTySyn loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
                          , tcdRhs = ltype }) unicode
   = ppTypeOrFunSig loc [name] (unLoc ltype) doc (full, hdr, char '=') unicode
   where
-    hdr  = hsep (keyword "type" : ppDocBinder name : ppTyVars ltyvars)
+    hdr  = hsep (keyword "type"
+                 : ppDocBinder name
+                 : map ppSymName (tyvarNames ltyvars))
     full = hdr <+> char '=' <+> ppLType unicode ltype
 
 ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn"
@@ -339,9 +343,9 @@ ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn"
 -------------------------------------------------------------------------------
 
 
-ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> HsType DocName
+ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> LHsType DocName
          -> Bool -> LaTeX
-ppFunSig loc doc docnames typ unicode =
+ppFunSig loc doc docnames (L _ typ) unicode =
   ppTypeOrFunSig loc docnames typ doc
     ( ppTypeSig names typ False
     , hsep . punctuate comma $ map ppSymName names
@@ -351,29 +355,17 @@ ppFunSig loc doc docnames typ unicode =
    names = map getName docnames
 
 ppLPatSig :: SrcSpan -> DocForDecl DocName -> Located DocName
-          -> (HsExplicitFlag, LHsTyVarBndrs DocName)
-          -> LHsContext DocName -> LHsContext DocName
-          -> LHsType DocName
+          -> LHsSigType DocName
           -> Bool -> LaTeX
-ppLPatSig _loc (doc, _argDocs) (L _ name) (expl, qtvs) lprov lreq (L _ ty) unicode
+ppLPatSig _loc (doc, _argDocs) (L _ name) ty unicode
   = declWithDoc pref1 (documentationToLaTeX doc)
   where
     pref1 = hsep [ keyword "pattern"
                  , ppDocBinder name
                  , dcolon unicode
-                 , ppLTyVarBndrs expl qtvs unicode
-                 , ctx
-                 , ppType unicode ty
+                 , ppLType unicode (hsSigType ty)
                  ]
 
-    ctx = case (ppLContextMaybe lprov unicode, ppLContextMaybe lreq unicode) of
-        (Nothing,   Nothing)  -> empty
-        (Nothing,   Just req) -> parens empty <+> darr <+> req <+> darr
-        (Just prov, Nothing)  -> prov <+> darr
-        (Just prov, Just req) -> prov <+> darr <+> req <+> darr
-
-    darr = darrow unicode
-
 ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocName
                -> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX)
                -> Bool -> LaTeX
@@ -392,23 +384,15 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
 
      arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs
 
-     do_args :: Int -> LaTeX -> (HsType DocName) -> LaTeX
-     do_args n leader (HsForAllTy Explicit _ tvs lctxt ltype)
-       = decltt leader <->
-             decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
-                ppLContextNoArrow lctxt unicode) <+> nl $$
-         do_largs n (darrow unicode) ltype
-
-     do_args n leader (HsForAllTy Qualified e a lctxt ltype)
-       = do_args n leader (HsForAllTy Implicit e a lctxt ltype)
-     do_args n leader (HsForAllTy Implicit _ _ lctxt ltype)
-       | not (null (unLoc lctxt))
-       = decltt leader <-> decltt (ppLContextNoArrow lctxt unicode) <+> nl $$
-         do_largs n (darrow unicode) ltype
-         -- if we're not showing any 'forall' or class constraints or
-         -- anything, skip having an empty line for the context.
-       | otherwise
-       = do_largs n leader ltype
+     do_args :: Int -> LaTeX -> HsType DocName -> LaTeX
+     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)
+       = decltt leader
+         <-> ppLContextNoArrow lctxt unicode <+> nl $$
+             do_largs n (darrow unicode) ltype
      do_args n leader (HsFunTy lt r)
        = decltt leader <-> decltt (ppLFunLhType unicode lt) <-> arg_doc n <+> nl $$
          do_largs (n+1) (arrow unicode) r
@@ -423,12 +407,12 @@ ppTypeSig nms ty unicode =
     <+> ppType unicode ty
 
 
-ppTyVars :: LHsTyVarBndrs DocName -> [LaTeX]
-ppTyVars tvs = map ppSymName (tyvarNames tvs)
+ppTyVars :: [LHsTyVarBndr DocName] -> [LaTeX]
+ppTyVars = map (ppSymName . getName . hsLTyVarName)
 
 
-tyvarNames :: LHsTyVarBndrs DocName -> [Name]
-tyvarNames = map getName . hsLTyVarNames
+tyvarNames :: LHsQTyVars DocName -> [Name]
+tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
 
 
 declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
@@ -477,12 +461,12 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace
 
 
 ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
-           -> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
+           -> LHsQTyVars DocName -> [Located ([Located DocName], [Located DocName])]
            -> Bool -> LaTeX
 ppClassHdr summ lctxt n tvs fds unicode =
   keyword "class"
   <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode else empty)
-  <+> ppAppDocNameNames summ n (tyvarNames $ tvs)
+  <+> ppAppDocNameNames summ n (tyvarNames tvs)
   <+> ppFds fds unicode
 
 
@@ -520,8 +504,8 @@ ppClassDecl instances loc doc subdocs
 
     methodTable =
       text "\\haddockpremethods{}\\textbf{Methods}" $$
-      vcat  [ ppFunSig loc doc names typ unicode
-            | L _ (TypeSig lnames (L _ typ) _) <- lsigs
+      vcat  [ ppFunSig loc doc names (hsSigWcType typ) unicode
+            | L _ (TypeSig lnames typ) <- lsigs
             , let doc = lookupAnySubdoc (head names) subdocs
                   names = map unLoc lnames ]
               -- FIXME: is taking just the first name ok? Is it possible that
@@ -544,14 +528,14 @@ ppDocInstances unicode (i : rest)
     (is, rest') = spanWith isUndocdInstance rest
 
 isUndocdInstance :: DocInstance a -> Maybe (InstHead a)
-isUndocdInstance (i,Nothing) = Just i
+isUndocdInstance (i,Nothing,_) = Just i
 isUndocdInstance _ = Nothing
 
 -- | Print a possibly commented instance. The instance header is printed inside
 -- an 'argBox'. The comment is printed to the right of the box in normal comment
 -- style.
 ppDocInstance :: Bool -> DocInstance DocName -> LaTeX
-ppDocInstance unicode (instHead, doc) =
+ppDocInstance unicode (instHead, doc, _) =
   declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc)
 
 
@@ -560,12 +544,13 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
 
 
 ppInstHead :: Bool -> InstHead DocName -> LaTeX
-ppInstHead unicode (n, ks, ts, ClassInst ctx) = ppContextNoLocs ctx unicode <+> ppAppNameTypes n ks ts unicode
-ppInstHead unicode (n, ks, ts, TypeInst rhs) = keyword "type"
-  <+> ppAppNameTypes n ks ts unicode
-  <+> maybe empty (\t -> equals <+> ppType unicode t) rhs
-ppInstHead _unicode (_n, _ks, _ts, DataInst _dd) =
-  error "data instances not supported by --latex yet"
+ppInstHead unicode (InstHead {..}) = case ihdInstType of
+    ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ
+    TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs
+    DataInst _ -> error "data instances not supported by --latex yet"
+  where
+    typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode
+    tibody = maybe empty (\t -> equals <+> ppType unicode t)
 
 lookupAnySubdoc :: (Eq name1) =>
                    name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
@@ -591,14 +576,14 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
 
   where
     cons      = dd_cons (tcdDataDefn dataDecl)
-    resTy     = (con_res . unLoc . head) cons
+    resTy     = (unLoc . head) cons
 
     body = catMaybes [constrBit, doc >>= documentationToLaTeX]
 
     (whereBit, leaders)
       | null cons = (empty,[])
       | otherwise = case resTy of
-        ResTyGADT _ _ -> (decltt (keyword "where"), repeat empty)
+        ConDeclGADT{} -> (decltt (keyword "where"), repeat empty)
         _             -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
 
     constrBit
@@ -612,21 +597,85 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
 
 
 -- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Bool -> LaTeX
+ppConstrHdr :: Bool -> [Name] -> HsContext DocName -> Bool -> LaTeX
 ppConstrHdr forall tvs ctxt unicode
  = (if null tvs then empty else ppForall)
    <+>
    (if null ctxt then empty else ppContextNoArrow ctxt unicode <+> darrow unicode <+> text " ")
   where
     ppForall = case forall of
-      Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". "
-      Qualified -> empty
-      Implicit -> empty
+      True  -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". "
+      False -> empty
+
+
+ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
+                   -> LConDecl DocName -> LaTeX
+ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
+  leader <->
+  case con_details con of
+
+    PrefixCon args ->
+      decltt (hsep ((header_ unicode <+> ppOcc) :
+                 map (ppLParendType unicode) args))
+      <-> rDoc mbDoc <+> nl
+
+    RecCon (L _ fields) ->
+      (decltt (header_ unicode <+> ppOcc)
+        <-> rDoc mbDoc <+> nl)
+      $$
+      doRecordFields fields
+
+    InfixCon arg1 arg2 ->
+      decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1,
+                 ppOcc,
+                 ppLParendType unicode arg2 ])
+      <-> rDoc mbDoc <+> nl
+
+ where
+    doRecordFields fields =
+        vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))
+
+
+    header_ = ppConstrHdr False tyVars context
+    occ     = map (nameOccName . getName . unLoc) $ getConNames con
+    ppOcc   = case occ of
+      [one] -> ppBinder one
+      _     -> cat (punctuate comma (map ppBinder occ))
+    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con))
+    context = unLoc (fromMaybe (noLoc []) (con_cxt con))
+
+    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
+    -- or also because we want Haddock to do the doc-parsing, not GHC.
+    mbDoc = case getConNames con of
+              [] -> panic "empty con_names"
+              (cn:_) -> lookup (unLoc cn) subdocs >>=
+                        fmap _doc . combineDocumentation . fst
+
+ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclGADT {})) =
+  leader <->
+  doGADTCon (hsib_body $ con_type con)
+
+ where
+    doGADTCon resTy = decltt (ppOcc <+> dcolon unicode <+>
+                               ppLType unicode resTy
+                            ) <-> rDoc mbDoc
+
+    occ     = map (nameOccName . getName . unLoc) $ getConNames con
+    ppOcc   = case occ of
+      [one] -> ppBinder one
+      _     -> cat (punctuate comma (map ppBinder occ))
 
+    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
+    -- or also because we want Haddock to do the doc-parsing, not GHC.
+    mbDoc = case getConNames con of
+              [] -> panic "empty con_names"
+              (cn:_) -> lookup (unLoc cn) subdocs >>=
+                        fmap _doc . combineDocumentation . fst
+{- old
 
 ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
                    -> LConDecl DocName -> LaTeX
-ppSideBySideConstr subdocs unicode leader (L _ con) =
+ppSideBySideConstr subdocs unicode leader (L loc con) =
   leader <->
   case con_res con of
   ResTyH98 -> case con_details con of
@@ -660,13 +709,13 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
     doRecordFields fields =
         vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))
 
-    doGADTCon args resTy = decltt (ppOcc <+> dcolon unicode <+> hsep [
-                               ppForAll forall ltvs (con_cxt con) unicode,
-                               ppLType unicode (foldr mkFunTy resTy args) ]
+    doGADTCon args resTy = decltt (ppOcc <+> dcolon unicode <+>
+                               ppLType unicode (mk_forall $ mk_phi $
+                                                foldr mkFunTy resTy args)
                             ) <-> rDoc mbDoc
 
 
-    header_ = ppConstrHdr forall tyVars context
+    header_ = ppConstrHdr (con_explicit con) tyVars context
     occ     = map (nameOccName . getName . unLoc) $ con_names con
     ppOcc   = case occ of
       [one] -> ppBinder one
@@ -674,7 +723,12 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
     ltvs    = con_qvars con
     tyVars  = tyvarNames (con_qvars con)
     context = unLoc (con_cxt con)
-    forall  = con_explicit con
+
+    mk_forall ty | con_explicit con = L loc (HsForAllTy (hsQTvExplicit ltvs) ty)
+                 | otherwise        = ty
+    mk_phi ty | null context = ty
+              | otherwise    = L loc (HsQualTy (con_cxt con) ty)
+
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
     -- or also because we want Haddock to do the doc-parsing, not GHC.
     mbDoc = case con_names con of
@@ -682,16 +736,16 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
               (cn:_) -> lookup (unLoc cn) subdocs >>=
                         fmap _doc . combineDocumentation . fst
     mkFunTy a b = noLoc (HsFunTy a b)
-
+-}
 
 ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName ->  LaTeX
 ppSideBySideField subdocs unicode (ConDeclField names ltype _) =
-  decltt (cat (punctuate comma (map (ppBinder . nameOccName . getName . unL) names))
+  decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . rdrNameFieldOcc . unLoc) names))
     <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc
   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 (unL $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
+    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
 
 -- {-
 -- ppHsFullConstr :: HsConDecl -> LaTeX
@@ -790,9 +844,6 @@ ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Bool -> LaTeX
 ppLContext        = ppContext        . unLoc
 ppLContextNoArrow = ppContextNoArrow . unLoc
 
-ppLContextMaybe :: Located (HsContext DocName) -> Bool -> Maybe LaTeX
-ppLContextMaybe = ppContextNoLocsMaybe . map unLoc . unLoc
-
 ppContextNoLocsMaybe :: [HsType DocName] -> Bool -> Maybe LaTeX
 ppContextNoLocsMaybe [] _ = Nothing
 ppContextNoLocsMaybe cxt unicode = Just $ pp_hs_context cxt unicode
@@ -822,9 +873,10 @@ pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)
 -------------------------------------------------------------------------------
 
 
-ppBang :: HsBang -> LaTeX
-ppBang HsNoBang = empty
-ppBang _        = char '!' -- Unpacked args is an implementation detail,
+ppBang :: HsSrcBang -> LaTeX
+ppBang (HsSrcBang _ _ SrcStrict) = char '!'
+ppBang (HsSrcBang _ _ SrcLazy)   = char '~'
+ppBang _                         = empty
 
 
 tupleParens :: HsTupleSort -> [LaTeX] -> LaTeX
@@ -877,33 +929,22 @@ ppKind unicode ki = ppr_mono_ty pREC_TOP ki unicode
 -- Drop top-level for-all type variables in user style
 -- since they are implicit in Haskell
 
-ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName
-         -> Located (HsContext DocName) -> Bool -> LaTeX
-ppForAll expl tvs cxt unicode = ppLTyVarBndrs expl tvs unicode <+> ppLContext cxt unicode
-
-ppLTyVarBndrs :: HsExplicitFlag -> LHsTyVarBndrs DocName
-              -> Bool -> LaTeX
-ppLTyVarBndrs expl tvs unicode
-  | show_forall = hsep (forallSymbol unicode : ppTyVars tvs) <> dot
-  | otherwise   = empty
-  where
-    show_forall = not (null (hsQTvBndrs tvs)) && is_explicit
-    is_explicit = case expl of {Explicit -> True; Implicit -> False; Qualified -> False}
-
 ppr_mono_lty :: Int -> LHsType DocName -> Bool -> LaTeX
 ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode
 
 
 ppr_mono_ty :: Int -> HsType DocName -> Bool -> LaTeX
-ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode
+ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode
   = maybeParen ctxt_prec pREC_FUN $
-    hsep [ppForAll expl tvs ctxt' unicode, ppr_mono_lty pREC_TOP ty unicode]
- where ctxt' = case extra of
-                 Just loc -> (++ [L loc HsWildcardTy]) `fmap` ctxt
-                 Nothing  -> ctxt
+    sep [ hsep (forallSymbol unicode : ppTyVars tvs) <> dot
+        , ppr_mono_lty pREC_TOP 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 name)      _ = ppDocName name
+ppr_mono_ty _         (HsTyVar (L _ name)) _ = 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 _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
@@ -915,7 +956,6 @@ ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
 ppr_mono_ty _         (HsCoreTy {})       _ = error "ppr_mono_ty HsCoreTy"
 ppr_mono_ty _         (HsExplicitListTy _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
 ppr_mono_ty _         (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
-ppr_mono_ty _         (HsWrapTy {})       _ = error "ppr_mono_ty HsWrapTy"
 
 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
   = maybeParen ctxt_prec pREC_OP $
@@ -925,7 +965,7 @@ 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
@@ -939,12 +979,14 @@ ppr_mono_ty ctxt_prec (HsParTy ty) unicode
 ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
   = ppr_mono_lty ctxt_prec ty unicode
 
-ppr_mono_ty _ HsWildcardTy _ = char '_'
+ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_'
 
-ppr_mono_ty _ (HsNamedWildcardTy name) _ = ppDocName name
+ppr_mono_ty _ (HsWildCardTy (NamedWildCard (L _ name))) _ = ppDocName name
 
 ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
 
+ppr_mono_ty _ (HsAppsTy {}) _ = panic "ppr_mono_ty:HsAppsTy"
+
 
 ppr_tylit :: HsTyLit -> Bool -> LaTeX
 ppr_tylit (HsNumTy _ n) _ = integer n