June 2025 - ghc-commits

[Git][ghc/ghc][master] haddock: Add redact-type-synonyms pragma
by Marge Bot (＠marge-bot) 19 Jun '25

19 Jun '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fd5b5177 by Ryan Hendrickson at 2025-06-18T22:30:06-04:00 haddock: Add redact-type-synonyms pragma `{-# OPTIONS_HADDOCK redact-type-synonyms #-}` pragma will hide the RHS of type synonyms, and display the result kind instead, if the RHS contains any unexported types. - - - - - 17 changed files: - utils/haddock/CHANGES.md - utils/haddock/doc/cheatsheet/haddocks.md - utils/haddock/doc/markup.rst - 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/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface.hs - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - + utils/haddock/html-test/ref/RedactTypeSynonyms.html - + utils/haddock/html-test/src/RedactTypeSynonyms.hs - + utils/haddock/latex-test/ref/RedactTypeSynonyms/RedactTypeSynonyms.tex - + utils/haddock/latex-test/src/RedactTypeSynonyms/RedactTypeSynonyms.hs Changes: ===================================== utils/haddock/CHANGES.md ===================================== @@ -11,6 +11,10 @@ * Include `package_info` with haddock's `--show-interface` option. + * `{-# OPTIONS_HADDOCK redact-type-synonyms #-}` pragma will hide the RHS of + type synonyms, and display the result kind instead, if the RHS contains any + unexported types. + ## Changes in 2.28.0 * `hi-haddock` is integrated, which means docstrings are no longer extracted through typchecked module results. Instead, docstrings are taken from Haskell ===================================== utils/haddock/doc/cheatsheet/haddocks.md ===================================== @@ -116,6 +116,8 @@ definitions with "[thing]" Show all enabled LANGUAGE extensions {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-} Show all `RuntimeRep` type variables +{-# OPTIONS_HADDOCK redact-type-synonyms #-} + Hide the RHS of type synonyms that use unexported types ``` # Grid tables ===================================== utils/haddock/doc/markup.rst ===================================== @@ -201,6 +201,21 @@ Individual arguments to a function may be documented like this: :: Pattern synonyms, GADT-style data constructors, and class methods also support this style of documentation. +.. _instance-documentation: + +Instance Documentation +~~~~~~~~~~~~~~~~~~~~~~ + +As instances are not exported, their documentation appears as part of the +documentation for the corresponding class and the data types that appear in the +instance head. This may result in the documentation appearing in multiple +modules. + +If the class is *hidden* (meaning defined in this package but not exported by +any exposed module), or if any of the data types that appear in the instance +head are hidden (ditto), then no documentation for the instance is produced, +even if the instance has an associated documentation comment. + .. _module-description: The Module Description @@ -785,6 +800,12 @@ The following attributes are currently understood by Haddock: underlying levity polymorphism. This flag is analogous to GHC's ``-fprint-explicit-runtime-reps`` flag. +``redact-type-synonyms`` + Hide the RHS of type synonyms, and display the result kind instead, if the + RHS contains any hidden types. ("Hidden" here means the same as in the + feature that hides class instances if those instances contain any hidden + types; see :ref:`instance-documentation`.) + .. _markup: Markup ===================================== utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs ===================================== @@ -478,7 +478,11 @@ ppTySyn : ppDocBinder name : map ppWcSymName (tyvarNames ltyvars) ) - full = hdr <+> char '=' <+> ppLType unicode ltype + full = hdr <+> def + def = case unLoc ltype of + XHsType (HsRedacted k) -> + dcolon unicode <+> ppType unicode k + _ -> equals <+> ppLType unicode ltype ppTySyn _ _ _ = error "declaration not supported by ppTySyn" ------------------------------------------------------------------------------- @@ -1360,6 +1364,7 @@ ppr_mono_ty (HsDocTy _ ty _) unicode = ppr_mono_ty (HsWildCardTy _) _ = char '_' ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode) +ppr_mono_ty (XHsType HsRedacted{}) _ = error "ppr_mono_ty: HsRedacted can't be used here" ppr_tylit :: HsTyLit DocNameI -> Bool -> LaTeX ppr_tylit (HsNumTy _ n) _ = integer n ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs ===================================== @@ -469,7 +469,11 @@ ppTySyn ( [keyword "type", ppBinder summary occ] ++ ppTyVars unicode qual (hsQTvExplicit ltyvars) ) - full = hdr <+> equals <+> ppPatSigType unicode qual (noLocA sig_type) + full = hdr <+> def + def = case unLoc ltype of + XHsType (HsRedacted k) -> + dcolon unicode <+> ppType unicode qual HideEmptyContexts k + _ -> equals <+> ppPatSigType unicode qual (noLocA sig_type) occ = nameOccName . getName $ name fixs | summary = noHtml @@ -1874,6 +1878,7 @@ ppr_mono_ty (HsDocTy _ ty _) unicode qual emptyCtxts = ppr_mono_lty ty unicode qual emptyCtxts ppr_mono_ty (HsWildCardTy _) _ _ _ = char '_' ppr_mono_ty (HsTyLit _ n) _ _ _ = ppr_tylit n +ppr_mono_ty (XHsType HsRedacted{}) _ _ _ = error "ppr_mono_ty: HsRedacted can't be used here" ppr_tylit :: HsTyLit DocNameI -> Html ppr_tylit (HsNumTy _ n) = toHtml (show n) ===================================== utils/haddock/haddock-api/src/Haddock/Convert.hs ===================================== @@ -23,6 +23,7 @@ module Haddock.Convert ( tyThingToLHsDecl , synifyInstHead , synifyFamInst + , synifyKindSig , PrintRuntimeReps (..) ) where ===================================== utils/haddock/haddock-api/src/Haddock/GhcUtils.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Utils.Outputable (Outputable, SDocContext, ppr) import qualified GHC.Utils.Outputable as Outputable import GHC.Utils.Panic (panic) -import Haddock.Types (DocName, DocNameI, XRecCond, HsTypeDocNameIExt(..)) +import Haddock.Types (DocName, DocNameI, ExportInfo, XRecCond, HsTypeDocNameIExt(..)) moduleString :: Module -> String moduleString = moduleNameString . moduleName @@ -771,6 +771,26 @@ typeNames ty = go ty Set.empty CastTy t' _ -> go t' acc CoercionTy{} -> acc + +-- | A class or data type is hidden iff +-- +-- * it is defined in one of the modules that are being processed +-- +-- * and it is not exported by any non-hidden module +isNameHidden :: ExportInfo -> Name -> Bool +isNameHidden (names, modules) name = + nameModule name `Set.member` modules + && not (name `Set.member` names) + +isTypeHidden :: ExportInfo -> Type -> Bool +isTypeHidden expInfo = typeHidden + where + typeHidden :: Type -> Bool + typeHidden t = any nameHidden $ typeNames t + + nameHidden :: Name -> Bool + nameHidden = isNameHidden expInfo + ------------------------------------------------------------------------------- -- * Free variables of a 'Type' ===================================== utils/haddock/haddock-api/src/Haddock/Interface.hs ===================================== @@ -102,7 +102,6 @@ processModules -- environment processModules verbosity modules flags extIfaces = do liftIO Compat.setEncoding - dflags <- getDynFlags -- Map from a module to a corresponding installed interface let instIfaceMap :: InstIfaceMap @@ -122,10 +121,11 @@ processModules verbosity modules flags extIfaces = do Set.unions $ map (Set.fromList . ifaceExports) $ filter (\i -> not $ OptHide `elem` ifaceOptions i) interfaces mods = Set.fromList $ map ifaceMod interfaces + expInfo = (exportedNames, mods) interfaces' <- {-# SCC attachInstances #-} withTimingM "attachInstances" (const ()) $ do - attachInstances (exportedNames, mods) interfaces instIfaceMap (isJust oneShotHiFile) + attachInstances expInfo interfaces instIfaceMap (isJust oneShotHiFile) -- Combine the link envs of the external packages into one let extLinks = Map.unions (map ifLinkEnv extIfaces) @@ -140,7 +140,7 @@ processModules verbosity modules flags extIfaces = do withTimingM "renameAllInterfaces" (const ()) $ for interfaces' $ \i -> do withTimingM ("renameInterface: " <+> pprModuleName (moduleName (ifaceMod i))) (const ()) $ - renameInterface dflags ignoredSymbolSet links warnings (Flag_Hoogle `elem` flags) i + renameInterface ignoredSymbolSet links expInfo warnings (Flag_Hoogle `elem` flags) i return (interfaces'', homeLinks) ===================================== utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs ===================================== @@ -31,7 +31,6 @@ import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import Data.Ord (comparing) import qualified Data.Sequence as Seq -import qualified Data.Set as Set import GHC import GHC.Builtin.Types (unrestrictedFunTyConName) import GHC.Core (isOrphan) @@ -62,13 +61,9 @@ import GHC.Unit.State import GHC.Utils.Outputable (sep, text, (<+>)) import Haddock.Convert -import Haddock.GhcUtils (typeNames) +import Haddock.GhcUtils (isNameHidden, isTypeHidden) import Haddock.Types -type ExportedNames = Set.Set Name -type Modules = Set.Set Module -type ExportInfo = (ExportedNames, Modules) - -- Also attaches fixities attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Bool -> Ghc [Interface] attachInstances expInfo ifaces instIfaceMap isOneShot = do @@ -389,16 +384,6 @@ instFam FamInst{fi_fam = n, fi_tys = ts, fi_rhs = t} = -- Filtering hidden instances -------------------------------------------------------------------------------- --- | A class or data type is hidden iff --- --- * it is defined in one of the modules that are being processed --- --- * and it is not exported by any non-hidden module -isNameHidden :: ExportInfo -> Name -> Bool -isNameHidden (names, modules) name = - nameModule name `Set.member` modules - && not (name `Set.member` names) - -- | We say that an instance is «hidden» iff its class or any (part) -- of its type(s) is hidden. isInstanceHidden :: ExportInfo -> Name -> [Type] -> Bool @@ -410,12 +395,3 @@ isInstanceHidden expInfo cls tyNames = instTypeHidden :: Bool instTypeHidden = any (isTypeHidden expInfo) tyNames - -isTypeHidden :: ExportInfo -> Type -> Bool -isTypeHidden expInfo = typeHidden - where - typeHidden :: Type -> Bool - typeHidden t = any nameHidden $ typeNames t - - nameHidden :: Name -> Bool - nameHidden = isNameHidden expInfo ===================================== utils/haddock/haddock-api/src/Haddock/Interface/Create.hs ===================================== @@ -395,6 +395,7 @@ parseOption "prune" = return (Just OptPrune) parseOption "not-home" = return (Just OptNotHome) parseOption "show-extensions" = return (Just OptShowExtensions) parseOption "print-explicit-runtime-reps" = return (Just OptPrintRuntimeRep) +parseOption "redact-type-synonyms" = return (Just OptRedactTypeSyns) parseOption other = warn ("Unrecognised option: " ++ other) >> return Nothing -------------------------------------------------------------------------------- ===================================== utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs ===================================== @@ -25,7 +25,9 @@ import Control.Applicative () import Control.DeepSeq (force) import Control.Monad hiding (mapM) import Control.Monad.Reader -import Control.Monad.Writer.CPS +import Control.Monad.Trans.Maybe (MaybeT (..), hoistMaybe) +import Control.Monad.Trans.Writer.CPS (WriterT, runWriterT) +import Control.Monad.Writer.Class import Data.Foldable (traverse_) import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -33,12 +35,15 @@ import Data.Traversable (mapM) import GHC hiding (NoLink, HsTypeGhcPsExt (..)) import GHC.Builtin.Types (eqTyCon_RDR, tupleDataConName, tupleTyConName) +import GHC.Core.TyCon (tyConResKind) +import GHC.Driver.DynFlags (getDynFlags) import GHC.Types.Basic (Boxity (..), TopLevelFlag (..), TupleSort (..)) import GHC.Types.Name import GHC.Types.Name.Reader (RdrName (Exact)) import Language.Haskell.Syntax.BooleanFormula(BooleanFormula(..)) import Haddock.Backends.Hoogle (ppExportD) +import Haddock.Convert (synifyKindSig) import Haddock.GhcUtils import Haddock.Types @@ -51,9 +56,7 @@ import Haddock.Types -- The renamed output gets written into fields in the Haddock interface record -- that were previously left empty. renameInterface - :: DynFlags - -- ^ GHC session dyn flags - -> Map.Map (Maybe String) (Set.Set String) + :: Map.Map (Maybe String) (Set.Set String) -- ^ Ignored symbols. A map from module names to unqualified names. Module -- 'Just M' mapping to name 'f' means that link warnings should not be -- generated for occurances of specifically 'M.f'. Module 'Nothing' mapping to @@ -61,6 +64,7 @@ renameInterface -> LinkEnv -- ^ Link environment. A map from 'Name' to 'Module', where name 'n' maps to -- module 'M' if 'M' is the preferred link destination for name 'n'. + -> ExportInfo -> Bool -- ^ Are warnings enabled? -> Bool @@ -68,18 +72,17 @@ renameInterface -> Interface -- ^ The interface we are renaming. -> Ghc Interface - -- ^ The renamed interface. Note that there is nothing really special about - -- this being in the 'Ghc' monad. This could very easily be any 'MonadIO' or - -- even pure, depending on the link warnings are reported. -renameInterface dflags ignoreSet renamingEnv warnings hoogle iface = do - let (iface', warnedNames) = - runRnM - dflags - mdl - localLinkEnv - warnName - (hoogle && not (OptHide `elem` ifaceOptions iface)) - (renameInterfaceRn iface) + -- ^ The renamed interface. The 'Ghc' monad is used to look up type + -- information and to get dynamic flags. +renameInterface ignoreSet renamingEnv expInfo warnings hoogle iface = do + (iface', warnedNames) <- + runRnM + mdl + localLinkEnv + (expInfo <$ guard (OptRedactTypeSyns `elem` ifaceOptions iface)) + warnName + (hoogle && not (OptHide `elem` ifaceOptions iface)) + (renameInterfaceRn iface) reportMissingLinks mdl warnedNames return iface' where @@ -144,14 +147,20 @@ reportMissingLinks mdl names -- | A renaming monad which provides 'MonadReader' access to a renaming -- environment, and 'MonadWriter' access to a 'Set' of names for which link -- warnings should be generated, based on the renaming environment. -newtype RnM a = RnM {unRnM :: ReaderT RnMEnv (Writer (Set.Set Name)) a} +newtype RnM a = RnM {unRnM :: ReaderT RnMEnv (WriterT (Set.Set Name) Ghc) a} deriving newtype (Functor, Applicative, Monad, MonadReader RnMEnv, MonadWriter (Set.Set Name)) +liftGhc :: Ghc a -> RnM a +liftGhc = RnM . lift . lift + -- | The renaming monad environment. Stores the linking environment (mapping -- names to modules), the link warning predicate, and the current module. data RnMEnv = RnMEnv { rnLinkEnv :: LinkEnv -- ^ The linking environment (map from names to modules) + , rnExportInfo :: Maybe ExportInfo + -- ^ Information about exported names and modules, only if + -- redact-type-synonyms is enabled , rnWarnName :: (Name -> Bool) -- ^ Link warning predicate (whether failing to find a link destination -- for a given name should result in a warning) @@ -159,26 +168,24 @@ data RnMEnv = RnMEnv -- ^ The current module , rnHoogleOutput :: Bool -- ^ Should Hoogle output be generated for this module? - , rnDynFlags :: DynFlags - -- ^ GHC Session DynFlags, necessary for Hoogle output generation } -- | Run the renamer action in a renaming environment built using the given -- module, link env, and link warning predicate. Returns the renamed value along -- with a set of 'Name's that were not renamed and should be warned for (i.e. -- they satisfied the link warning predicate). -runRnM :: DynFlags -> Module -> LinkEnv -> (Name -> Bool) -> Bool -> RnM a -> (a, Set.Set Name) -runRnM dflags mdl linkEnv warnName hoogleOutput rn = - runWriter $ runReaderT (unRnM rn) rnEnv +runRnM :: Module -> LinkEnv -> Maybe ExportInfo -> (Name -> Bool) -> Bool -> RnM a -> Ghc (a, Set.Set Name) +runRnM mdl linkEnv mbExpInfo warnName hoogleOutput rn = + runWriterT $ runReaderT (unRnM rn) rnEnv where rnEnv :: RnMEnv rnEnv = RnMEnv { rnLinkEnv = linkEnv + , rnExportInfo = mbExpInfo , rnWarnName = warnName , rnModuleString = moduleString mdl , rnHoogleOutput = hoogleOutput - , rnDynFlags = dflags } -------------------------------------------------------------------------------- @@ -243,12 +250,13 @@ renameExportItem item = case item of ExportDecl ed@(ExportD decl pats doc subs instances fixities splice) -> do -- If Hoogle output should be generated, generate it RnMEnv{..} <- ask + dflags0 <- liftGhc getDynFlags let !hoogleOut = force $ if rnHoogleOutput then -- Since Hoogle is line based, we want to avoid breaking long lines. - let dflags = rnDynFlags{pprCols = maxBound} + let dflags = dflags0{pprCols = maxBound} in ppExportD dflags ed else [] @@ -536,7 +544,16 @@ renameTyClD d = case d of SynDecl{tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs} -> do lname' <- renameNameL lname tyvars' <- renameLHsQTyVars tyvars - rhs' <- renameLType rhs + rhs' <- maybe (renameLType rhs) pure <=< runMaybeT $ do + expInfo <- MaybeT $ asks rnExportInfo + -- Given that we have matched on a 'SynDecl', this lookup /really should/ + -- be 'ATyCon', and the 'synTyConRhs_maybe' result /really should/ be + -- 'Just', but out of an abundance of caution, failing either expectation + -- gracefully exits the monad instead of erroring. + ATyCon tc <- MaybeT $ liftGhc $ GHC.lookupName $ getName lname + guard . isTypeHidden expInfo <=< hoistMaybe $ synTyConRhs_maybe tc + let hsKind = synifyKindSig $ tyConResKind tc + lift $ fmap (XHsType . HsRedacted) <$> renameLType hsKind return ( SynDecl { tcdSExt = noExtField ===================================== utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs ===================================== @@ -423,6 +423,8 @@ instance Binary DocOption where putByte bh 4 put_ bh OptPrintRuntimeRep = do putByte bh 5 + put_ bh OptRedactTypeSyns = do + putByte bh 6 get bh = do h <- getByte bh case h of @@ -438,6 +440,8 @@ instance Binary DocOption where return OptShowExtensions 5 -> do return OptPrintRuntimeRep + 6 -> do + return OptRedactTypeSyns n -> fail $ "invalid binary data found: " <> show n instance Binary Example where ===================================== utils/haddock/haddock-api/src/Haddock/Types.hs ===================================== @@ -87,6 +87,9 @@ data DocPaths = DocPaths -- ^ path to hyperlinked sources } type WarningMap = Map Name (Doc Name) +type ExportedNames = Set.Set Name +type Modules = Set.Set Module +type ExportInfo = (ExportedNames, Modules) ----------------------------------------------------------------------------- @@ -697,6 +700,9 @@ data DocOption | -- | Render runtime reps for this module (see -- the GHC @-fprint-explicit-runtime-reps@ flag) OptPrintRuntimeRep + | -- | Hide the RHS of type synonyms in this module + -- that use unexported types. + OptRedactTypeSyns deriving (Eq, Show) -- | Option controlling how to qualify names @@ -874,6 +880,8 @@ data HsTypeDocNameIExt | HsRecTy [LHsConDeclRecField DocNameI] + | HsRedacted (HsType DocNameI) -- ^ contains the kind of the redacted type + type instance XNumTy DocNameI = NoExtField type instance XStrTy DocNameI = NoExtField type instance XCharTy DocNameI = NoExtField ===================================== utils/haddock/html-test/ref/RedactTypeSynonyms.html ===================================== @@ -0,0 +1,205 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><meta name="viewport" content="width=device-width, initial-scale=1" + /><title + >RedactTypeSynonyms</title + ><link href="#" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="#" + /><link rel="stylesheet" type="text/css" href="#" + /><script src="haddock-bundle.min.js" async="async" type="text/javascript" + ></script + ><script type="text/x-mathjax-config" + >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-…" type="text/javascript" + ></script + ></head + ><body + ><div id="package-header" + ><span class="caption empty" + > </span + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >None</td + ></tr + ></table + ><p class="caption" + >RedactTypeSynonyms</p + ></div + ><div id="synopsis" + ><details id="syn" + ><summary + >Synopsis</summary + ><ul class="details-toggle" data-details-id="syn" + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType1</a + > :: <a href="#" title="Data.Kind" + >Type</a + ></li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType2</a + > a :: <a href="#" title="Data.Kind" + >Type</a + ></li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType3</a + > :: <a href="#" title="Data.Kind" + >Constraint</a + ></li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType4</a + > a = (a, <a href="#" title="RedactTypeSynonyms" + >ExportedType2</a + > a)</li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#" + >ExportedType5</a + > (f :: k1 -> k2) (a :: k1) :: (k1, k2, <a href="#" title="Data.Kind" + >Type</a + >)</li + ><li class="src short" + ><a href="#" + >exportedFn</a + > :: <a href="#" title="Data.Bool" + >Bool</a + > -> AlsoHidden</li + ></ul + ></details + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType1" class="def" + >ExportedType1</a + > :: <a href="#" title="Data.Kind" + >Type</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >A type that should be redacted.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType2" class="def" + >ExportedType2</a + > a :: <a href="#" title="Data.Kind" + >Type</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >Another type that should be redacted, but that shouldn't suppress the + warning about AlsoHidden, because it's also visible in <code + ><a href="#" title="RedactTypeSynonyms" + >exportedFn</a + ></code + >.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType3" class="def" + >ExportedType3</a + > :: <a href="#" title="Data.Kind" + >Constraint</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >For a little kind variety.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType4" class="def" + >ExportedType4</a + > a = (a, <a href="#" title="RedactTypeSynonyms" + >ExportedType2</a + > a) <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >This type does not need to be redacted.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >type</span + > <a id="t:ExportedType5" class="def" + >ExportedType5</a + > (f :: k1 -> k2) (a :: k1) :: (k1, k2, <a href="#" title="Data.Kind" + >Type</a + >) <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >This type has parameters in the result kind.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><a id="v:exportedFn" class="def" + >exportedFn</a + > :: <a href="#" title="Data.Bool" + >Bool</a + > -> AlsoHidden <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >A function.</p + ></div + ></div + ></div + ></div + ></body + ></html +> ===================================== utils/haddock/html-test/src/RedactTypeSynonyms.hs ===================================== @@ -0,0 +1,46 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# OPTIONS_HADDOCK redact-type-synonyms #-} +module RedactTypeSynonyms ( + ExportedType1, + ExportedType2, + ExportedType3, + ExportedType4, + ExportedType5, + exportedFn, +) where + +import Data.Kind (Type) + +-- We don't want to see a warning about this being undocumented, because it is +-- only used in 'ExportedType', which is redacted. +-- +-- (Warnings aren't currently tested, but this module would be a good case for +-- it.) +data Hidden + +-- We do want to see a warning here, though. +data AlsoHidden + +class ThisIsHiddenToo where + +-- | A type that should be redacted. +type ExportedType1 = (Bool, Hidden) + +-- | Another type that should be redacted, but that shouldn't suppress the +-- warning about AlsoHidden, because it's also visible in 'exportedFn'. +type ExportedType2 a = (a, AlsoHidden) + +-- | For a little kind variety. +type ExportedType3 = ThisIsHiddenToo + +-- | This type does not need to be redacted. +type ExportedType4 a = (a, ExportedType2 a) + +-- | This type has parameters in the result kind. +type ExportedType5 :: forall k1 k2. (k1 -> k2) -> k1 -> (k1, k2, Type) +type ExportedType5 f a = '(a, f a, Hidden) + +-- | A function. +exportedFn :: Bool -> AlsoHidden +exportedFn = undefined ===================================== utils/haddock/latex-test/ref/RedactTypeSynonyms/RedactTypeSynonyms.tex ===================================== @@ -0,0 +1,53 @@ +\haddockmoduleheading{RedactTypeSynonyms} +\label{module:RedactTypeSynonyms} +\haddockbeginheader +{\haddockverb\begin{verbatim} +module RedactTypeSynonyms ( + ExportedType1, ExportedType2, ExportedType3, ExportedType4, ExportedType5, + exportedFn + ) where\end{verbatim}} +\haddockendheader + +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +type ExportedType1 :: Type +\end{tabular}] +{\haddockbegindoc +A type that should be redacted.\par} +\end{haddockdesc} +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +type ExportedType2 a :: Type +\end{tabular}] +{\haddockbegindoc +Another type that should be redacted, but that shouldn't suppress the + warning about AlsoHidden, because it's also visible in \haddockid{exportedFn}.\par} +\end{haddockdesc} +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +type ExportedType3 :: Constraint +\end{tabular}] +{\haddockbegindoc +For a little kind variety.\par} +\end{haddockdesc} +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +type ExportedType4 a = (a, ExportedType2 a) +\end{tabular}] +{\haddockbegindoc +This type does not need to be redacted.\par} +\end{haddockdesc} +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +type ExportedType5 f a :: (k1, k2, Type) +\end{tabular}] +{\haddockbegindoc +This type has parameters in the result kind.\par} +\end{haddockdesc} +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +exportedFn :: Bool -> AlsoHidden +\end{tabular}] +{\haddockbegindoc +A function.\par} +\end{haddockdesc} \ No newline at end of file ===================================== utils/haddock/latex-test/src/RedactTypeSynonyms/RedactTypeSynonyms.hs ===================================== @@ -0,0 +1,46 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# OPTIONS_HADDOCK redact-type-synonyms #-} +module RedactTypeSynonyms ( + ExportedType1, + ExportedType2, + ExportedType3, + ExportedType4, + ExportedType5, + exportedFn, +) where + +import Data.Kind (Type) + +-- We don't want to see a warning about this being undocumented, because it is +-- only used in 'ExportedType', which is redacted. +-- +-- (Warnings aren't currently tested, but this module would be a good case for +-- it.) +data Hidden + +-- We do want to see a warning here, though. +data AlsoHidden + +class ThisIsHiddenToo where + +-- | A type that should be redacted. +type ExportedType1 = (Bool, Hidden) + +-- | Another type that should be redacted, but that shouldn't suppress the +-- warning about AlsoHidden, because it's also visible in 'exportedFn'. +type ExportedType2 a = (a, AlsoHidden) + +-- | For a little kind variety. +type ExportedType3 = ThisIsHiddenToo + +-- | This type does not need to be redacted. +type ExportedType4 a = (a, ExportedType2 a) + +-- | This type has parameters in the result kind. +type ExportedType5 :: forall k1 k2. (k1 -> k2) -> k1 -> (k1, k2, Type) +type ExportedType5 f a = '(a, f a, Hidden) + +-- | A function. +exportedFn :: Bool -> AlsoHidden +exportedFn = undefined View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd5b51771ac726ecceaaf3480ad7c7c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd5b51771ac726ecceaaf3480ad7c7c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Deprecate -Wdata-kinds-tc, make DataKinds issues in typechecker become errors
by Marge Bot (＠marge-bot) 19 Jun '25

