recursion-ninja pushed to branch wip/26626 at Glasgow Haskell Compiler / GHC Commits: 5d04dba3 by Recursion Ninja at 2025-12-05T10:50:29-05:00 Redefining 'hsQTvExplicit' as 'GhcPass' specialized function definition. Redefining 'hsQTvExplicitBinders' as specialized to 'DocNameI'. - - - - - 6 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -72,7 +72,7 @@ module GHC.Hs.Type ( mkHsWildCardBndrs, mkHsPatSigType, mkHsTyPat, mkEmptyWildCardBndrs, mkHsForAllVisTele, mkHsForAllInvisTele, - mkHsQTvs, emptyLHsQTvs, + mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isHsKindedTyVar, hsBndrVar, hsBndrKind, hsTvbAllKinded, hsScopedTvs, hsScopedKvs, hsWcScopedTvs, dropWildCards, hsTyVarLName, hsTyVarName, @@ -640,6 +640,9 @@ hsLTyVarName = hsTyVarName . unLoc hsLTyVarNames :: [LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)] hsLTyVarNames = mapMaybe hsLTyVarName +hsQTvExplicit :: LHsQTyVars (GhcPass p) -> [LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)] +hsQTvExplicit = hsq_explicit + hsForAllTelescopeBndrs :: HsForAllTelescope (GhcPass p) -> [LHsTyVarBndr ForAllTyFlag (GhcPass p)] hsForAllTelescopeBndrs (HsForAllVis _ bndrs) = map (fmap (setHsTyVarBndrFlag Required)) bndrs hsForAllTelescopeBndrs (HsForAllInvis _ bndrs) = map (fmap (updateHsTyVarBndrFlag Invisible)) bndrs @@ -650,7 +653,7 @@ hsForAllTelescopeNames (HsForAllInvis _ bndrs) = hsLTyVarNames bndrs hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)] -- Explicit variables only -hsExplicitLTyVarNames qtvs = hsLTyVarNames (hsq_explicit qtvs) +hsExplicitLTyVarNames qtvs = hsLTyVarNames (hsQTvExplicit qtvs) hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name] -- All variables @@ -664,7 +667,7 @@ hsLTyVarLocName (L _ a) = hsTyVarLName a hsLTyVarLocNames :: Anno (IdGhcP p) ~ SrcSpanAnnN => LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))] -hsLTyVarLocNames qtvs = mapMaybe hsLTyVarLocName (hsq_explicit qtvs) +hsLTyVarLocNames qtvs = mapMaybe hsLTyVarLocName (hsQTvExplicit qtvs) -- | Get the kind signature of a type, ignoring parentheses: -- ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -922,7 +922,7 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside , hsq_explicit = rn_bndrs }) body_remaining } } where - hs_tv_bndrs = hsq_explicit hsq_bndrs + hs_tv_bndrs = hsQTvExplicit hsq_bndrs -- The SrcSpan of the LHsQTyVars. For example, bndrs_loc would be the -- highlighted part in the class below: ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs ===================================== @@ -33,6 +33,7 @@ import GHC import GHC.Core.InstEnv import qualified GHC.Driver.DynFlags as DynFlags import GHC.Driver.Ppr +import GHC.Hs.Type (hsQTvExplicit) import GHC.Plugins (TopLevelFlag (..)) import GHC.Types.SourceText import GHC.Unit.State @@ -330,7 +331,7 @@ ppCtor sDocContext dat subdocs con@ConDeclH98{con_args = con_args'} = apps $ map reL $ (HsTyVar noAnn NotPromoted (reL (noUserRdr $ tcdName dat))) - : map (tyVarArg . unLoc) (hsq_explicit $ tyClDeclTyVars dat) + : map (tyVarArg . unLoc) (hsQTvExplicit $ tyClDeclTyVars dat) ppCtor sDocContext _dat ===================================== utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs ===================================== @@ -435,7 +435,7 @@ ppFamHeader | associated = id | otherwise = (<+> keyword "family") - famName = ppAppDocNameTyVarBndrs unicode name (hsq_explicit tvs) + famName = ppAppDocNameTyVarBndrs unicode name (hsQTvExplicitBinders tvs) famSig = case result of NoSig _ -> empty ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs ===================================== @@ -467,7 +467,7 @@ ppTySyn hdr = hsep ( [keyword "type", ppBinder summary occ] - ++ ppTyVars unicode qual (hsq_explicit ltyvars) + ++ ppTyVars unicode qual (hsQTvExplicitBinders ltyvars) ) full = hdr <+> def def = case unLoc ltype of @@ -594,7 +594,7 @@ ppFamHeader qual = hsep [ ppFamilyLeader associated info - , ppAppDocNameTyVarBndrs summary unicode qual name (hsq_explicit tvs) + , ppAppDocNameTyVarBndrs summary unicode qual name (hsQTvExplicitBinders tvs) , ppResultSig result unicode qual , injAnn , whereBit @@ -759,7 +759,7 @@ ppClassHdr ppClassHdr summ lctxt n tvs fds unicode qual = keyword "class" <+> (if not (null $ fromMaybeContext lctxt) then ppLContext lctxt unicode qual HideEmptyContexts else noHtml) - <+> ppAppDocNameTyVarBndrs summ unicode qual n (hsq_explicit tvs) + <+> ppAppDocNameTyVarBndrs summ unicode qual n (hsQTvExplicitBinders tvs) <+> ppFds fds unicode qual ppFds :: [LHsFunDep DocNameI] -> Unicode -> Qualification -> Html @@ -1655,7 +1655,7 @@ ppDataHeader ppLContext ctxt unicode qual HideEmptyContexts <+> -- T a b c ..., or a :+: b - ppAppDocNameTyVarBndrs summary unicode qual name (hsq_explicit tvs) + ppAppDocNameTyVarBndrs summary unicode qual name (hsQTvExplicitBinders tvs) <+> case ks of Nothing -> mempty Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x ===================================== utils/haddock/haddock-api/src/Haddock/GhcUtils.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Core.Type (binderVar, isRuntimeRepVar) import GHC.Data.StringBuffer (StringBuffer) import qualified GHC.Data.StringBuffer as S import GHC.Driver.Session +import GHC.Hs.Type (hsQTvExplicit) import GHC.HsToCore.Docs hiding (sigNameNoLoc) import GHC.Types.Name import GHC.Types.SrcLoc (advanceSrcLoc) @@ -333,9 +334,12 @@ lHsQTyVarsToTypes tvs = [ HsValArg noExtField $ noLocA (case hsLTyVarName tv of Nothing -> HsWildCardTy noExtField Just nm -> HsTyVar noAnn NotPromoted (noLocA $ noUserRdr nm)) - | tv <- hsq_explicit tvs + | tv <- hsQTvExplicit tvs ] +hsQTvExplicitBinders :: LHsQTyVars DocNameI -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI] +hsQTvExplicitBinders = hsq_explicit + -------------------------------------------------------------------------------- -- * Making abstract declarations View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d04dba38612b96e7921dbcaee49076e... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d04dba38612b96e7921dbcaee49076e... You're receiving this email because of your account on gitlab.haskell.org.