diff options
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 14 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/GhcUtils.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Types.hs | 44 |
3 files changed, 33 insertions, 31 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index f8d85f88..19630077 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -19,6 +19,8 @@ module Haddock.Convert ( PrintRuntimeReps(..), ) where +#include "HsVersions.h" + import GHC.Data.Bag ( emptyBag ) import GHC.Types.Basic ( TupleSort(..), PromotionFlag(..), DefMethSpec(..), TopLevelFlag(..) ) import GHC.Types.SourceText (SourceText(..)) @@ -45,9 +47,9 @@ import GHC.Builtin.Types ( eqTyConName, listTyConName, liftedTypeKindTyConName import GHC.Builtin.Names ( hasKey, eqTyConKey, ipClassKey, tYPETyConKey , liftedDataConKey, boxedRepDataConKey ) import GHC.Types.Unique ( getUnique ) -import GHC.Utils.Misc ( chkAppend, dropList, equalLength +import GHC.Utils.Misc ( chkAppend, debugIsOn, dropList, equalLength , filterByList, filterOut ) -import GHC.Utils.Panic.Plain ( assert ) +import GHC.Utils.Panic ( assertPanic ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.SrcLoc @@ -931,8 +933,8 @@ tcSplitForAllTysReqPreserveSynonyms :: Type -> ([ReqTVBinder], Type) tcSplitForAllTysReqPreserveSynonyms ty = let (all_bndrs, body) = tcSplitSomeForAllTysPreserveSynonyms isVisibleArgFlag ty req_bndrs = mapMaybe mk_req_bndr_maybe all_bndrs in - assert ( req_bndrs `equalLength` all_bndrs) - (req_bndrs, body) + ASSERT( req_bndrs `equalLength` all_bndrs ) + (req_bndrs, body) where mk_req_bndr_maybe :: TyCoVarBinder -> Maybe ReqTVBinder mk_req_bndr_maybe (Bndr tv argf) = case argf of @@ -944,8 +946,8 @@ tcSplitForAllTysInvisPreserveSynonyms :: Type -> ([InvisTVBinder], Type) tcSplitForAllTysInvisPreserveSynonyms ty = let (all_bndrs, body) = tcSplitSomeForAllTysPreserveSynonyms isInvisibleArgFlag ty inv_bndrs = mapMaybe mk_inv_bndr_maybe all_bndrs in - assert ( inv_bndrs `equalLength` all_bndrs) - (inv_bndrs, body) + ASSERT( inv_bndrs `equalLength` all_bndrs ) + (inv_bndrs, body) where mk_inv_bndr_maybe :: TyCoVarBinder -> Maybe InvisTVBinder mk_inv_bndr_maybe (Bndr tv argf) = case argf of diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 1d6b8bc3..2fc42131 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -338,7 +338,7 @@ reparenTypePrec = go where -- Shorter name for 'reparenType' - go :: XParTy a ~ EpAnn AnnParen => Precedence -> HsType a -> HsType a + go :: XParTy a ~ EpAnn' AnnParen => Precedence -> HsType a -> HsType a go _ (HsBangTy x b ty) = HsBangTy x b (reparenLType ty) go _ (HsTupleTy x con tys) = HsTupleTy x con (map reparenLType tys) go _ (HsSumTy x tys) = HsSumTy x (map reparenLType tys) @@ -378,11 +378,11 @@ reparenTypePrec = go go _ t@XHsType{} = t -- Located variant of 'go' - goL :: XParTy a ~ EpAnn AnnParen => Precedence -> LHsType a -> LHsType a + goL :: XParTy a ~ EpAnn' AnnParen => Precedence -> LHsType a -> LHsType a goL ctxt_prec = mapXRec @a (go ctxt_prec) -- Optionally wrap a type in parens - paren :: XParTy a ~ EpAnn AnnParen + paren :: XParTy a ~ EpAnn' AnnParen => Precedence -- Precedence of context -> Precedence -- Precedence of top-level operator -> HsType a -> HsType a -- Wrap in parens if (ctxt >= op) diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 7c4aeb80..d9943e55 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -727,35 +727,35 @@ type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA type instance Anno (HsSigType DocNameI) = SrcSpanAnnA type XRecCond a - = ( XParTy a ~ EpAnn AnnParen + = ( XParTy a ~ EpAnn' AnnParen , NoGhcTc a ~ a , MapXRec a , UnXRec a , WrapXRec a (HsType a) ) -type instance XForAllTy DocNameI = EpAnn [AddEpAnn] -type instance XQualTy DocNameI = EpAnn [AddEpAnn] -type instance XTyVar DocNameI = EpAnn [AddEpAnn] -type instance XStarTy DocNameI = EpAnn [AddEpAnn] -type instance XAppTy DocNameI = EpAnn [AddEpAnn] -type instance XAppKindTy DocNameI = EpAnn [AddEpAnn] -type instance XFunTy DocNameI = EpAnn [AddEpAnn] -type instance XListTy DocNameI = EpAnn AnnParen -type instance XTupleTy DocNameI = EpAnn AnnParen -type instance XSumTy DocNameI = EpAnn AnnParen -type instance XOpTy DocNameI = EpAnn [AddEpAnn] -type instance XParTy DocNameI = EpAnn AnnParen -type instance XIParamTy DocNameI = EpAnn [AddEpAnn] -type instance XKindSig DocNameI = EpAnn [AddEpAnn] +type instance XForAllTy DocNameI = EpAnn +type instance XQualTy DocNameI = EpAnn +type instance XTyVar DocNameI = EpAnn +type instance XStarTy DocNameI = EpAnn +type instance XAppTy DocNameI = EpAnn +type instance XAppKindTy DocNameI = EpAnn +type instance XFunTy DocNameI = EpAnn +type instance XListTy DocNameI = EpAnn' AnnParen +type instance XTupleTy DocNameI = EpAnn' AnnParen +type instance XSumTy DocNameI = EpAnn' AnnParen +type instance XOpTy DocNameI = EpAnn +type instance XParTy DocNameI = EpAnn' AnnParen +type instance XIParamTy DocNameI = EpAnn +type instance XKindSig DocNameI = EpAnn type instance XSpliceTy DocNameI = Void -- see `renameHsSpliceTy` -type instance XDocTy DocNameI = EpAnn [AddEpAnn] -type instance XBangTy DocNameI = EpAnn [AddEpAnn] -type instance XRecTy DocNameI = EpAnn [AddEpAnn] -type instance XExplicitListTy DocNameI = EpAnn [AddEpAnn] -type instance XExplicitTupleTy DocNameI = EpAnn [AddEpAnn] -type instance XTyLit DocNameI = EpAnn [AddEpAnn] -type instance XWildCardTy DocNameI = EpAnn [AddEpAnn] +type instance XDocTy DocNameI = EpAnn +type instance XBangTy DocNameI = EpAnn +type instance XRecTy DocNameI = EpAnn +type instance XExplicitListTy DocNameI = EpAnn +type instance XExplicitTupleTy DocNameI = EpAnn +type instance XTyLit DocNameI = EpAnn +type instance XWildCardTy DocNameI = EpAnn type instance XXType DocNameI = HsCoreTy type instance XHsForAllVis DocNameI = NoExtField |