19 Jun '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d3e60e97 by Ryan Scott at 2025-06-18T22:29:21-04:00 Deprecate -Wdata-kinds-tc, make DataKinds issues in typechecker become errors !11314 introduced the `-Wdata-kinds-tc` warning as part of a fix for #22141. This was a temporary stopgap measure to allow users who were accidentally relying on code which needed the `DataKinds` extension in order to typecheck without having to explicitly enable the extension. Now that some amount of time has passed, this patch deprecates `-Wdata-kinds-tc` and upgrades any `DataKinds`-related issues in the typechecker (which were previously warnings) into errors. - - - - - 30 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Validity.hs - docs/users_guide/9.14.1-notes.rst - docs/users_guide/using-warnings.rst - + testsuite/tests/typecheck/should_compile/T20873c.hs - − testsuite/tests/typecheck/should_compile/T22141a.stderr - − testsuite/tests/typecheck/should_compile/T22141b.stderr - − testsuite/tests/typecheck/should_compile/T22141c.stderr - − testsuite/tests/typecheck/should_compile/T22141d.stderr - − testsuite/tests/typecheck/should_compile/T22141e.stderr - testsuite/tests/typecheck/should_compile/all.T - − testsuite/tests/typecheck/should_fail/T20873c.hs - − testsuite/tests/typecheck/should_fail/T20873c.stderr - testsuite/tests/typecheck/should_compile/T22141a.hs → testsuite/tests/typecheck/should_fail/T22141a.hs - testsuite/tests/typecheck/should_fail/T22141a.stderr - testsuite/tests/typecheck/should_compile/T22141b.hs → testsuite/tests/typecheck/should_fail/T22141b.hs - testsuite/tests/typecheck/should_fail/T22141b.stderr - testsuite/tests/typecheck/should_compile/T22141c.hs → testsuite/tests/typecheck/should_fail/T22141c.hs - testsuite/tests/typecheck/should_fail/T22141c.stderr - testsuite/tests/typecheck/should_compile/T22141d.hs → testsuite/tests/typecheck/should_fail/T22141d.hs - testsuite/tests/typecheck/should_fail/T22141d.stderr - testsuite/tests/typecheck/should_compile/T22141e.hs → testsuite/tests/typecheck/should_fail/T22141e.hs - testsuite/tests/typecheck/should_fail/T22141e.stderr - testsuite/tests/typecheck/should_compile/T22141e_Aux.hs → testsuite/tests/typecheck/should_fail/T22141e_Aux.hs - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/vdq-rta/should_fail/T23739_fail_case.hs - testsuite/tests/vdq-rta/should_fail/T23739_fail_case.stderr Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -1364,7 +1364,6 @@ standardWarnings -- see Note [Documenting warning flags] Opt_WarnBadlyLevelledTypes, Opt_WarnTypeEqualityRequiresOperators, Opt_WarnInconsistentFlags, - Opt_WarnDataKindsTC, Opt_WarnTypeEqualityOutOfScope, Opt_WarnImplicitRhsQuantification, -- was in -Wcompat since 9.8, enabled by default since 9.14, to turn into a hard error in 9.16 Opt_WarnViewPatternSignatures, ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2382,7 +2382,8 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of Opt_WarnImplicitRhsQuantification -> warnSpec x Opt_WarnIncompleteExportWarnings -> warnSpec x Opt_WarnIncompleteRecordSelectors -> warnSpec x - Opt_WarnDataKindsTC -> warnSpec x + Opt_WarnDataKindsTC + -> depWarnSpec x "DataKinds violations are now always an error" Opt_WarnDefaultedExceptionContext -> warnSpec x Opt_WarnViewPatternSignatures -> warnSpec x Opt_WarnUselessSpecialisations -> warnSpec x ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1750,21 +1750,15 @@ instance Diagnostic TcRnMessage where , inHsDocContext doc ] TcRnDataKindsError typeOrKind thing - -- See Note [Checking for DataKinds] (Wrinkle: Migration story for - -- DataKinds typechecker errors) in GHC.Tc.Validity for why we give - -- different diagnostic messages below. -> case thing of Left renamer_thing -> - mkSimpleDecorated $ - text "Illegal" <+> ppr_level <> colon <+> quotes (ppr renamer_thing) + mkSimpleDecorated $ msg renamer_thing Right typechecker_thing -> - mkSimpleDecorated $ vcat - [ text "An occurrence of" <+> quotes (ppr typechecker_thing) <+> - text "in a" <+> ppr_level <+> text "requires DataKinds." - , text "Future versions of GHC will turn this warning into an error." - ] + mkSimpleDecorated $ msg typechecker_thing where - ppr_level = text $ levelString typeOrKind + msg :: Outputable a => a -> SDoc + msg thing = text "Illegal" <+> text (levelString typeOrKind) <> + colon <+> quotes (ppr thing) TcRnTypeSynonymCycle decl_or_tcs -> mkSimpleDecorated $ @@ -2567,17 +2561,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnusedQuantifiedTypeVar{} -> WarningWithFlag Opt_WarnUnusedForalls - TcRnDataKindsError _ thing - -- DataKinds errors can arise from either the renamer (Left) or the - -- typechecker (Right). The latter category of DataKinds errors are a - -- fairly recent addition to GHC (introduced in GHC 9.10), and in order - -- to prevent these new errors from breaking users' code, we temporarily - -- downgrade these errors to warnings. See Note [Checking for DataKinds] - -- (Wrinkle: Migration story for DataKinds typechecker errors) - -- in GHC.Tc.Validity. - -> case thing of - Left _ -> ErrorWithoutFlag - Right _ -> WarningWithFlag Opt_WarnDataKindsTC + TcRnDataKindsError{} + -> ErrorWithoutFlag TcRnTypeSynonymCycle{} -> ErrorWithoutFlag TcRnZonkerMessage msg ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2553,11 +2553,11 @@ data TcRnMessage where rename/should_fail/T22478e th/TH_Promoted1Tuple typecheck/should_compile/tcfail094 - typecheck/should_compile/T22141a - typecheck/should_compile/T22141b - typecheck/should_compile/T22141c - typecheck/should_compile/T22141d - typecheck/should_compile/T22141e + typecheck/should_fail/T22141a + typecheck/should_fail/T22141b + typecheck/should_fail/T22141c + typecheck/should_fail/T22141d + typecheck/should_fail/T22141e typecheck/should_compile/T22141f typecheck/should_compile/T22141g typecheck/should_fail/T20873c ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -1001,18 +1001,11 @@ checkVdqOK ve tvbs ty = do -- | Check for a DataKinds violation in a kind context. -- See @Note [Checking for DataKinds]@. --- --- Note that emitting DataKinds errors from the typechecker is a fairly recent --- addition to GHC (introduced in GHC 9.10), and in order to prevent these new --- errors from breaking users' code, we temporarily downgrade these errors to --- warnings. (This is why we use 'diagnosticTcM' below.) See --- @Note [Checking for DataKinds] (Wrinkle: Migration story for DataKinds --- typechecker errors)@. checkDataKinds :: ValidityEnv -> Type -> TcM () checkDataKinds (ValidityEnv{ ve_ctxt = ctxt, ve_tidy_env = env }) ty = do data_kinds <- xoptM LangExt.DataKinds - diagnosticTcM - (not (data_kinds || typeLevelUserTypeCtxt ctxt)) $ + checkTcM + (data_kinds || typeLevelUserTypeCtxt ctxt) $ (env, TcRnDataKindsError KindLevel (Right (tidyType env ty))) {- Note [No constraints in kinds] @@ -1164,28 +1157,6 @@ different places in the code: synonym), so we also catch a subset of kind-level violations in the renamer to allow for earlier reporting of these errors. ------ --- Wrinkle: Migration story for DataKinds typechecker errors ------ - -As mentioned above, DataKinds is checked in two different places: the renamer -and the typechecker. The checks in the renamer have been around since DataKinds -was introduced. The checks in the typechecker, on the other hand, are a fairly -recent addition, having been introduced in GHC 9.10. As such, it is possible -that there are some programs in the wild that (1) do not enable DataKinds, and -(2) were accepted by a previous GHC version, but would now be rejected by the -new DataKinds checks in the typechecker. - -To prevent the new DataKinds checks in the typechecker from breaking users' -code, we temporarily allow programs to compile if they violate a DataKinds -check in the typechecker, but GHC will emit a warning if such a violation -occurs. Users can then silence the warning by enabling DataKinds in the module -where the affected code lives. It is fairly straightforward to distinguish -between DataKinds violations arising from the renamer versus the typechecker, -as TcRnDataKindsError (the error message type classifying all DataKinds errors) -stores an Either field that is Left when the error comes from the renamer and -Right when the error comes from the typechecker. - ************************************************************************ * * \subsection{Checking a theta or source type} ===================================== docs/users_guide/9.14.1-notes.rst ===================================== @@ -70,6 +70,21 @@ Language * The :extension:`ExplicitNamespaces` extension now allows the ``data`` namespace specifier in import and export lists. +* The ``-Wdata-kinds-tc`` warning has been deprecated, and the use of promoted + data types in kinds is now an error (rather than a warning) unless the + :extension:`DataKinds` extension is enabled. For example, the following code + will be rejected unless :extension:`DataKinds` is on: + + import Data.Kind (Type) + import GHC.TypeNats (Nat) + + -- Nat shouldn't be allowed here without DataKinds + data Vec :: Nat -> Type -> Type + + (The ``-Wdata-kinds-tc`` warning was introduced in GHC 9.10 as part of a fix + for an accidental oversight in which programs like the one above were + mistakenly accepted without the use of :extension:`DataKinds`.) + * The :extension:`MonadComprehensions` extension now implies :extension:`ParallelListComp` as was originally intended (see `Monad Comprehensions <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/monad_comprehension…>`_). Compiler ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -82,7 +82,6 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Winconsistent-flags` * :ghc-flag:`-Wnoncanonical-monoid-instances` * :ghc-flag:`-Wnoncanonical-monad-instances` - * :ghc-flag:`-Wdata-kinds-tc` * :ghc-flag:`-Wimplicit-rhs-quantification` * :ghc-flag:`-Wunusable-unpack-pragmas` @@ -2601,24 +2600,19 @@ of ``-W(no-)*``. is passed. .. ghc-flag:: -Wdata-kinds-tc - :shortdesc: warn when an illegal use of a type or kind without - :extension:`DataKinds` is caught by the typechecker + :shortdesc: *(deprecated)* Does nothing :type: dynamic - :reverse: -Wno-data-kinds-tc :since: 9.10.1 - Introduced in GHC 9.10.1, this warns when an illegal use of a type or kind - (without having enabled the :extension:`DataKinds` extension) is caught in - the typechecker (hence the ``-tc`` suffix). These warnings complement the - existing :extension:`DataKinds` checks (that have existed since - :extension:`DataKinds` was first introduced), which result in errors - instead of warnings. - - This warning is scheduled to be changed to an error in a future GHC - version, at which point the :ghc-flag:`-Wdata-kinds-tc` flag will be - removed. Users can enable the :extension:`DataKinds` extension to avoid - issues (thus silencing the warning). + This warning is deprecated. It no longer has any effect since GHC 9.14. + + In the past, GHC 9.10 and 9.12 was overly permissive about which types or + kinds could be used without enabling the :extension:`DataKinds` extension. + In GHC 9.14 or later, however, GHC now consistently requires + :extension:`DataKinds`, and all :extension:`DataKinds` violations are now + errors. :ghc-flag:`-Wdata-kinds-tc` was used in the migration period before + the breaking change took place. .. ghc-flag:: -Wdefaulted-exception-context :shortdesc: warn when an :base-ref:`Control.Exception.Context.ExceptionContext` ===================================== testsuite/tests/typecheck/should_compile/T20873c.hs ===================================== @@ -0,0 +1,14 @@ + +{-# LANGUAGE GADTSyntax, KindSignatures, NoDataKinds #-} + +module T20873c where + +import Data.Kind ( Type ) + +type U a = Type + +-- This should be allowed without enabling DataKinds, This is because the return +-- kind only mentions Type, which is always permitted in kinds, and U, which is +-- simply a type synonym that expands to Type. +data Foo :: U Type where + MkFoo :: Foo ===================================== testsuite/tests/typecheck/should_compile/T22141a.stderr deleted ===================================== @@ -1,8 +0,0 @@ -T22141a.hs:8:1: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In the expansion of type synonym ‘Nat’ - In the data type declaration for ‘Vector’ - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - ===================================== testsuite/tests/typecheck/should_compile/T22141b.stderr deleted ===================================== @@ -1,9 +0,0 @@ -T22141b.hs:10:1: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In the expansion of type synonym ‘Nat’ - In the expansion of type synonym ‘MyNat’ - In the data type declaration for ‘Vector’ - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - ===================================== testsuite/tests/typecheck/should_compile/T22141c.stderr deleted ===================================== @@ -1,37 +0,0 @@ -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘(# *, * #)’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In the expansion of type synonym ‘T’ - In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘'[]’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘'[GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘[GHC.Internal.Types.LiftedRep, - GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141c.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘Proxy T’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - ===================================== testsuite/tests/typecheck/should_compile/T22141d.stderr deleted ===================================== @@ -1,37 +0,0 @@ -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘(# * | * #)’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In the expansion of type synonym ‘T’ - In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘'[]’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘'[GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘[GHC.Internal.Types.LiftedRep, - GHC.Internal.Types.LiftedRep]’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141d.hs:10:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘Proxy T’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - ===================================== testsuite/tests/typecheck/should_compile/T22141e.stderr deleted ===================================== @@ -1,22 +0,0 @@ -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘42’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In the expansion of type synonym ‘T’ - In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - -T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)] - • An occurrence of ‘Proxy T’ in a kind requires DataKinds. - Future versions of GHC will turn this warning into an error. - • In a standalone kind signature for ‘D’: Proxy T -> Type - Suggested fix: - Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) - ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -819,6 +819,7 @@ test('T20588d', [extra_files(['T20588d.hs', 'T20588d.hs-boot', 'T20588d_aux.hs'] test('T20661', [extra_files(['T20661.hs', 'T20661.hs-boot', 'T20661_aux.hs'])], multimod_compile, ['T20661_aux.hs', '-v0']) test('T20873', normal, compile, ['']) test('T20873b', [extra_files(['T20873b_aux.hs'])], multimod_compile, ['T20873b', '-v0']) +test('T20873c', normal, compile, ['']) test('StaticPtrTypeFamily', normal, compile, ['']) test('T20946', normal, compile, ['']) test('T20996', normal, compile, ['']) @@ -864,11 +865,6 @@ test('T21951a', normal, compile, ['-Wredundant-strictness-flags']) test('T21951b', normal, compile, ['-Wredundant-strictness-flags']) test('DataToTagSolving', normal, compile, ['']) test('T21550', normal, compile, ['']) -test('T22141a', normal, compile, ['']) -test('T22141b', normal, compile, ['']) -test('T22141c', normal, compile, ['']) -test('T22141d', normal, compile, ['']) -test('T22141e', [extra_files(['T22141e_Aux.hs'])], multimod_compile, ['T22141e.hs', '-v0']) test('T22141f', normal, compile, ['']) test('T22141g', normal, compile, ['']) test('T22310', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T20873c.hs deleted ===================================== @@ -1,11 +0,0 @@ - -{-# LANGUAGE GADTSyntax, NoKindSignatures, NoDataKinds #-} - -module T20873c where - -import Data.Kind ( Type ) - -type U a = Type - -data Foo :: U Int where - MkFoo :: Foo ===================================== testsuite/tests/typecheck/should_fail/T20873c.stderr deleted ===================================== @@ -1,6 +0,0 @@ -T20873c.hs:10:1: error: [GHC-49378] - • Illegal kind signature ‘Foo :: U Int’ - • In the data type declaration for ‘Foo’ - Suggested fix: - Perhaps you intended to use the ‘KindSignatures’ extension (implied by ‘TypeFamilies’ and ‘PolyKinds’) - ===================================== testsuite/tests/typecheck/should_compile/T22141a.hs → testsuite/tests/typecheck/should_fail/T22141a.hs ===================================== ===================================== testsuite/tests/typecheck/should_fail/T22141a.stderr ===================================== @@ -1,6 +1,7 @@ - T22141a.hs:8:1: error: [GHC-68567] - • Illegal kind: ‘GHC.Num.Natural.Natural’ + • Illegal kind: ‘GHC.Internal.Bignum.Natural.Natural’ • In the expansion of type synonym ‘Nat’ In the data type declaration for ‘Vector’ - Suggested fix: Perhaps you intended to use DataKinds + Suggested fix: + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) + ===================================== testsuite/tests/typecheck/should_compile/T22141b.hs → testsuite/tests/typecheck/should_fail/T22141b.hs ===================================== ===================================== testsuite/tests/typecheck/should_fail/T22141b.stderr ===================================== @@ -1,7 +1,8 @@ - T22141b.hs:10:1: error: [GHC-68567] - • Illegal kind: ‘GHC.Num.Natural.Natural’ + • Illegal kind: ‘GHC.Internal.Bignum.Natural.Natural’ • In the expansion of type synonym ‘Nat’ In the expansion of type synonym ‘MyNat’ In the data type declaration for ‘Vector’ - Suggested fix: Perhaps you intended to use DataKinds + Suggested fix: + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) + ===================================== testsuite/tests/typecheck/should_compile/T22141c.hs → testsuite/tests/typecheck/should_fail/T22141c.hs ===================================== ===================================== testsuite/tests/typecheck/should_fail/T22141c.stderr ===================================== @@ -1,4 +1,6 @@ +T22141c.hs:10:11: error: [GHC-68567] + • Illegal kind: ‘Proxy T’ + • In a standalone kind signature for ‘D’: Proxy T -> Type + Suggested fix: + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) -T22141c.hs:8:17: error: [GHC-68567] - Illegal kind: ‘(# Type, Type #)’ - Suggested fix: Perhaps you intended to use DataKinds ===================================== testsuite/tests/typecheck/should_compile/T22141d.hs → testsuite/tests/typecheck/should_fail/T22141d.hs ===================================== ===================================== testsuite/tests/typecheck/should_fail/T22141d.stderr ===================================== @@ -1,4 +1,6 @@ +T22141d.hs:10:11: error: [GHC-68567] + • Illegal kind: ‘Proxy T’ + • In a standalone kind signature for ‘D’: Proxy T -> Type + Suggested fix: + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) -T22141d.hs:8:17: error: [GHC-68567] - Illegal kind: ‘(# Type | Type #)’ - Suggested fix: Perhaps you intended to use DataKinds ===================================== testsuite/tests/typecheck/should_compile/T22141e.hs → testsuite/tests/typecheck/should_fail/T22141e.hs ===================================== ===================================== testsuite/tests/typecheck/should_fail/T22141e.stderr ===================================== @@ -1,4 +1,6 @@ +T22141e.hs:8:11: error: [GHC-68567] + • Illegal kind: ‘Proxy T’ + • In a standalone kind signature for ‘D’: Proxy T -> Type + Suggested fix: + Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’) -T22141e.hs:7:17: error: [GHC-68567] - Illegal kind: ‘42’ - Suggested fix: Perhaps you intended to use DataKinds ===================================== testsuite/tests/typecheck/should_compile/T22141e_Aux.hs → testsuite/tests/typecheck/should_fail/T22141e_Aux.hs ===================================== ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -646,7 +646,6 @@ test('T20542', normal, compile_fail, ['']) test('T20588', [extra_files(['T20588.hs', 'T20588.hs-boot', 'T20588_aux.hs'])], multimod_compile_fail, ['T20588_aux.hs', '-v0']) test('T20588c', [extra_files(['T20588c.hs', 'T20588c.hs-boot', 'T20588c_aux.hs'])], multimod_compile_fail, ['T20588c_aux.hs', '-v0']) test('T20189', normal, compile_fail, ['']) -test('T20873c', normal, compile_fail, ['']) test('T20873d', normal, compile_fail, ['']) test('FunDepOrigin1b', normal, compile_fail, ['']) test('FD1', normal, compile_fail, ['']) @@ -667,6 +666,11 @@ test('T21447', normal, compile_fail, ['']) test('T21530a', normal, compile_fail, ['']) test('T21530b', normal, compile_fail, ['']) test('Or4', normal, compile_fail, ['']) +test('T22141a', normal, compile_fail, ['']) +test('T22141b', normal, compile_fail, ['']) +test('T22141c', normal, compile_fail, ['']) +test('T22141d', normal, compile_fail, ['']) +test('T22141e', [extra_files(['T22141e_Aux.hs'])], multimod_compile_fail, ['T22141e.hs', '-v0']) test('T22570', normal, compile_fail, ['']) test('T22645', normal, compile_fail, ['']) test('T20666', normal, compile_fail, ['']) ===================================== testsuite/tests/vdq-rta/should_fail/T23739_fail_case.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE RequiredTypeArguments #-} module T23739_fail_case where @@ -6,4 +7,4 @@ bad :: forall (b :: Bool) -> String bad t = case t of False -> "False" - True -> "True" \ No newline at end of file + True -> "True" ===================================== testsuite/tests/vdq-rta/should_fail/T23739_fail_case.stderr ===================================== @@ -1,7 +1,6 @@ - -T23739_fail_case.hs:7:8: error: [GHC-01928] +T23739_fail_case.hs:8:8: error: [GHC-01928] • Illegal term-level use of the type variable ‘t’ - • bound at T23739_fail_case.hs:6:5 + • bound at T23739_fail_case.hs:7:5 • In the expression: t In the expression: case t of @@ -12,3 +11,4 @@ T23739_fail_case.hs:7:8: error: [GHC-01928] = case t of False -> "False" True -> "True" + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3e60e97d0afa2ad3a1e4d2e9fa6454… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3e60e97d0afa2ad3a1e4d2e9fa6454… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/haddock-move-binary-instances] compiler: move Binary instance of Map to GHC.Utils.Binary
by Cheng Shao (＠TerrorJack) 19 Jun '25

