[Git][ghc/ghc][wip/T25282] Expose ghc-internal unit id through the settings file
by Teo Camarasu (＠teo) 20 Jun '25
by Teo Camarasu (＠teo) 20 Jun '25
20 Jun '25
Teo Camarasu pushed to branch wip/T25282 at Glasgow Haskell Compiler / GHC
Commits:
cdf55d41 by Teo Camarasu at 2025-06-20T14:31:58+01:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
3 changed files:
- compiler/GHC/Driver/Session.hs
- compiler/Setup.hs
- hadrian/src/Rules/Generate.hs
Changes:
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3459,6 +3459,7 @@ compilerInfo dflags
("Project Patch Level1", cProjectPatchLevel1),
("Project Patch Level2", cProjectPatchLevel2),
("Project Unit Id", cProjectUnitId),
+ ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids]
("Booter version", cBooterVersion),
("Stage", cStage),
("Build platform", cBuildPlatformString),
@@ -3512,6 +3513,23 @@ compilerInfo dflags
expandDirectories :: FilePath -> Maybe FilePath -> String -> String
expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd
+-- Note [Special unit-ids]
+-- ~~~~~~~~~~~~~~~~~~~~~~~
+-- Certain units are special to the compiler:
+-- - Wired-in identifiers reference a specific unit-id of `ghc-internal`.
+-- - GHC plugins must be linked against a specific unit-id of `ghc`,
+-- namely the same one as the compiler.
+-- - When using Template Haskell, splices refer to the Template Haskell
+-- interface defined in `ghc-internal`, and must be linked against the same
+-- unit-id as the compiler.
+--
+-- We therefore expose the unit-id of `ghc-internal` ("ghc-internal Unit Id") and
+-- ghc ("Project Unit Id") through `ghc --info`.
+--
+-- This allows build tools to act accordingly, eg, if a user wishes to build a
+-- GHC plugin, `cabal-install` might force them to use the exact `ghc` unit
+-- that the compiler was linked against.
+
{- -----------------------------------------------------------------------------
Note [DynFlags consistency]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/Setup.hs
=====================================
@@ -22,6 +22,7 @@ import qualified Data.Map as Map
import GHC.ResponseFile
import System.Environment
+
main :: IO ()
main = defaultMainWithHooks ghcHooks
where
@@ -56,7 +57,7 @@ primopIncls =
]
ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
-ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap}
+ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPackageIndex}
= do
-- Get compiler/ root directory from the cabal file
let Just compilerRoot = takeDirectory <$> pkgDescrFile
@@ -96,9 +97,16 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM
Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId
_ -> error "Couldn't find unique cabal library when building ghc"
+ let cGhcInternalUnitId = case Map.lookup (mkPackageName "ghc-internal", LMainLibName) $ packageIdIndex installedPackageIndex of
+ Just versions
+ -- We assume there is exactly one copy of `ghc-internal` in our dependency closure
+ | [[packageInfo]] <- Map.values versions
+ -> unUnitId $ installedUnitId packageInfo
+ _ -> error "Couldn't find unique ghc-internal library when building ghc"
+
-- Write GHC.Settings.Config
configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs"
- configHs = generateConfigHs cProjectUnitId settings
+ configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings
createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath)
rewriteFileEx verbosity configHsPath configHs
@@ -110,8 +118,9 @@ getSetting settings kh kr = go settings kr
Just v -> Right v
generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key
+ -> String -- ^ ghc-internal's cabal-generated unit-id, which matches its package-id/key
-> [(String,String)] -> String
-generateConfigHs cProjectUnitId settings = either error id $ do
+generateConfigHs cProjectUnitId cGhcInternalUnitId settings = either error id $ do
let getSetting' = getSetting $ (("cStage","2"):) settings
buildPlatform <- getSetting' "cBuildPlatformString" "Host platform"
hostPlatform <- getSetting' "cHostPlatformString" "Target platform"
@@ -127,6 +136,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do
, " , cBooterVersion"
, " , cStage"
, " , cProjectUnitId"
+ , " , cGhcInternalUnitId"
, " ) where"
, ""
, "import GHC.Prelude.Basic"
@@ -150,4 +160,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do
, ""
, "cProjectUnitId :: String"
, "cProjectUnitId = " ++ show cProjectUnitId
+ , ""
+ , "cGhcInternalUnitId :: String"
+ , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId
]
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -601,6 +601,8 @@ generateConfigHs = do
-- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the
-- unit-id in both situations.
cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage
+
+ cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage
return $ unlines
[ "module GHC.Settings.Config"
, " ( module GHC.Version"
@@ -610,6 +612,7 @@ generateConfigHs = do
, " , cBooterVersion"
, " , cStage"
, " , cProjectUnitId"
+ , " , cGhcInternalUnitId"
, " ) where"
, ""
, "import GHC.Prelude.Basic"
@@ -633,6 +636,9 @@ generateConfigHs = do
, ""
, "cProjectUnitId :: String"
, "cProjectUnitId = " ++ show cProjectUnitId
+ , ""
+ , "cGhcInternalUnitId :: String"
+ , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId
]
where
stageString (Stage0 InTreeLibs) = "1"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdf55d41c4a7547716f2f79696c7793…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdf55d41c4a7547716f2f79696c7793…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T25282] Expose ghc-internal unit id through the settings file
by Teo Camarasu (＠teo) 20 Jun '25
by Teo Camarasu (＠teo) 20 Jun '25
20 Jun '25
Teo Camarasu pushed to branch wip/T25282 at Glasgow Haskell Compiler / GHC
Commits:
1b88c0dc by Teo Camarasu at 2025-06-20T14:29:11+01:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
3 changed files:
- compiler/GHC/Driver/Session.hs
- compiler/Setup.hs
- hadrian/src/Rules/Generate.hs
Changes:
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3459,6 +3459,7 @@ compilerInfo dflags
("Project Patch Level1", cProjectPatchLevel1),
("Project Patch Level2", cProjectPatchLevel2),
("Project Unit Id", cProjectUnitId),
+ ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids]
("Booter version", cBooterVersion),
("Stage", cStage),
("Build platform", cBuildPlatformString),
@@ -3512,6 +3513,23 @@ compilerInfo dflags
expandDirectories :: FilePath -> Maybe FilePath -> String -> String
expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd
+-- Note [Special unit-ids]
+-- ~~~~~~~~~~~~~~~~~~~~~~~
+-- Certain units are special to the compiler:
+-- - Wired-in identifiers reference a specific unit-id of `ghc-internal`.
+-- - GHC plugins must be linked against a specific unit-id of `ghc`,
+-- namely the same one as the compiler.
+-- - When using Template Haskell, splices refer to the Template Haskell
+-- interface defined in `ghc-internal`, and must be linked against the same
+-- unit-id as the compiler.
+--
+-- We therefore expose the unit-id of `ghc-internal` ("ghc-internal Unit Id") and
+-- ghc ("Project Unit Id") through `ghc --info`.
+--
+-- This allows build tools to act accordingly, eg, if a user wishes to build a
+-- GHC plugin, `cabal-install` might force them to use the exact `ghc` unit
+-- that the compiler was linked against.
+
{- -----------------------------------------------------------------------------
Note [DynFlags consistency]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/Setup.hs
=====================================
@@ -22,6 +22,9 @@ import qualified Data.Map as Map
import GHC.ResponseFile
import System.Environment
+import Debug.Trace
+
+
main :: IO ()
main = defaultMainWithHooks ghcHooks
where
@@ -56,7 +59,7 @@ primopIncls =
]
ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
-ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap}
+ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPackageIndex}
= do
-- Get compiler/ root directory from the cabal file
let Just compilerRoot = takeDirectory <$> pkgDescrFile
@@ -96,9 +99,16 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM
Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId
_ -> error "Couldn't find unique cabal library when building ghc"
+ let cGhcInternalUnitId = case Map.lookup (mkPackageName "ghc-internal", LMainLibName) $ packageIdIndex installedPackageIndex of
+ Just versions
+ -- We assume there is exactly one copy of `ghc-internal` in our dependency closure
+ | [[packageInfo]] <- Map.values versions
+ -> unUnitId $ installedUnitId packageInfo
+ _ -> error "Couldn't find unique ghc-internal library when building ghc"
+
-- Write GHC.Settings.Config
configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs"
- configHs = generateConfigHs cProjectUnitId settings
+ configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings
createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath)
rewriteFileEx verbosity configHsPath configHs
@@ -110,8 +120,9 @@ getSetting settings kh kr = go settings kr
Just v -> Right v
generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key
+ -> String -- ^ ghc-internal's cabal-generated unit-id, which matches its package-id/key
-> [(String,String)] -> String
-generateConfigHs cProjectUnitId settings = either error id $ do
+generateConfigHs cProjectUnitId cGhcInternalUnitId settings = either error id $ do
let getSetting' = getSetting $ (("cStage","2"):) settings
buildPlatform <- getSetting' "cBuildPlatformString" "Host platform"
hostPlatform <- getSetting' "cHostPlatformString" "Target platform"
@@ -127,6 +138,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do
, " , cBooterVersion"
, " , cStage"
, " , cProjectUnitId"
+ , " , cGhcInternalUnitId"
, " ) where"
, ""
, "import GHC.Prelude.Basic"
@@ -150,4 +162,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do
, ""
, "cProjectUnitId :: String"
, "cProjectUnitId = " ++ show cProjectUnitId
+ , ""
+ , "cGhcInternalUnitId :: String"
+ , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId
]
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -601,6 +601,8 @@ generateConfigHs = do
-- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the
-- unit-id in both situations.
cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage
+
+ cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage
return $ unlines
[ "module GHC.Settings.Config"
, " ( module GHC.Version"
@@ -610,6 +612,7 @@ generateConfigHs = do
, " , cBooterVersion"
, " , cStage"
, " , cProjectUnitId"
+ , " , cGhcInternalUnitId"
, " ) where"
, ""
, "import GHC.Prelude.Basic"
@@ -633,6 +636,9 @@ generateConfigHs = do
, ""
, "cProjectUnitId :: String"
, "cProjectUnitId = " ++ show cProjectUnitId
+ , ""
+ , "cGhcInternalUnitId :: String"
+ , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId
]
where
stageString (Stage0 InTreeLibs) = "1"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b88c0dc12f4882d4d676dfb97945bc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b88c0dc12f4882d4d676dfb97945bc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC
Commits:
d765a871 by Simon Peyton Jones at 2025-06-20T13:07:04+01:00
Further iteration
Needs documentation
- - - - -
1 changed file:
- compiler/GHC/HsToCore/Binds.hs
Changes:
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -57,6 +57,7 @@ import GHC.Core.TyCon
import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.Rules
+import GHC.Core.Ppr( pprCoreBinders )
import GHC.Core.TyCo.Compare( eqType )
import GHC.Builtin.Names
@@ -1002,6 +1003,88 @@ when we would rather avoid passing both dictionaries, and instead generate:
$sg @c d = let { d1 = $p1Ord d; d2 = d } in <g-rhs> @c @c d1 d2
For now, we accept this infelicity.
+
+Note [Desugaring new-form SPECIALISE pragmas] -- Take 2
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we have
+ f :: forall a b c d. (Ord a, Ord b, Eq c, Ix d) => ...
+ f = rhs
+ {-# SPECIALISE f @p @[p] @[Int] @(q,r) #-}
+
+The type-checker generates `the_call` which looks like
+
+ spe_bndrs = (dx1 :: Ord p) (dx2::Ix q) (dx3::Ix r)
+ the_call = let d6 = dx1
+ d2 = $fOrdList d6
+ d3 = $fEqList $fEqInt
+ d7 = dx1 -- Solver may introduce
+ d1 = d7 -- these indirections
+ d4 = $fIxPair dx2 dx3
+ in f @p @p @[Int] @(q,r)
+ (d1::Ord p) (d2::Ord [p]) (d3::Eq [Int]) (d4::Ix (q,r)
+
+We /could/ generate
+ RULE f d1 d2 d3 d4 e1..en = $sf d1 d2 d3 d4
+ $sf d1 d2 d3 d4 = <rhs> d1 d2 d3 d4
+
+But that would do no specialisation! What we want is this:
+ RULE f d1 _d2 _d3 d4 e1..en = $sf d1 d4
+ $sf d1 d4 = let d7 = d1 -- Renaming
+ dx1 = d7 -- Renaming
+ d6 = dx1
+ d2 = $fOrdList d6
+ d3 = $fEqList $fEqInt
+ in rhs d1 d2 d3 d4
+
+Notice that:
+ * We pass some, but not all, of the matched dictionaries to $sf
+
+ * We get specialisations for d2 and d3, but not for d1, nor d4.
+
+ * We had to introduce some renaming bindings at the top
+ to line things up
+
+The transformation goes in these steps
+(S1) decomposeCall: decomopose `the_call` into
+ - `rev_binds`: the enclosing let-bindings (actually reversed)
+ - `rule_lhs_args`: the arguments of the call itself
+ We carefully arrange that the dictionary arguments of the actual
+ call, `rule_lhs_args` are all distinct dictionary variables,
+ not expressions. How? We use `simpleOptExprNoInline` to avoid
+ inlining the let-bindings.
+
+(S2) Compute `rule_bndrs`: the free vars of `rule_lhs_args`, which
+ will be the forall'd template variables of the RULE. In the example,
+ rule_bndrs = d1,d2,d3,d4
+
+(S3) grabSpecBinds: transform `rev_binds` into `spec_binds`: the
+ bindings we will wrap around the call in the RHS of `$sf`
+
+(S4) Find `spec_bndrs`, the subset of `rule_bndrs` that we actually
+ need to pass to `$sf`, simply by filtering out those that are
+ bound by `spec_binds`. In the example
+ spec_bndrs = d1,d4
+
+
+ Working inner
+* Grab any bindings we can that will "shadow" the forall'd
+ rule-bndrs, giving specialised bindings for them.
+ * We keep a set of known_bndrs starting with {d1,..,dn}
+ * We keep a binding iff no free var is
+ (a) in orig_bndrs (i.e. not totally free)
+ (b) not in known_bndrs
+ * If we keep it, add its binder to known_bndrs; if not, don't
+
+To maximise what we can "grab", start by extracting /renamings/ of the
+forall'd rule_bndrs, and bringing them to the top. A renaming is
+ rule_bndr = d
+If we see this:
+ * Bring d=rule_bndr to the top
+ * Add d to the set of variables to look for on the right.
+ e.g. rule_bndrs = d1, d2
+ Bindings { d7=d9; d1=d7 }
+ Bring to the top { d7=d1; d9=d7 }
+
-}
------------------------
@@ -1083,13 +1166,18 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call
Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call)
; return Nothing } ;
- Just (rev_binds, rule_lhs_args) ->
+ Just (binds, rule_lhs_args) ->
+
+ do { let locals = mkVarSet orig_bndrs `extendVarSetList` bindersOfBinds binds
+ is_local :: Var -> Bool
+ is_local v = v `elemVarSet` locals
+
+ rule_bndrs = scopedSort (exprsSomeFreeVarsList is_local rule_lhs_args)
+ rn_binds = getRenamings orig_bndrs binds rule_bndrs
+
+ spec_binds = pickSpecBinds is_local (mkVarSet rule_bndrs)
+ (rn_binds ++ binds)
- do { let orig_bndr_set = mkVarSet orig_bndrs
- 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)
spec_bndrs = filterOut (`elemVarSet` spec_binds_bndr_set) rule_bndrs
@@ -1101,13 +1189,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 "orig_bndrs" <+> ppr orig_bndrs
+ , text "orig_bndrs" <+> pprCoreBinders orig_bndrs
, text "ds_call" <+> ppr ds_call
, text "core_call" <+> ppr core_call
- , text "rev_binds" <+> ppr rev_binds
+ , text "binds" <+> ppr binds
, text "rule_bndrs" <+> ppr rule_bndrs
, text "rule_lhs_args" <+> ppr rule_lhs_args
, text "spec_bndrs" <+> ppr spec_bndrs
+ , text "rn_binds" <+> ppr rn_binds
, text "spec_binds" <+> ppr spec_binds ]
; finishSpecPrag poly_nm poly_rhs
@@ -1115,7 +1204,7 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call
spec_bndrs mk_spec_body inl } } }
decomposeCall :: Id -> CoreExpr
- -> Maybe ( [CoreBind] -- Reversed bindings
+ -> Maybe ( [CoreBind]
, [CoreExpr] ) -- Args of the call
decomposeCall poly_id binds
= go [] binds
@@ -1125,42 +1214,78 @@ decomposeCall poly_id binds
go acc e
| (Var fun, args) <- collectArgs e
= assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $
- Just (acc, args)
+ Just (reverse acc, args)
| otherwise
= Nothing
+getRenamings :: [Var] -> [CoreBind] -- orig_bndrs and bindings
+ -> [Var] -- rule_bndrs
+ -> [CoreBind] -- Binds some of the orig_bndrs to a rule_bndr
+getRenamings orig_bndrs binds rule_bndrs
+ = [ NonRec b e | b <- orig_bndrs
+ , not (b `elem` rule_bndrs)
+ , Just e <- [lookupVarEnv final_renamings b] ]
+ where
+ init_renamings, final_renamings :: IdEnv CoreExpr
+ -- In this function, IdEnv maps a local variable to (v |> co),
+ -- where `v` is a rule_bndr
+
+ init_renamings = mkVarEnv [ (v, Var v) | v <- rule_bndrs, isId v ]
+ final_renamings = go binds
+
+ go :: [CoreBind] -> IdEnv CoreExpr
+ go [] = init_renamings
+ go (bind : binds)
+ | NonRec b rhs <- bind
+ , Just (v, mco) <- getCastedVar rhs
+ , Just e <- lookupVarEnv renamings v
+ = extendVarEnv renamings b (mkCastMCo e (mkSymMCo mco))
+ | otherwise
+ = renamings
+ where
+ renamings = go binds
-grabSpecBinds :: VarSet -> VarSet -> [CoreBind] -> [CoreBind]
-grabSpecBinds orig_bndrs rule_bndrs rev_binds
- = reverse rename_binds ++ spec_binds
+pickSpecBinds :: (Var -> Bool) -> VarSet -> [CoreBind] -> [CoreBind]
+pickSpecBinds _ _ [] = []
+pickSpecBinds is_local known_bndrs (bind:binds)
+ | all keep_me (rhssOfBind bind)
+ , let known_bndrs' = known_bndrs `extendVarSetList` bindersOf bind
+ = bind : pickSpecBinds is_local known_bndrs' binds
+ | otherwise
+ = pickSpecBinds is_local known_bndrs binds
+ where
+ keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs)
+ bad_var v = is_local v && not (v `elemVarSet` known_bndrs)
+{-
+grabSpecBinds :: (Var -> Bool) -> VarSet -> [CoreBind]
+ -> ([CoreBind], [CoreBind])
+grabSpecBinds is_local rule_bndrs rev_binds
+ = (reverse rename_binds, spec_binds)
where
(known_bndrs, (rename_binds, other_binds))
- = get_renamings orig_bndrs rule_bndrs ([],[]) rev_binds
+ = get_renamings rule_bndrs ([],[]) rev_binds
spec_binds = pick_spec_binds known_bndrs other_binds
------------------------
- get_renamings :: VarSet -- Locally bound variables
- -> VarSet -- Variables bound by a successful match on the call
+ get_renamings :: 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 _ bndrs acc [] = (bndrs, acc)
+ get_renamings bndrs acc [] = (bndrs, acc)
- get_renamings locals bndrs (rn_binds, other_binds) (bind : binds)
+ get_renamings bndrs (rn_binds, other_binds) (bind : binds)
| NonRec d r <- bind
, d `elemVarSet` bndrs
, Just (v, mco) <- getCastedVar r
- , v `elemVarSet` locals
+ , is_local v
, 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
- (locals `extendVarSetList` bindersOf bind)
(rn_binds, bind:other_binds)
binds
@@ -1175,7 +1300,8 @@ grabSpecBinds orig_bndrs rule_bndrs rev_binds
= pick_spec_binds known_bndrs binds
where
keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs)
- bad_var v = v `elemVarSet` orig_bndrs && not (v `elemVarSet` known_bndrs)
+ bad_var v = is_local v && not (v `elemVarSet` known_bndrs)
+-}
getCastedVar :: CoreExpr -> Maybe (Var, MCoercionR)
getCastedVar (Var v) = Just (v, MRefl)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d765a87164bdffd2a6494108b3fbcf1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d765a87164bdffd2a6494108b3fbcf1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/supersven/ghc-9.12.2-release+jumptable-fix] compiler: Fix CPP guards around ghc_unique_counter64
by Sven Tennie (＠supersven) 20 Jun '25
by Sven Tennie (＠supersven) 20 Jun '25
20 Jun '25
Sven Tennie pushed to branch wip/supersven/ghc-9.12.2-release+jumptable-fix at Glasgow Haskell Compiler / GHC
Commits:
5a7cc5ff by Ben Gamari at 2025-06-19T12:33:17+00:00
compiler: Fix CPP guards around ghc_unique_counter64
The `ghc_unique_counter64` symbol was introduced in the RTS in the
64-bit unique refactor (!10568) which has been backported to %9.6.7 and
%9.8.4. Update the CPP to reflect this.
Fixes #25576.
- - - - -
1 changed file:
- compiler/cbits/genSym.c
Changes:
=====================================
compiler/cbits/genSym.c
=====================================
@@ -9,7 +9,19 @@
//
// The CPP is thus about the RTS version GHC is linked against, and not the
// version of the GHC being built.
-#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0)
+
+#if MIN_VERSION_GLASGOW_HASKELL(9,9,0,0)
+// Unique64 patch was present in 9.10 and later
+#define HAVE_UNIQUE64 1
+#elif !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) && MIN_VERSION_GLASGOW_HASKELL(9,8,4,0)
+// Unique64 patch was backported to 9.8.4
+#define HAVE_UNIQUE64 1
+#elif !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) && MIN_VERSION_GLASGOW_HASKELL(9,6,7,0)
+// Unique64 patch was backported to 9.6.7
+#define HAVE_UNIQUE64 1
+#endif
+
+#if !defined(HAVE_UNIQUE64)
HsWord64 ghc_unique_counter64 = 0;
#endif
#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a7cc5fffbc37ed420cc59a81c8f6d0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a7cc5fffbc37ed420cc59a81c8f6d0…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/az/ghc-cpp] 139 commits: MachRegs.h: Don't define NO_ARG_REGS when a XMM register is defined
by Alan Zimmerman (＠alanz) 19 Jun '25
by Alan Zimmerman (＠alanz) 19 Jun '25
19 Jun '25
Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC
Commits:
e64b3f16 by ARATA Mizuki at 2025-06-17T10:13:42+09:00
MachRegs.h: Don't define NO_ARG_REGS when a XMM register is defined
On i386, MAX_REAL_VANILLA_REG is 1, but MAX_REAL_XMM_REG is 4.
If we define NO_ARG_REGS on i386, programs that use SIMD vectors may segfault.
Closes #25985
A couple of notes on the BROKEN_TESTS field:
* This fixes the segfault from T25062_V16.
* The failure from T22187_run was fixed in an earlier commit (see #25561),
but BROKEN_TESTS was missed at that time. Now should be a good time to
mark it fixed.
- - - - -
3e7c6b4d by Matthew Pickering at 2025-06-18T15:34:04-04:00
Improve error messages when implicit lifting fails
This patch concerns programs which automatically try to fix level errors
by inserting `Lift`. For example:
```
foo x = [| x |]
~>
foo x = [| $(lift x) |]
```
Before, there were two problems with the message.
1. (#26031), the location of the error was reported as the whole
quotation.
2. (#26035), the message just mentions there is no Lift instance, but
gives no indicate why the user program needed a Lift instance in the
first place.
This problem is especially bad when you disable
`ImplicitStagePersistence`, so you just end up with a confusing "No
instance for" message rather than an error message about levels
This patch fixes both these issues.
Firstly, `PendingRnSplice` differentiates between a user-written splice
and an implicit lift. Then, the Lift instance is precisely requested
with a specific origin in the typechecker. If the instance fails to be
solved, the message is reported using the `TcRnBadlyLevelled`
constructor (like a normal level error).
Fixes #26031, #26035
- - - - -
44b8cee2 by Cheng Shao at 2025-06-18T15:34:46-04:00
testsuite: add T26120 marked as broken
- - - - -
894a04f3 by Cheng Shao at 2025-06-18T15:34:46-04:00
compiler: fix GHC.SysTools.Ar archive member size writing logic
This patch fixes a long-standing bug in `GHC.SysTools.Ar` that emits
the wrong archive member size in each archive header. It should encode
the exact length of the member payload, excluding any padding byte,
otherwise malformed archive that extracts a broken object with an
extra trailing byte could be created.
Apart from the in-tree `T26120` test, I've also created an out-of-tree
testsuite at https://github.com/TerrorJack/ghc-ar-quickcheck that
contains QuickCheck roundtrip tests for `GHC.SysTools.Ar`. With this
fix, simple roundtrip tests and `writeGNUAr`/GNU `ar` roundtrip test
passes. There might be more bugs lurking in here, but this patch is
still a critical bugfix already.
Fixes #26120 #22586.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
f677ab5f by Lauren Yim at 2025-06-18T15:35:37-04:00
fix some typos in the warnings page in the user guide
- - - - -
b968e1c1 by Rodrigo Mesquita at 2025-06-18T15:36:18-04:00
Add a frozen callstack to throwGhcException
Fixes #25956
- - - - -
a5e0c3a3 by fendor at 2025-06-18T15:36:59-04:00
Update using.rst to advertise full mhu support for GHCi
- - - - -
889b8815 by Alan Zimmerman at 2025-06-18T21:22:34+01:00
GHC-CPP: first rough proof of concept
Processes
#define FOO
#ifdef FOO
x = 1
#endif
Into
[ITcppIgnored [L loc ITcppDefine]
,ITcppIgnored [L loc ITcppIfdef]
,ITvarid "x"
,ITequal
,ITinteger (IL {il_text = SourceText "1", il_neg = False, il_value = 1})
,ITcppIgnored [L loc ITcppEndif]
,ITeof]
In time, ITcppIgnored will be pushed into a comment
- - - - -
4ebf2101 by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Tidy up before re-visiting the continuation mechanic
- - - - -
f0dd0257 by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Switch preprocessor to continuation passing style
Proof of concept, needs tidying up
- - - - -
604d1a13 by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Small cleanup
- - - - -
fb58338d by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Get rid of some cruft
- - - - -
778123da by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Starting to integrate.
Need to get the pragma recognised and set
- - - - -
946016da by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Make cppTokens extend to end of line, and process CPP comments
- - - - -
c8b03ee1 by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Remove unused ITcppDefined
- - - - -
1de0f0e3 by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Allow spaces between # and keyword for preprocessor directive
- - - - -
088fcc53 by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Process CPP continuation lines
They are emited as separate ITcppContinue tokens.
Perhaps the processing should be more like a comment, and keep on
going to the end.
BUT, the last line needs to be slurped as a whole.
- - - - -
9fe0f67a by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Accumulate CPP continuations, process when ready
Can be simplified further, we only need one CPP token
- - - - -
bcb05807 by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Simplify Lexer interface. Only ITcpp
We transfer directive lines through it, then parse them from scratch
in the preprocessor.
- - - - -
18cce45b by Alan Zimmerman at 2025-06-18T21:22:34+01:00
Deal with directive on last line, with no trailing \n
- - - - -
01804178 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Start parsing and processing the directives
- - - - -
9369dfeb by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Prepare for processing include files
- - - - -
2c498ca4 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Move PpState into PreProcess
And initParserState, initPragState too
- - - - -
08dc4d62 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Process nested include files
Also move PpState out of Lexer.x, so it is easy to evolve it in a ghci
session, loading utils/check-cpp/Main.hs
- - - - -
9b8af447 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Split into separate files
- - - - -
462d0b45 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Starting on expression parser.
But it hangs. Time for Text.Parsec.Expr
- - - - -
9a0bb0ac by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Start integrating the ghc-cpp work
From https://github.com/alanz/ghc-cpp
- - - - -
3d703f19 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
WIP
- - - - -
8c8ab9de by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Fixup after rebase
- - - - -
292f6173 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
WIP
- - - - -
aa1d4f99 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Fixup after rebase, including all tests pass
- - - - -
5b20ff87 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Change pragma usage to GHC_CPP from GhcCPP
- - - - -
3d2e444d by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Some comments
- - - - -
9bbf6ba8 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Reformat
- - - - -
f470c7b5 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Delete unused file
- - - - -
eff62de5 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Rename module Parse to ParsePP
- - - - -
e66be481 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Clarify naming in the parser
- - - - -
a0224ad1 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
WIP. Switching to alex/happy to be able to work in-tree
Since Parsec is not available
- - - - -
2cef2273 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Layering is now correct
- GHC lexer, emits CPP tokens
- accumulated in Preprocessor state
- Lexed by CPP lexer, CPP command extracted, tokens concated with
spaces (to get rid of token pasting via comments)
- if directive lexed and parsed by CPP lexer/parser, and evaluated
- - - - -
9878bce6 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
First example working
Loading Example1.hs into ghci, getting the right results
```
{-# LANGUAGE GHC_CPP #-}
module Example1 where
y = 3
x =
"hello"
"bye now"
foo = putStrLn x
```
- - - - -
411767d9 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Rebase, and all tests pass except whitespace for generated parser
- - - - -
2a92b35c by Alan Zimmerman at 2025-06-18T21:22:35+01:00
More plumbing. Ready for testing tomorrow.
- - - - -
53d2399c by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Proress. Renamed module State from Types
And at first blush it seems to handle preprocessor scopes properly.
- - - - -
5703c1a9 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Insert basic GHC version macros into parser
__GLASGOW_HASKELL__
__GLASGOW_HASKELL_FULL_VERSION__
__GLASGOW_HASKELL_PATCHLEVEL1__
__GLASGOW_HASKELL_PATCHLEVEL2__
- - - - -
914c0931 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Re-sync check-cpp for easy ghci work
- - - - -
3f227991 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Get rid of warnings
- - - - -
5e878d93 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Rework macro processing, in check-cpp
Macros kept at the top level, looked up via name, multiple arity
versions per name can be stored
- - - - -
e7bdaaa4 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
WIP. Can crack arguments for #define
Next step it to crack out args in an expansion
- - - - -
373f9916 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
WIP on arg parsing.
- - - - -
d8d130c5 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Progress. Still screwing up nested parens.
- - - - -
0080df4a by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Seems to work, but has redundant code
- - - - -
686084ca by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Remove redundant code
- - - - -
b378b0e9 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Reformat
- - - - -
9be9de1f by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Expand args, single pass
Still need to repeat until fixpoint
- - - - -
4fe1d38e by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Fixed point expansion
- - - - -
2c868e15 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Sync the playground to compiler
- - - - -
65e5a420 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Working on dumping the GHC_CPP result
But We need to keep the BufSpan in a comment
- - - - -
305ffb14 by Alan Zimmerman at 2025-06-18T21:22:35+01:00
Keep BufSpan in queued comments in GHC.Parser.Lexer
- - - - -
54a1c9ff by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Getting close to being able to print the combined tokens
showing what is in and what is out
- - - - -
e6924494 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
First implementation of dumpGhcCpp.
Example output
First dumps all macros in the state, then the source, showing which
lines are in and which are out
------------------------------
- |#define FOO(A,B) A + B
- |#define FOO(A,B,C) A + B + C
- |#if FOO(1,FOO(3,4)) == 8
- |-- a comment
|x = 1
- |#else
- |x = 5
- |#endif
- - - - -
6c893315 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Clean up a bit
- - - - -
89e1cd84 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Add -ddump-ghc-cpp option and a test based on it
- - - - -
13daa03f by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Restore Lexer.x rules, we need them for continuation lines
- - - - -
bc439ea3 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Lexer.x: trying to sort out the span for continuations
- We need to match on \n at the end of the line
- We cannot simply back up for it
- - - - -
332ddab7 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Inserts predefined macros. But does not dump properly
Because the cpp tokens have a trailing newline
- - - - -
50f40f1f by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Remove unnecessary LExer rules
We *need* the ones that explicitly match to the end of the line.
- - - - -
b5a9732b by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Generate correct span for ITcpp
Dump now works, except we do not render trailing `\` for continuation
lines. This is good enough for use in test output.
- - - - -
6307a622 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Reduce duplication in lexer
- - - - -
ae9cb89a by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Tweaks
- - - - -
74f31b10 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Insert min_version predefined macros into state
The mechanism now works. Still need to flesh out the full set.
- - - - -
cd087f21 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Trying my alternative pragma syntax.
It works, but dumpGhcCpp is broken, I suspect from the ITcpp token
span update.
- - - - -
eaeefb34 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Pragma extraction now works, with both CPP and GHC_CPP
For the following
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 913
{-# LANGUAGE GHC_CPP #-}
#endif
We will enable GHC_CPP only
- - - - -
fe4d273e by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Remove some tracing
- - - - -
35f675b0 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Fix test exes for changes
- - - - -
d4500988 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
For GHC_CPP tests, normalise config-time-based macros
- - - - -
2f99928b by Alan Zimmerman at 2025-06-18T21:22:36+01:00
WIP
- - - - -
64bd6a23 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
WIP again. What is wrong?
- - - - -
1f2a83b4 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Revert to dynflags for normal not pragma lexing
- - - - -
2225db35 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Working on getting check-exact to work properly
- - - - -
30aa16de by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Passes CppCommentPlacement test
- - - - -
408b4722 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Starting on exact printing with GHC_CPP
While overriding normal CPP
- - - - -
420548f5 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Correctly store CPP ignored tokens as comments
By populating the lexeme string in it, based on the bufpos
- - - - -
4a1a04ef by Alan Zimmerman at 2025-06-18T21:22:36+01:00
WIP
- - - - -
279e41d4 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Simplifying
- - - - -
2f0d4d97 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Update the active state logic
- - - - -
9ef48795 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Work the new logic into the mainline code
- - - - -
80428aaa by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Process `defined` operator
- - - - -
f65a0d9d by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Manage lexer state while skipping tokens
There is very intricate layout-related state used when lexing. If a
CPP directive blanks out some tokens, store this state when the
blanking starts, and restore it when they are no longer being blanked.
- - - - -
2f12dffd by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Track the last token buffer index, for ITCppIgnored
We need to attach the source being skipped in an ITCppIgnored token.
We cannot simply use its BufSpan as an index into the underlying
StringBuffer as it counts unicode chars, not bytes.
So we update the lexer state to store the starting StringBuffer
location for the last token, and use the already-stored length to
extract the correct portion of the StringBuffer being parsed.
- - - - -
0fff4ce8 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Process the ! operator in GHC_CPP expressions
- - - - -
7245df41 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Predefine a constant when GHC_CPP is being used.
- - - - -
c32f169a by Alan Zimmerman at 2025-06-18T21:22:36+01:00
WIP
- - - - -
f79d8ae6 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Skip lines directly in the lexer when required
- - - - -
eacc502e by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Properly manage location when accepting tokens again
- - - - -
46fc9d13 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Seems to be working now, for Example9
- - - - -
7189e97c by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Remove tracing
- - - - -
99eafc55 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Fix parsing '*' in block comments
Instead of replacing them with '-'
- - - - -
2ccb3354 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Keep the trailing backslash in a ITcpp token
- - - - -
96c0b70e by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Deal with only enabling one section of a group.
A group is an instance of a conditional introduced by
#if/#ifdef/#ifndef,
and ending at the final #endif, including intermediate #elsif sections
- - - - -
5270f370 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Replace remaining identifiers with 0 when evaluating
As per the spec
- - - - -
e35ede33 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Snapshot before rebase
- - - - -
bc8081ae by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Skip non-processed lines starting with #
- - - - -
37947b7e by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Export generateMacros so we can use it in ghc-exactprint
- - - - -
aec471b4 by Alan Zimmerman at 2025-06-18T21:22:36+01:00
Fix rebase
- - - - -
5b166f2a by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Expose initParserStateWithMacrosString
- - - - -
82accba8 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Fix buggy lexer cppSkip
It was skipping all lines, not just ones prefixed by #
- - - - -
015d27a7 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Fix evaluation of && to use the correct operator
- - - - -
fb7038b5 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Deal with closing #-} at the start of a line
- - - - -
28047dc8 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Add the MIN_VERSION_GLASGOW_HASKELL predefined macro
- - - - -
cd298351 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Include MIN_VERSION_GLASGOW_HASKELL in GhcCpp01.stderr
- - - - -
59fc66d0 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Use a strict map for macro defines
- - - - -
abc3d948 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Process TIdentifierLParen
Which only matters at the start of #define
- - - - -
4e145cd2 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Do not provide TIdentifierLParen paren twice
- - - - -
6dd33444 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Handle whitespace between identifier and '(' for directive only
- - - - -
d83ddd88 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Expose some Lexer bitmap manipulation helpers
- - - - -
2b4ae10c by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Deal with line pragmas as tokens
Blows up for dumpGhcCpp though
- - - - -
95ef50f2 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Allow strings delimited by a single quote too
- - - - -
d420e107 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Allow leading whitespace on cpp directives
As per https://timsong-cpp.github.io/cppwp/n4140/cpp#1
- - - - -
b36cc1ef by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Implement GHC_CPP undef
- - - - -
81286cbd by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Sort out expansion of no-arg macros, in a context with args
And make the expansion bottom out, in the case of recursion
- - - - -
775b9e53 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Fix GhcCpp01 test
The LINE pragma stuff works in ghc-exactprint when specifically
setting flag to emit ITline_pragma tokens
- - - - -
d0e96edd by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Process comments in CPP directives
- - - - -
23856d4d by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Correctly lex pragmas with finel #-} on a newline
- - - - -
6bd11f3d by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Do not process CPP-style comments
- - - - -
d502ce75 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Allow cpp-style comments when GHC_CPP enabled
- - - - -
3296c832 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Return other pragmas as cpp ignored when GHC_CPP active
- - - - -
a8f4a2a2 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Fix exactprinting default decl
- - - - -
0bf34347 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Reorganise getOptionsFromFile for use in ghc-exactprint
We want to be able to inject predefined macro definitions into the
parser preprocessor state for when we do a hackage roundtrip.
- - - - -
f5697190 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Tweak testing
- - - - -
72664c05 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Only allow unknown cpp pragmas with # in left margin
- - - - -
bb3524d9 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Require # against left margin for all GHC_CPP directives
- - - - -
1657e0cd by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Fix CPP directives appearing in pragmas
And add a test for error reporting for missing `#if`
- - - - -
1be508ef by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Starting to report GHC_CPP errors using GHC machinery
- - - - -
591b330e by Alan Zimmerman at 2025-06-18T21:22:37+01:00
More GHC_CPP diagnostic results
- - - - -
7d9e12b1 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
WIP on converting error calls to GHC diagnostics in GHC_CPP
- - - - -
5ed5378f by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Working on CPP diagnostic reporting
- - - - -
b64fea57 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Tweak some tests/lint warnings
- - - - -
9d91ca3e by Alan Zimmerman at 2025-06-18T21:22:37+01:00
More error reporting in Macro
- - - - -
ad20e507 by Alan Zimmerman at 2025-06-18T21:22:37+01:00
Some cleanups
- - - - -
136 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC.hs
- compiler/GHC/Cmm/Lexer.x
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Parser/Monad.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Config/Parser.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.hs-boot
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- + compiler/GHC/Parser/PreProcess.hs
- + compiler/GHC/Parser/PreProcess/Eval.hs
- + compiler/GHC/Parser/PreProcess/Lexer.x
- + compiler/GHC/Parser/PreProcess/Macro.hs
- + compiler/GHC/Parser/PreProcess/ParsePP.hs
- + compiler/GHC/Parser/PreProcess/Parser.y
- + compiler/GHC/Parser/PreProcess/ParserM.hs
- + compiler/GHC/Parser/PreProcess/State.hs
- compiler/GHC/Parser/Utils.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/SysTools/Ar.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Utils/Panic.hs
- compiler/ghc.cabal.in
- docs/users_guide/debugging.rst
- docs/users_guide/using-warnings.rst
- docs/users_guide/using.rst
- ghc/GHCi/UI.hs
- hadrian/src/Rules/SourceDist.hs
- hadrian/stack.yaml.lock
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- rts/include/stg/MachRegs.h
- testsuite/tests/annotations/should_fail/annfail03.stderr
- testsuite/tests/annotations/should_fail/annfail09.stderr
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/driver/T4437.hs
- testsuite/tests/ghc-api/T11579.hs
- + testsuite/tests/ghc-api/T26120.hs
- + testsuite/tests/ghc-api/T26120.stdout
- testsuite/tests/ghc-api/all.T
- + testsuite/tests/ghc-cpp/GhcCpp01.hs
- + testsuite/tests/ghc-cpp/GhcCpp01.stderr
- + testsuite/tests/ghc-cpp/GhcCpp02.hs
- + testsuite/tests/ghc-cpp/GhcCpp02.stderr
- + testsuite/tests/ghc-cpp/all.T
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- + testsuite/tests/printer/CppCommentPlacement.hs
- testsuite/tests/quasiquotation/qq001/qq001.stderr
- testsuite/tests/quasiquotation/qq002/qq002.stderr
- testsuite/tests/quasiquotation/qq003/qq003.stderr
- testsuite/tests/quasiquotation/qq004/qq004.stderr
- + testsuite/tests/quotes/LiftErrMsg.hs
- + testsuite/tests/quotes/LiftErrMsg.stderr
- + testsuite/tests/quotes/LiftErrMsgDefer.hs
- + testsuite/tests/quotes/LiftErrMsgDefer.stderr
- + testsuite/tests/quotes/LiftErrMsgTyped.hs
- + testsuite/tests/quotes/LiftErrMsgTyped.stderr
- testsuite/tests/quotes/T10384.stderr
- testsuite/tests/quotes/TH_localname.stderr
- testsuite/tests/quotes/all.T
- testsuite/tests/splice-imports/SI03.stderr
- testsuite/tests/splice-imports/SI05.stderr
- testsuite/tests/splice-imports/SI16.stderr
- testsuite/tests/splice-imports/SI18.stderr
- testsuite/tests/splice-imports/SI20.stderr
- testsuite/tests/splice-imports/SI25.stderr
- testsuite/tests/splice-imports/SI28.stderr
- testsuite/tests/splice-imports/SI31.stderr
- testsuite/tests/th/T16976z.stderr
- testsuite/tests/th/T17820a.stderr
- testsuite/tests/th/T17820b.stderr
- testsuite/tests/th/T17820c.stderr
- testsuite/tests/th/T17820d.stderr
- testsuite/tests/th/T17820e.stderr
- testsuite/tests/th/T23829_hasty.stderr
- testsuite/tests/th/T23829_hasty_b.stderr
- testsuite/tests/th/T5795.stderr
- + utils/check-cpp/.ghci
- + utils/check-cpp/.gitignore
- + utils/check-cpp/Eval.hs
- + utils/check-cpp/Example1.hs
- + utils/check-cpp/Example10.hs
- + utils/check-cpp/Example11.hs
- + utils/check-cpp/Example12.hs
- + utils/check-cpp/Example13.hs
- + utils/check-cpp/Example2.hs
- + utils/check-cpp/Example3.hs
- + utils/check-cpp/Example4.hs
- + utils/check-cpp/Example5.hs
- + utils/check-cpp/Example6.hs
- + utils/check-cpp/Example7.hs
- + utils/check-cpp/Example8.hs
- + utils/check-cpp/Example9.hs
- + utils/check-cpp/Lexer.x
- + utils/check-cpp/Macro.hs
- + utils/check-cpp/Main.hs
- + utils/check-cpp/ParsePP.hs
- + utils/check-cpp/ParseSimulate.hs
- + utils/check-cpp/Parser.y
- + utils/check-cpp/ParserM.hs
- + utils/check-cpp/PreProcess.hs
- + utils/check-cpp/README.md
- + utils/check-cpp/State.hs
- + utils/check-cpp/run.sh
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Preprocess.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c39a131a7440c04ce4f079dbaf4b9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c39a131a7440c04ce4f079dbaf4b9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-5] 2 commits: debugger: Implement step-out feature
by Rodrigo Mesquita (＠alt-romes) 19 Jun '25
by Rodrigo Mesquita (＠alt-romes) 19 Jun '25
19 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC
Commits:
20668d60 by Rodrigo Mesquita at 2025-06-19T13:12:21+01:00
debugger: Implement step-out feature
Implements support for stepping-out of a function (aka breaking right after
returning from a function) in the interactive debugger.
It also introduces a GHCi command :stepout to step-out of a function
being debugged in the interpreter. The feature is described as:
Stop at the first breakpoint immediately after returning from the current
function scope.
Known limitations: because a function tail-call does not push a stack
frame, if step-out is used inside of a function that was tail-called,
execution will not be returned to its caller, but rather its caller's
first non-tail caller. On the other hand, it means the debugger
follows the more realistic execution of the program.
In the following example:
.. code-block:: none
f = do
a
b <--- (1) set breakpoint then step in here
c
b = do
...
d <--- (2) step-into this tail call
d = do
...
something <--- (3) step-out here
...
Stepping-out will stop execution at the `c` invokation in `f`, rather than
stopping at `b`.
The key idea is simple: When step-out is enabled, traverse the runtime
stack until a continuation BCO is found -- and enable the breakpoint
heading that BCO explicitly using its tick-index.
The details are specified in `Note [Debugger: Step-out]` in `rts/Interpreter.c`.
Since PUSH_ALTS BCOs (representing case continuations) were never headed
by a breakpoint (unlike the case alternatives they push), we introduced
the BRK_ALTS instruction to allow the debugger to set a case
continuation to stop at the breakpoint heading the alternative that is
taken. This is further described in `Note [Debugger: BRK_ALTS]`.
Fixes #26042
- - - - -
8f0a3a46 by Rodrigo Mesquita at 2025-06-19T13:12:21+01:00
debugger: Filter step-out stops by SrcSpan
To implement step-out, the RTS looks for the first continuation frame on
the stack and explicitly enables its entry breakpoint. However, some
continuations will be contained in the function from which step-out was
initiated (trivial example is a case expression).
Similarly to steplocal, we will filter the breakpoints at which the RTS
yields to the debugger based on the SrcSpan. When doing step-out, only
stop if the breakpoint is /not/ contained in the function from which we
initiated it.
This is especially relevant in monadic statements such as IO which is
compiled to a long chain of case expressions.
See Note [Debugger: Filtering step-out stops]
- - - - -
44 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/Driver/Config.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Eval/Types.hs
- compiler/GHC/StgToByteCode.hs
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
- libraries/ghc-heap/tests/parse_tso_flags.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Interpreter.c
- rts/Interpreter.h
- rts/RtsSymbols.c
- rts/StgMiscClosures.cmm
- rts/include/rts/Bytecodes.h
- rts/include/rts/Constants.h
- rts/include/rts/storage/Closures.h
- + testsuite/tests/ghci.debugger/scripts/T26042b.hs
- + testsuite/tests/ghci.debugger/scripts/T26042b.script
- + testsuite/tests/ghci.debugger/scripts/T26042b.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042c.hs
- + testsuite/tests/ghci.debugger/scripts/T26042c.script
- + testsuite/tests/ghci.debugger/scripts/T26042c.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042d.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d.script
- + testsuite/tests/ghci.debugger/scripts/T26042d.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042e.hs
- + testsuite/tests/ghci.debugger/scripts/T26042e.script
- + testsuite/tests/ghci.debugger/scripts/T26042e.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042f.hs
- + testsuite/tests/ghci.debugger/scripts/T26042f.script
- + testsuite/tests/ghci.debugger/scripts/T26042f1.stderr
- + testsuite/tests/ghci.debugger/scripts/T26042f1.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042g.hs
- + testsuite/tests/ghci.debugger/scripts/T26042g.script
- + testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5df3c3fcec5b08ce8bd90ebed02be5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5df3c3fcec5b08ce8bd90ebed02be5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-5] debugger: Filter step-out stops by SrcSpan
by Rodrigo Mesquita (＠alt-romes) 19 Jun '25
by Rodrigo Mesquita (＠alt-romes) 19 Jun '25
19 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC
Commits:
5df3c3fc by Rodrigo Mesquita at 2025-06-19T12:59:26+01:00
debugger: Filter step-out stops by SrcSpan
To implement step-out, the RTS looks for the first continuation frame on
the stack and explicitly enables its entry breakpoint. However, some
continuations will be contained in the function from which step-out was
initiated (trivial example is a case expression).
Similarly to steplocal, we will filter the breakpoints at which the RTS
yields to the debugger based on the SrcSpan. When doing step-out, only
stop if the breakpoint is /not/ contained in the function from which we
initiated it.
This is especially relevant in monadic statements such as IO which is
compiled to a long chain of case expressions.
See Note [Debugger: Filtering step-out stops]
- - - - -
5 changed files:
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Eval/Types.hs
- ghc/GHCi/UI.hs
- rts/Interpreter.c
- testsuite/tests/ghci.debugger/scripts/T26042d.stdout
Changes:
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -355,14 +355,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
decl = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
- b <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi)
+ bactive <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi)
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
-- This breakpoint is enabled or we mean to break here;
-- we want to stop instead of just logging it.
- if b || breakHere step span then do
+ if breakHere bactive step span then do
-- This function only returns control to ghci with 'ExecBreak' when it is really meant to break.
-- Specifically, for :steplocal or :stepmodule, don't return control
-- and simply resume execution from here until we hit a breakpoint we do want to stop at.
@@ -386,6 +386,7 @@ handleRunStatus step expr bindings final_ids status history0 = do
setSession hsc_env2
return (ExecBreak names (Just ibi))
else do
+ -- resume with the same step type
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
status <- liftIO $ GHCi.resumeStmt interp eval_opts resume_ctxt_fhv
history <- if not tracing then pure history0 else do
@@ -451,7 +452,7 @@ resumeExec step mbCnt
hist' = case mb_brkpt of
Nothing -> pure prevHistoryLst
Just bi
- | breakHere step span -> do
+ | breakHere False step span -> do
hist1 <- liftIO (mkHistory hsc_env apStack bi)
return $ hist1 `consBL` fromListBL 50 hist
| otherwise -> pure prevHistoryLst
=====================================
compiler/GHC/Runtime/Eval/Types.hs
=====================================
@@ -49,6 +49,11 @@ data SingleStep
-- | :stepout
| StepOut
+ { initiatedFrom :: Maybe SrcSpan
+ -- ^ Step-out locations are filtered to make sure we don't stop at a
+ -- continuation that is within the function from which step-out was
+ -- initiated. See Note [Debugger: Step-out]
+ }
-- | :steplocal [expr]
| LocalStep
@@ -62,24 +67,73 @@ data SingleStep
-- step at every breakpoint or after every return (see @'EvalStep'@).
enableGhcStepMode :: SingleStep -> EvalStep
enableGhcStepMode RunToCompletion = EvalStepNone
-enableGhcStepMode StepOut = EvalStepOut
+enableGhcStepMode StepOut{} = EvalStepOut
-- for the remaining step modes we need to stop at every single breakpoint.
enableGhcStepMode _ = EvalStepSingle
--- | Given a 'SingleStep' mode and the SrcSpan of a breakpoint we hit, return
--- @True@ if based on the step-mode alone we should stop at this breakpoint.
+-- | Given a 'SingleStep' mode, whether the breakpoint was explicitly active,
+-- and the SrcSpan of a breakpoint we hit, return @True@ if we should stop at
+-- this breakpoint.
--
-- In particular, this will always be @False@ for @'RunToCompletion'@ and
-- @'RunAndLogSteps'@. We'd need further information e.g. about the user
-- breakpoints to determine whether to break in those modes.
-breakHere :: SingleStep -> SrcSpan -> Bool
-breakHere step break_span = case step of
- RunToCompletion -> False
- RunAndLogSteps -> False
- StepOut -> True
- SingleStep -> True
- LocalStep span -> break_span `isSubspanOf` span
- ModuleStep span -> srcSpanFileName_maybe span == srcSpanFileName_maybe break_span
+breakHere :: Bool -- ^ Was this breakpoint explicitly active (in the @BreakArray@s)?
+ -> SingleStep -- ^ What kind of stepping were we doing
+ -> SrcSpan -- ^ The span of the breakpoint we hit
+ -> Bool -- ^ Should we stop here then?
+breakHere b RunToCompletion _ = b
+breakHere b RunAndLogSteps _ = b
+breakHere _ SingleStep _ = True
+breakHere b step break_span = case step of
+ LocalStep start_span -> b || break_span `isSubspanOf` start_span
+ ModuleStep start_span -> b || srcSpanFileName_maybe start_span == srcSpanFileName_maybe break_span
+ StepOut Nothing -> True
+ StepOut (Just start) ->
+ -- See Note [Debugger: Filtering step-out stops]
+ not (break_span `isSubspanOf` start)
+
+{-
+Note [Debugger: Filtering step-out stops]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Recall from Note [Debugger: Step-out] that the RTS explicitly enables the
+breakpoint at the start of the first continuation frame on the stack, when
+the step-out flag is set.
+
+Often, the continuation on top of the stack will be part of the same function
+from which step-out was initiated. A trivial example is a case expression:
+
+ f x = case <brk>g x of ...
+
+If we're stopped in <brk>, the continuation will be case alternatives rather
+than in the function which called `f`. This is especially relevant for monadic
+do-blocks which may end up being compiled to long chains of case expressions,
+such as IO, and we don't want to stop at every line in the block while stepping out!
+
+To make sure we only stop at a continuation outside of the current function, we
+compare the continuation breakpoint `SrcSpan` against the current one. If the
+continuation breakpoint is within the current function, instead of stopping, we
+re-trigger step-out and return the RTS interpreter right away.
+
+This behaviour is very similar to `:steplocal`, which is implemented by
+yielding from the RTS at every breakpoint (using `:step`) but only really
+stopping when the breakpoint's `SrcSpan` is contained in the current function.
+
+The function which determines if we should stop at the current breakpoint is
+`breakHere`. For `StepOut`, `breakHere` will only return `True` if the
+breakpoint is not contained in the function from which step-out was initiated.
+
+Notably, this means we will ignore breakpoints enabled by the user if they are
+contained in the function we are stepping out of.
+
+If we had a way to distinguish whether a breakpoint was explicitly enabled (in
+`BreakArrays`) by the user vs by step-out we could additionally break on
+user-enabled breakpoints; however, it's not a straightforward and arguably it
+may be uncommon for a user to use step-out to run until the next breakpoint in
+the same function. Of course, if a breakpoint in any other function is hit
+before returning to the continuation, we will still stop there (`breakHere`
+will be `True` because the break point is not within the initiator function).
+-}
data ExecResult
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -4165,7 +4165,14 @@ stepCmd arg = withSandboxOnly ":step" $ step arg
step expression = runStmt expression GHC.SingleStep >> return ()
stepOutCmd :: GhciMonad m => String -> m ()
-stepOutCmd _ = withSandboxOnly ":stepout" $ doContinue GHC.StepOut
+stepOutCmd _ = withSandboxOnly ":stepout" $ do
+ mb_span <- getCurrentBreakSpan
+ case mb_span of
+ Nothing -> doContinue (GHC.StepOut Nothing)
+ Just loc -> do
+ md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
+ current_toplevel_decl <- flip enclosingTickSpan loc <$> getTickArray md
+ doContinue (GHC.StepOut (Just (RealSrcSpan current_toplevel_decl Strict.Nothing)))
stepLocalCmd :: GhciMonad m => String -> m ()
stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
=====================================
rts/Interpreter.c
=====================================
@@ -361,6 +361,11 @@ By simply enabling the breakpoint heading the continuation we can ensure that
when it is returned to we will stop there without additional work -- it
leverages the existing break point insertion process and stopping mechanisms.
+See Note [Debugger: Filtering step-out stops] for details on how the
+interpreter further filters the continuation we stop at to make sure we onky
+break on a continuation outside of the function from which step-out was
+initiated.
+
A limitation of this approach is that stepping-out of a function that was
tail-called will skip its caller since no stack frame is pushed for a tail
call (i.e. a tail call returns directly to its caller's first non-tail caller).
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d.stdout
=====================================
@@ -10,8 +10,5 @@ _result ::
^^^^^^^^^^^^^^^^^
7 putStrLn "hello3"
hello2
-Stopped in Main.main, T26042d.hs:7:3-19
-_result ::
- GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
- -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
- () #) = _
+hello3
+hello4
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5df3c3fcec5b08ce8bd90ebed02be5d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5df3c3fcec5b08ce8bd90ebed02be5d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] haddock: Add redact-type-synonyms pragma
by Marge Bot (＠marge-bot) 18 Jun '25
by Marge Bot (＠marge-bot) 18 Jun '25
18 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) 18 Jun '25
by Marge Bot (＠marge-bot) 18 Jun '25
18 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) 18 Jun '25
by Cheng Shao (＠TerrorJack) 18 Jun '25
18 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