19 Jun '25

Cheng Shao pushed to branch wip/haddock-move-binary-instances at Glasgow Haskell Compiler / GHC Commits: 0523deff by Cheng Shao at 2025-06-19T02:12:57+00:00 compiler: move Binary instance of Map to GHC.Utils.Binary This patch moves `Binary` instance of `Map` from `haddock-api` to `GHC.Utils.Binary`. This also allows us to remove a redundant instance defined for `NameEntityInfo`, which is a type synonym for `Map`. - - - - - 3 changed files: - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Utils/Binary.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs Changes: ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -98,10 +98,6 @@ data HieFile = HieFile type NameEntityInfo = M.Map Name (S.Set EntityInfo) -instance Binary NameEntityInfo where - put_ bh m = put_ bh $ M.toList m - get bh = fmap M.fromList (get bh) - instance Binary HieFile where put_ bh hf = do put_ bh $ hie_hs_file hf ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -2131,6 +2131,13 @@ instance (Binary v) => Binary (IntMap v) where put_ bh m = put_ bh (IntMap.toAscList m) get bh = IntMap.fromAscList <$> get bh +instance (Ord k, Binary k, Binary v) => Binary (Map k v) where + put_ bh m = put_ bh $ Map.toList m + -- Unfortunately, we can't use fromAscList, since k is often + -- instantiated to Name which has a non-deterministic Ord instance + -- that only compares the Uniques, and the Uniques are likely + -- changed when deserializing! + get bh = Map.fromList <$> get bh {- Note [FingerprintWithValue] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs ===================================== @@ -40,7 +40,6 @@ import Data.Coerce (coerce) import Data.Function ((&)) import Data.IORef import Data.Map (Map) -import qualified Data.Map as Map import Data.Version import Data.Word import GHC hiding (NoLink) @@ -319,10 +318,6 @@ data BinDictionary = BinDictionary ------------------------------------------------------------------------------- -instance (Ord k, Binary k, Binary v) => Binary (Map k v) where - put_ bh m = put_ bh (Map.toList m) - get bh = fmap (Map.fromList) (get bh) - instance Binary PackageInfo where put_ bh PackageInfo{piPackageName, piPackageVersion} = do put_ bh (unPackageName piPackageName) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0523deffe6e002bad869caa9458c60c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0523deffe6e002bad869caa9458c60c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26115] Wibbles
by Simon Peyton Jones (＠simonpj) 18 Jun '25

18 Jun '25

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: 50938910 by Simon Peyton Jones at 2025-06-18T23:22:55+01:00 Wibbles - - - - - 1 changed file: - compiler/GHC/HsToCore/Binds.hs Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -1079,14 +1079,15 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call ; let simpl_opts = initSimpleOpts dflags core_call = simpleOptExprNoInline simpl_opts ds_call - ; case decomposeCall poly_id [] core_call of { + ; case decomposeCall poly_id core_call of { Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call) ; return Nothing } ; Just (rev_binds, rule_lhs_args) -> do { let orig_bndr_set = mkVarSet orig_bndrs - rule_bndrs = scopedSort (exprsSomeFreeVarsList (`elemVarSet` orig_bndr_set) + locally_bound = orig_bndr_set `extendVarSetList` bindersOfBinds rev_binds + rule_bndrs = scopedSort (exprsSomeFreeVarsList (`elemVarSet` locally_bound) rule_lhs_args) spec_binds = grabSpecBinds orig_bndr_set (mkVarSet rule_bndrs) rev_binds spec_binds_bndr_set = mkVarSet (bindersOfBinds spec_binds) @@ -1100,17 +1101,14 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call ; tracePm "dsSpec(new route)" $ vcat [ text "poly_id" <+> ppr poly_id , text "unfolding" <+> ppr (realIdUnfolding poly_id) - , text "bndrs" <+> ppr bndrs + , text "orig_bndrs" <+> ppr orig_bndrs , text "ds_call" <+> ppr ds_call , text "core_call" <+> ppr core_call - , text "bndr_set" <+> ppr bndr_set - , text "all_bndrs" <+> ppr all_bndrs + , text "rev_binds" <+> ppr rev_binds , text "rule_bndrs" <+> ppr rule_bndrs , text "rule_lhs_args" <+> ppr rule_lhs_args - , text "const_bndrs" <+> ppr const_bndrs , text "spec_bndrs" <+> ppr spec_bndrs - , text "core_call fvs" <+> ppr (exprFreeVars core_call) - , text "spec_const_binds" <+> ppr spec_const_binds ] + , text "spec_binds" <+> ppr spec_binds ] ; finishSpecPrag poly_nm poly_rhs rule_bndrs poly_id rule_lhs_args @@ -1124,8 +1122,8 @@ decomposeCall poly_id binds where go acc (Let bind body) = go (bind:acc) body - go add e - | Just (Var fun, args) <- collectArgs e + go acc e + | (Var fun, args) <- collectArgs e = assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $ Just (acc, args) | otherwise @@ -1134,44 +1132,55 @@ decomposeCall poly_id binds grabSpecBinds :: VarSet -> VarSet -> [CoreBind] -> [CoreBind] grabSpecBinds orig_bndrs rule_bndrs rev_binds - = rename_binds ++ spec_binds + = reverse rename_binds ++ spec_binds where - (known_bndrs, rename_binds, other_binds) - = get_renamings rule_bndrs ([],[]) rev_binds + (known_bndrs, (rename_binds, other_binds)) + = get_renamings orig_bndrs rule_bndrs ([],[]) rev_binds spec_binds = pick_spec_binds known_bndrs other_binds ------------------------ - get_renamings :: VarSet -- Variables bound by a successful match on the call + get_renamings :: VarSet -- Locally bound variables + -> VarSet -- Variables bound by a successful match on the call -> ([CoreBind],[CoreBind]) -- Accumulating parameter, in order -> [CoreBind] -- Reversed, innermost first -> ( VarSet - , [CoreBind] -- Renamings, in order - , [CoreBind]) -- Other bindings, in order - get_renamings _ acc [] acc + , ([CoreBind] -- Renamings, in order + , [CoreBind])) -- Other bindings, in order + get_renamings _ bndrs acc [] = (bndrs, acc) - get_renamings bndrs (rn_binds, other_binds) (bind : binds) + get_renamings locals bndrs (rn_binds, other_binds) (bind : binds) | NonRec d r <- bind , d `elemVarSet` bndrs , Just (v, mco) <- getCastedVar r + , v `elemVarSet` locals , let flipped_bind = NonRec v (mkCastMCo (Var d) (mkSymMCo mco)) = get_renamings (bndrs `extendVarSet` v) + (locals `extendVarSet` d) (flipped_bind:rn_binds, other_binds) binds | otherwise - = get_renamings bndrs (rn_binds, bind:other_binds) binds + = get_renamings bndrs + (locals `extendVarSetList` bindersOf bind) + (rn_binds, bind:other_binds) + binds ------------------------ pick_spec_binds :: VarSet -> [CoreBind] -> [CoreBind] - pick_spec_binds known_bndrs [] = [] + pick_spec_binds _ [] = [] pick_spec_binds known_bndrs (bind:binds) | all keep_me (rhssOfBind bind) - , let known_bndrs' = known_bndrs `extendVarSetList` bindersOfBind bind + , let known_bndrs' = known_bndrs `extendVarSetList` bindersOf bind = bind : pick_spec_binds known_bndrs' binds | otherwise = pick_spec_binds known_bndrs binds where - keep_me rhs = isEmptyVarSet (exprSomFreeVars bad_var rhs) - bad_var v = v `elemVarSet` orig_bndrs && not (bndr `elemVarSet` known_bndrs) + keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) + bad_var v = v `elemVarSet` orig_bndrs && not (v `elemVarSet` known_bndrs) + +getCastedVar :: CoreExpr -> Maybe (Var, MCoercionR) +getCastedVar (Var v) = Just (v, MRefl) +getCastedVar (Cast (Var v) co) = Just (v, MCo co) +getCastedVar _ = Nothing {- where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50938910c2f24225d8f2b547abf534c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50938910c2f24225d8f2b547abf534c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/fix-25406
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/fix-25406 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/rm-ci-timings
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/rm-ci-timings at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/fix-912-bootstrap
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/fix-912-bootstrap at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/rm-showBreakArray
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/rm-showBreakArray at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/fix-putWithTables
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/fix-putWithTables at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/wasm-jsffi-sync-export
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/wasm-jsffi-sync-export at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0