[Git][ghc/ghc][wip/romes/step-out-9] 6 commits: refactor: "Inspecting the session" moved from GHC
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
30 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC
Commits:
5989a722 by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
refactor: "Inspecting the session" moved from GHC
Moved utilities for inspecting the session from the GHC module to
GHC.Driver.Session.Inspect
Purely a clean up
- - - - -
ff7d68ab by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
cleanup: Pass the HUG to readModBreaks, not HscEnv
A minor cleanup. The associated history and setupBreakpoint functions
are changed accordingly.
- - - - -
cc8a6cd8 by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
cleanup: Move readModBreaks to GHC.Runtime.Interpreter
With some small docs changes
- - - - -
56218cbf by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
cleanup: Move interpreterProfiled to Interp.Types
Moves interpreterProfiled and interpreterDynamic to
GHC.Runtime.Interpreter.Types from GHC.Runtime.Interpreter.
- - - - -
e60ece5d by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
cleanup: Don't import GHC in Debugger.Breakpoints
Remove the top-level
import GHC
from GHC.Runtime.Debugger.Breakpoints
This makes the module dependencies more granular and cleans up the
qualified imports from the code.
- - - - -
de60ae45 by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
refactor: Use BreakpointId in Core and Ifaces
- - - - -
28 changed files:
- compiler/GHC.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Map/Expr.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- + compiler/GHC/Driver/Session/Inspect.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/FVs.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/Breakpoint.hs
- compiler/GHC/Types/Tickish.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -346,6 +346,7 @@ import GHC.Driver.Errors
import GHC.Driver.Errors.Types
import GHC.Driver.CmdLine
import GHC.Driver.Session
+import GHC.Driver.Session.Inspect
import GHC.Driver.Backend
import GHC.Driver.Config.Finder (initFinderOpts)
import GHC.Driver.Config.Parser (initParserOpts)
@@ -378,7 +379,7 @@ import GHC.Builtin.Types.Prim ( alphaTyVars )
import GHC.Data.StringBuffer
import GHC.Data.FastString
import qualified GHC.LanguageExtensions as LangExt
-import GHC.Rename.Names (renamePkgQual, renameRawPkgQual, gresFromAvails)
+import GHC.Rename.Names (renamePkgQual, renameRawPkgQual)
import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceTcRn )
import GHC.Tc.Types
@@ -425,14 +426,12 @@ import GHC.Types.Target
import GHC.Types.Basic
import GHC.Types.TyThing
import GHC.Types.Name.Env
-import GHC.Types.Name.Ppr
import GHC.Types.TypeEnv
import GHC.Types.Breakpoint
import GHC.Types.PkgQual
import GHC.Unit
import GHC.Unit.Env as UnitEnv
-import GHC.Unit.External
import GHC.Unit.Finder
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.ModGuts
@@ -1570,169 +1569,6 @@ compileCore simplify fn = do
cm_safe = safe_mode
}
--- %************************************************************************
--- %* *
--- Inspecting the session
--- %* *
--- %************************************************************************
-
--- | Get the module dependency graph.
-getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
-getModuleGraph = liftM hsc_mod_graph getSession
-
-{-# DEPRECATED isLoaded "Prefer 'isLoadedModule' and 'isLoadedHomeModule'" #-}
--- | Return @True@ \<==> module is loaded.
-isLoaded :: GhcMonad m => ModuleName -> m Bool
-isLoaded m = withSession $ \hsc_env -> liftIO $ do
- hmis <- HUG.lookupAllHug (hsc_HUG hsc_env) m
- return $! not (null hmis)
-
--- | Check whether a 'ModuleName' is found in the 'HomePackageTable'
--- for the given 'UnitId'.
-isLoadedModule :: GhcMonad m => UnitId -> ModuleName -> m Bool
-isLoadedModule uid m = withSession $ \hsc_env -> liftIO $ do
- hmi <- HUG.lookupHug (hsc_HUG hsc_env) uid m
- return $! isJust hmi
-
--- | Check whether 'Module' is part of the 'HomeUnitGraph'.
---
--- Similar to 'isLoadedModule', but for 'Module's.
-isLoadedHomeModule :: GhcMonad m => Module -> m Bool
-isLoadedHomeModule m = withSession $ \hsc_env -> liftIO $ do
- hmi <- HUG.lookupHugByModule m (hsc_HUG hsc_env)
- return $! isJust hmi
-
--- | Return the bindings for the current interactive session.
-getBindings :: GhcMonad m => m [TyThing]
-getBindings = withSession $ \hsc_env ->
- return $ icInScopeTTs $ hsc_IC hsc_env
-
--- | Return the instances for the current interactive session.
-getInsts :: GhcMonad m => m ([ClsInst], [FamInst])
-getInsts = withSession $ \hsc_env ->
- let (inst_env, fam_env) = ic_instances (hsc_IC hsc_env)
- in return (instEnvElts inst_env, fam_env)
-
-getNamePprCtx :: GhcMonad m => m NamePprCtx
-getNamePprCtx = withSession $ \hsc_env -> do
- return $ icNamePprCtx (hsc_unit_env hsc_env) (hsc_IC hsc_env)
-
--- | Container for information about a 'Module'.
-data ModuleInfo = ModuleInfo {
- minf_type_env :: TypeEnv,
- minf_exports :: [AvailInfo],
- minf_instances :: [ClsInst],
- minf_iface :: Maybe ModIface,
- minf_safe :: SafeHaskellMode,
- minf_modBreaks :: Maybe ModBreaks
- }
- -- We don't want HomeModInfo here, because a ModuleInfo applies
- -- to package modules too.
-
-
--- | Request information about a loaded 'Module'
-getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
-getModuleInfo mdl = withSession $ \hsc_env -> do
- if HUG.memberHugUnit (moduleUnit mdl) (hsc_HUG hsc_env)
- then liftIO $ getHomeModuleInfo hsc_env mdl
- else liftIO $ getPackageModuleInfo hsc_env mdl
-
-getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
-getPackageModuleInfo hsc_env mdl
- = do eps <- hscEPS hsc_env
- iface <- hscGetModuleInterface hsc_env mdl
- let
- avails = mi_exports iface
- pte = eps_PTE eps
- tys = [ ty | name <- concatMap availNames avails,
- Just ty <- [lookupTypeEnv pte name] ]
-
- return (Just (ModuleInfo {
- minf_type_env = mkTypeEnv tys,
- minf_exports = avails,
- minf_instances = error "getModuleInfo: instances for package module unimplemented",
- minf_iface = Just iface,
- minf_safe = getSafeMode $ mi_trust iface,
- minf_modBreaks = Nothing
- }))
-
-availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv
-availsToGlobalRdrEnv hsc_env mod avails
- = forceGlobalRdrEnv rdr_env
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
- where
- rdr_env = mkGlobalRdrEnv (gresFromAvails hsc_env (Just imp_spec) avails)
- -- We're building a GlobalRdrEnv as if the user imported
- -- all the specified modules into the global interactive module
- imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
- decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
- is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual,
- is_dloc = srcLocSpan interactiveSrcLoc,
- is_level = NormalLevel }
-
-getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
-getHomeModuleInfo hsc_env mdl =
- HUG.lookupHugByModule mdl (hsc_HUG hsc_env) >>= \case
- Nothing -> return Nothing
- Just hmi -> do
- let details = hm_details hmi
- iface = hm_iface hmi
- return (Just (ModuleInfo {
- minf_type_env = md_types details,
- minf_exports = md_exports details,
- -- NB: already forced. See Note [Forcing GREInfo] in GHC.Types.GREInfo.
- minf_instances = instEnvElts $ md_insts details,
- minf_iface = Just iface,
- minf_safe = getSafeMode $ mi_trust iface
- ,minf_modBreaks = getModBreaks hmi
- }))
-
--- | The list of top-level entities defined in a module
-modInfoTyThings :: ModuleInfo -> [TyThing]
-modInfoTyThings minf = typeEnvElts (minf_type_env minf)
-
-modInfoExports :: ModuleInfo -> [Name]
-modInfoExports minf = concatMap availNames $! minf_exports minf
-
-modInfoExportsWithSelectors :: ModuleInfo -> [Name]
-modInfoExportsWithSelectors minf = concatMap availNames $! minf_exports minf
-
--- | Returns the instances defined by the specified module.
--- Warning: currently unimplemented for package modules.
-modInfoInstances :: ModuleInfo -> [ClsInst]
-modInfoInstances = minf_instances
-
-modInfoIsExportedName :: ModuleInfo -> Name -> Bool
-modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf))
-
-mkNamePprCtxForModule ::
- GhcMonad m =>
- Module ->
- ModuleInfo ->
- m NamePprCtx
-mkNamePprCtxForModule mod minf = withSession $ \hsc_env -> do
- let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (availsToGlobalRdrEnv hsc_env mod (minf_exports minf))
- ptc = initPromotionTickContext (hsc_dflags hsc_env)
- return name_ppr_ctx
-
-modInfoLookupName :: GhcMonad m =>
- ModuleInfo -> Name
- -> m (Maybe TyThing) -- XXX: returns a Maybe X
-modInfoLookupName minf name = withSession $ \hsc_env -> do
- case lookupTypeEnv (minf_type_env minf) name of
- Just tyThing -> return (Just tyThing)
- Nothing -> liftIO (lookupType hsc_env name)
-
-modInfoIface :: ModuleInfo -> Maybe ModIface
-modInfoIface = minf_iface
-
--- | Retrieve module safe haskell mode
-modInfoSafe :: ModuleInfo -> SafeHaskellMode
-modInfoSafe = minf_safe
-
-modInfoModBreaks :: ModuleInfo -> Maybe ModBreaks
-modInfoModBreaks = minf_modBreaks
-
isDictonaryId :: Id -> Bool
isDictonaryId id = isDictTy (idType id)
@@ -2063,7 +1899,7 @@ getGHCiMonad :: GhcMonad m => m Name
getGHCiMonad = fmap (ic_monad . hsc_IC) getSession
getHistorySpan :: GhcMonad m => History -> m SrcSpan
-getHistorySpan h = withSession $ \hsc_env -> liftIO $ GHC.Runtime.Eval.getHistorySpan hsc_env h
+getHistorySpan h = withSession $ \hsc_env -> liftIO $ GHC.Runtime.Eval.getHistorySpan (hsc_HUG hsc_env) h
obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
obtainTermFromVal bound force ty a = withSession $ \hsc_env ->
=====================================
compiler/GHC/Core/FVs.hs
=====================================
@@ -287,7 +287,7 @@ exprs_fvs :: [CoreExpr] -> FV
exprs_fvs exprs = mapUnionFV expr_fvs exprs
tickish_fvs :: CoreTickish -> FV
-tickish_fvs (Breakpoint _ _ ids _) = FV.mkFVs ids
+tickish_fvs (Breakpoint _ _ ids) = FV.mkFVs ids
tickish_fvs _ = emptyFV
{- **********************************************************************
@@ -759,8 +759,8 @@ freeVars = go
, AnnTick tickish expr2 )
where
expr2 = go expr
- tickishFVs (Breakpoint _ _ ids _) = mkDVarSet ids
- tickishFVs _ = emptyDVarSet
+ tickishFVs (Breakpoint _ _ ids) = mkDVarSet ids
+ tickishFVs _ = emptyDVarSet
go (Type ty) = (tyCoVarsOfTypeDSet ty, AnnType ty)
go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co)
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -897,8 +897,8 @@ lintCoreExpr (Cast expr co)
lintCoreExpr (Tick tickish expr)
= do { case tickish of
- Breakpoint _ _ ids _ -> forM_ ids $ \id -> lintIdOcc id 0
- _ -> return ()
+ Breakpoint _ _ ids -> forM_ ids $ \id -> lintIdOcc id 0
+ _ -> return ()
; markAllJoinsBadIf block_joins $ lintCoreExpr expr }
where
block_joins = not (tickish `tickishScopesLike` SoftScope)
=====================================
compiler/GHC/Core/Map/Expr.hs
=====================================
@@ -198,11 +198,10 @@ eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where
eqDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Bool
eqDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where
- go (Breakpoint lext lid lids lmod) (Breakpoint rext rid rids rmod)
+ go (Breakpoint lext lid lids) (Breakpoint rext rid rids)
= lid == rid
&& D env1 lids == D env2 rids
&& lext == rext
- && lmod == rmod
go l r = l == r
-- Compares for equality, modulo alpha
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -2501,7 +2501,7 @@ occAnal env (Tick tickish body)
-- For a non-soft tick scope, we can inline lambdas only, so we
-- abandon tail calls, and do markAllInsideLam too: usage_lam
- | Breakpoint _ _ ids _ <- tickish
+ | Breakpoint _ _ ids <- tickish
= -- Never substitute for any of the Ids in a Breakpoint
addManyOccs usage_lam (mkVarSet ids)
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -1461,8 +1461,8 @@ simplTick env tickish expr cont
simplTickish env tickish
- | Breakpoint ext n ids modl <- tickish
- = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) modl
+ | Breakpoint ext bid ids <- tickish
+ = Breakpoint ext bid (mapMaybe (getDoneId . substId env) ids)
| otherwise = tickish
-- Push type application and coercion inside a tick
=====================================
compiler/GHC/Core/Ppr.hs
=====================================
@@ -31,6 +31,7 @@ import GHC.Prelude
import GHC.Core
import GHC.Core.Stats (exprStats)
+import GHC.Types.Breakpoint
import GHC.Types.Fixity (LexicalFixity(..))
import GHC.Types.Literal( pprLiteral )
import GHC.Types.Name( pprInfixName, pprPrefixName )
@@ -694,10 +695,10 @@ instance Outputable (XTickishId pass) => Outputable (GenTickish pass) where
ppr modl, comma,
ppr ix,
text ">"]
- ppr (Breakpoint _ext ix vars modl) =
+ ppr (Breakpoint _ext bid vars) =
hcat [text "break<",
- ppr modl, comma,
- ppr ix,
+ ppr (bi_tick_mod bid), comma,
+ ppr (bi_tick_index bid),
text ">",
parens (hcat (punctuate comma (map ppr vars)))]
ppr (ProfNote { profNoteCC = cc,
=====================================
compiler/GHC/Core/Subst.hs
=====================================
@@ -602,8 +602,8 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs
------------------
-- | Drop free vars from the breakpoint if they have a non-variable substitution.
substTickish :: Subst -> CoreTickish -> CoreTickish
-substTickish subst (Breakpoint ext n ids modl)
- = Breakpoint ext n (mapMaybe do_one ids) modl
+substTickish subst (Breakpoint ext bid ids)
+ = Breakpoint ext bid (mapMaybe do_one ids)
where
do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst
=====================================
compiler/GHC/Core/Tidy.hs
=====================================
@@ -235,8 +235,8 @@ tidyAlt env (Alt con vs rhs)
------------ Tickish --------------
tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish
-tidyTickish env (Breakpoint ext ix ids modl)
- = Breakpoint ext ix (map (tidyVarOcc env) ids) modl
+tidyTickish env (Breakpoint ext bid ids)
+ = Breakpoint ext bid (map (tidyVarOcc env) ids)
tidyTickish _ other_tickish = other_tickish
------------ Rules --------------
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -2492,11 +2492,10 @@ cheapEqExpr' ignoreTick e1 e2
-- Used by diffBinds, which is itself only used in GHC.Core.Lint.lintAnnots
eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool
-eqTickish env (Breakpoint lext lid lids lmod) (Breakpoint rext rid rids rmod)
+eqTickish env (Breakpoint lext lid lids) (Breakpoint rext rid rids)
= lid == rid &&
map (rnOccL env) lids == map (rnOccR env) rids &&
- lext == rext &&
- lmod == rmod
+ lext == rext
eqTickish _ l r = l == r
-- | Finds differences between core bindings, see @diffExpr@.
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -586,8 +586,8 @@ toIfaceTickish (ProfNote cc tick push) = IfaceSCC cc tick push
toIfaceTickish (HpcTick modl ix) = IfaceHpcTick modl ix
toIfaceTickish (SourceNote src (LexicalFastString names)) =
IfaceSource src names
-toIfaceTickish (Breakpoint _ ix fv m) =
- IfaceBreakpoint ix (toIfaceVar <$> fv) m
+toIfaceTickish (Breakpoint _ ix fv) =
+ IfaceBreakpoint ix (toIfaceVar <$> fv)
---------------------
toIfaceBind :: Bind Id -> IfaceBinding IfaceLetBndr
=====================================
compiler/GHC/CoreToStg.hs
=====================================
@@ -643,10 +643,10 @@ coreToStgArgs (arg : args) = do -- Non-type argument
coreToStgTick :: Type -- type of the ticked expression
-> CoreTickish
-> StgTickish
-coreToStgTick _ty (HpcTick m i) = HpcTick m i
-coreToStgTick _ty (SourceNote span nm) = SourceNote span nm
-coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope
-coreToStgTick !ty (Breakpoint _ bid fvs modl) = Breakpoint ty bid fvs modl
+coreToStgTick _ty (HpcTick m i) = HpcTick m i
+coreToStgTick _ty (SourceNote span nm) = SourceNote span nm
+coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope
+coreToStgTick !ty (Breakpoint _ bid fvs) = Breakpoint ty bid fvs
-- ---------------------------------------------------------------------------
-- The magic for lets:
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -842,9 +842,9 @@ cpeRhsE env (Tick tickish expr)
= do { body <- cpeBodyNF env expr
; return (emptyFloats, mkTick tickish' body) }
where
- tickish' | Breakpoint ext n fvs modl <- tickish
+ tickish' | Breakpoint ext bid fvs <- tickish
-- See also 'substTickish'
- = Breakpoint ext n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs) modl
+ = Breakpoint ext bid (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs)
| otherwise
= tickish
=====================================
compiler/GHC/Driver/Session/Inspect.hs
=====================================
@@ -0,0 +1,201 @@
+{-# LANGUAGE LambdaCase #-}
+
+-- | GHC API utilities for inspecting the GHC session
+module GHC.Driver.Session.Inspect where
+
+import GHC.Prelude
+import GHC.Data.Maybe
+import Control.Monad
+
+import GHC.ByteCode.Types
+import GHC.Core.FamInstEnv
+import GHC.Core.InstEnv
+import GHC.Driver.Env
+import GHC.Driver.Main
+import GHC.Driver.Monad
+import GHC.Driver.Session
+import GHC.Rename.Names
+import GHC.Runtime.Context
+import GHC.Runtime.Interpreter
+import GHC.Types.Avail
+import GHC.Types.Name
+import GHC.Types.Name.Ppr
+import GHC.Types.Name.Reader
+import GHC.Types.Name.Set
+import GHC.Types.PkgQual
+import GHC.Types.SafeHaskell
+import GHC.Types.SrcLoc
+import GHC.Types.TyThing
+import GHC.Types.TypeEnv
+import GHC.Unit.External
+import GHC.Unit.Home.ModInfo
+import GHC.Unit.Module
+import GHC.Unit.Module.Graph
+import GHC.Unit.Module.ModDetails
+import GHC.Unit.Module.ModIface
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import qualified GHC.Unit.Home.Graph as HUG
+
+-- %************************************************************************
+-- %* *
+-- Inspecting the session
+-- %* *
+-- %************************************************************************
+
+-- | Get the module dependency graph.
+getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
+getModuleGraph = liftM hsc_mod_graph getSession
+
+{-# DEPRECATED isLoaded "Prefer 'isLoadedModule' and 'isLoadedHomeModule'" #-}
+-- | Return @True@ \<==> module is loaded.
+isLoaded :: GhcMonad m => ModuleName -> m Bool
+isLoaded m = withSession $ \hsc_env -> liftIO $ do
+ hmis <- HUG.lookupAllHug (hsc_HUG hsc_env) m
+ return $! not (null hmis)
+
+-- | Check whether a 'ModuleName' is found in the 'HomePackageTable'
+-- for the given 'UnitId'.
+isLoadedModule :: GhcMonad m => UnitId -> ModuleName -> m Bool
+isLoadedModule uid m = withSession $ \hsc_env -> liftIO $ do
+ hmi <- HUG.lookupHug (hsc_HUG hsc_env) uid m
+ return $! isJust hmi
+
+-- | Check whether 'Module' is part of the 'HomeUnitGraph'.
+--
+-- Similar to 'isLoadedModule', but for 'Module's.
+isLoadedHomeModule :: GhcMonad m => Module -> m Bool
+isLoadedHomeModule m = withSession $ \hsc_env -> liftIO $ do
+ hmi <- HUG.lookupHugByModule m (hsc_HUG hsc_env)
+ return $! isJust hmi
+
+-- | Return the bindings for the current interactive session.
+getBindings :: GhcMonad m => m [TyThing]
+getBindings = withSession $ \hsc_env ->
+ return $ icInScopeTTs $ hsc_IC hsc_env
+
+-- | Return the instances for the current interactive session.
+getInsts :: GhcMonad m => m ([ClsInst], [FamInst])
+getInsts = withSession $ \hsc_env ->
+ let (inst_env, fam_env) = ic_instances (hsc_IC hsc_env)
+ in return (instEnvElts inst_env, fam_env)
+
+getNamePprCtx :: GhcMonad m => m NamePprCtx
+getNamePprCtx = withSession $ \hsc_env -> do
+ return $ icNamePprCtx (hsc_unit_env hsc_env) (hsc_IC hsc_env)
+
+-- | Container for information about a 'Module'.
+data ModuleInfo = ModuleInfo {
+ minf_type_env :: TypeEnv,
+ minf_exports :: [AvailInfo],
+ minf_instances :: [ClsInst],
+ minf_iface :: Maybe ModIface,
+ minf_safe :: SafeHaskellMode,
+ minf_modBreaks :: Maybe ModBreaks
+ }
+ -- We don't want HomeModInfo here, because a ModuleInfo applies
+ -- to package modules too.
+
+-- | Request information about a loaded 'Module'
+getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
+getModuleInfo mdl = withSession $ \hsc_env -> do
+ if HUG.memberHugUnit (moduleUnit mdl) (hsc_HUG hsc_env)
+ then liftIO $ getHomeModuleInfo hsc_env mdl
+ else liftIO $ getPackageModuleInfo hsc_env mdl
+
+getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
+getPackageModuleInfo hsc_env mdl
+ = do eps <- hscEPS hsc_env
+ iface <- hscGetModuleInterface hsc_env mdl
+ let
+ avails = mi_exports iface
+ pte = eps_PTE eps
+ tys = [ ty | name <- concatMap availNames avails,
+ Just ty <- [lookupTypeEnv pte name] ]
+
+ return (Just (ModuleInfo {
+ minf_type_env = mkTypeEnv tys,
+ minf_exports = avails,
+ minf_instances = error "getModuleInfo: instances for package module unimplemented",
+ minf_iface = Just iface,
+ minf_safe = getSafeMode $ mi_trust iface,
+ minf_modBreaks = Nothing
+ }))
+
+availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv
+availsToGlobalRdrEnv hsc_env mod avails
+ = forceGlobalRdrEnv rdr_env
+ -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
+ where
+ rdr_env = mkGlobalRdrEnv (gresFromAvails hsc_env (Just imp_spec) avails)
+ -- We're building a GlobalRdrEnv as if the user imported
+ -- all the specified modules into the global interactive module
+ imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
+ decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
+ is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual,
+ is_dloc = srcLocSpan interactiveSrcLoc,
+ is_level = NormalLevel }
+
+getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
+getHomeModuleInfo hsc_env mdl =
+ HUG.lookupHugByModule mdl (hsc_HUG hsc_env) >>= \case
+ Nothing -> return Nothing
+ Just hmi -> do
+ let details = hm_details hmi
+ iface = hm_iface hmi
+ return (Just (ModuleInfo {
+ minf_type_env = md_types details,
+ minf_exports = md_exports details,
+ -- NB: already forced. See Note [Forcing GREInfo] in GHC.Types.GREInfo.
+ minf_instances = instEnvElts $ md_insts details,
+ minf_iface = Just iface,
+ minf_safe = getSafeMode $ mi_trust iface,
+ minf_modBreaks = getModBreaks hmi
+ }))
+
+-- | The list of top-level entities defined in a module
+modInfoTyThings :: ModuleInfo -> [TyThing]
+modInfoTyThings minf = typeEnvElts (minf_type_env minf)
+
+modInfoExports :: ModuleInfo -> [Name]
+modInfoExports minf = concatMap availNames $! minf_exports minf
+
+modInfoExportsWithSelectors :: ModuleInfo -> [Name]
+modInfoExportsWithSelectors minf = concatMap availNames $! minf_exports minf
+
+-- | Returns the instances defined by the specified module.
+-- Warning: currently unimplemented for package modules.
+modInfoInstances :: ModuleInfo -> [ClsInst]
+modInfoInstances = minf_instances
+
+modInfoIsExportedName :: ModuleInfo -> Name -> Bool
+modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf))
+
+mkNamePprCtxForModule ::
+ GhcMonad m =>
+ Module ->
+ ModuleInfo ->
+ m NamePprCtx
+mkNamePprCtxForModule mod minf = withSession $ \hsc_env -> do
+ let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (availsToGlobalRdrEnv hsc_env mod (minf_exports minf))
+ ptc = initPromotionTickContext (hsc_dflags hsc_env)
+ return name_ppr_ctx
+
+modInfoLookupName :: GhcMonad m =>
+ ModuleInfo -> Name
+ -> m (Maybe TyThing) -- XXX: returns a Maybe X
+modInfoLookupName minf name = withSession $ \hsc_env -> do
+ case lookupTypeEnv (minf_type_env minf) name of
+ Just tyThing -> return (Just tyThing)
+ Nothing -> liftIO (lookupType hsc_env name)
+
+modInfoIface :: ModuleInfo -> Maybe ModIface
+modInfoIface = minf_iface
+
+-- | Retrieve module safe haskell mode
+modInfoSafe :: ModuleInfo -> SafeHaskellMode
+modInfoSafe = minf_safe
+
+modInfoModBreaks :: ModuleInfo -> Maybe ModBreaks
+modInfoModBreaks = minf_modBreaks
+
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.Driver.Flags (DumpFlag(..))
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Utils.Logger
+import GHC.Types.Breakpoint
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.Id
@@ -1235,7 +1236,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
Breakpoints -> do
i <- addMixEntry me
- pure (Breakpoint noExtField i ids (this_mod env))
+ pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids)
SourceNotes | RealSrcSpan pos' _ <- pos ->
return $ SourceNote pos' $ LexicalFastString cc_name
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -56,6 +56,7 @@ import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,
constraintKindTyConKey )
+import GHC.Types.Breakpoint
import GHC.Types.Unique ( hasKey )
import GHC.Iface.Type
import GHC.Iface.Recomp.Binary
@@ -699,7 +700,7 @@ data IfaceTickish
= IfaceHpcTick Module Int -- from HpcTick x
| IfaceSCC CostCentre Bool Bool -- from ProfNote
| IfaceSource RealSrcSpan FastString -- from SourceNote
- | IfaceBreakpoint Int [IfaceExpr] Module -- from Breakpoint
+ | IfaceBreakpoint BreakpointId [IfaceExpr] -- from Breakpoint
data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr
-- Note: IfLclName, not IfaceBndr (and same with the case binder)
@@ -1848,7 +1849,7 @@ pprIfaceTickish (IfaceSCC cc tick scope)
= braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)
pprIfaceTickish (IfaceSource src _names)
= braces (pprUserRealSpan True src)
-pprIfaceTickish (IfaceBreakpoint m ix fvs)
+pprIfaceTickish (IfaceBreakpoint (BreakpointId m ix) fvs)
= braces (text "break" <+> ppr m <+> ppr ix <+> ppr fvs)
------------------
@@ -2198,7 +2199,7 @@ freeNamesIfaceTyConParent (IfDataInstance ax tc tys)
= unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfAppArgs tys
freeNamesIfTickish :: IfaceTickish -> NameSet
-freeNamesIfTickish (IfaceBreakpoint _ fvs _) =
+freeNamesIfTickish (IfaceBreakpoint _ fvs) =
fnList freeNamesIfExpr fvs
freeNamesIfTickish _ = emptyNameSet
@@ -2919,7 +2920,7 @@ instance Binary IfaceTickish where
put_ bh (srcSpanEndLine src)
put_ bh (srcSpanEndCol src)
put_ bh name
- put_ bh (IfaceBreakpoint m ix fvs) = do
+ put_ bh (IfaceBreakpoint (BreakpointId m ix) fvs) = do
putByte bh 3
put_ bh m
put_ bh ix
@@ -2947,7 +2948,7 @@ instance Binary IfaceTickish where
3 -> do m <- get bh
ix <- get bh
fvs <- get bh
- return (IfaceBreakpoint m ix fvs)
+ return (IfaceBreakpoint (BreakpointId m ix) fvs)
_ -> panic ("get IfaceTickish " ++ show h)
instance Binary IfaceConAlt where
@@ -3206,7 +3207,7 @@ instance NFData IfaceTickish where
IfaceHpcTick m i -> rnf m `seq` rnf i
IfaceSCC cc b1 b2 -> rnf cc `seq` rnf b1 `seq` rnf b2
IfaceSource src str -> rnf src `seq` rnf str
- IfaceBreakpoint m i fvs -> rnf m `seq` rnf i `seq` rnf fvs
+ IfaceBreakpoint i fvs -> rnf i `seq` rnf fvs
instance NFData IfaceConAlt where
rnf = \case
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -955,7 +955,7 @@ dffvExpr :: CoreExpr -> DFFV ()
dffvExpr (Var v) = insert v
dffvExpr (App e1 e2) = dffvExpr e1 >> dffvExpr e2
dffvExpr (Lam v e) = extendScope v (dffvExpr e)
-dffvExpr (Tick (Breakpoint _ _ ids _) e) = mapM_ insert ids >> dffvExpr e
+dffvExpr (Tick (Breakpoint _ _ ids) e) = mapM_ insert ids >> dffvExpr e
dffvExpr (Tick _other e) = dffvExpr e
dffvExpr (Cast e _) = dffvExpr e
dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e)
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -1732,9 +1732,9 @@ tcIfaceTickish :: IfaceTickish -> IfL CoreTickish
tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix)
tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push)
tcIfaceTickish (IfaceSource src name) = return (SourceNote src (LexicalFastString name))
-tcIfaceTickish (IfaceBreakpoint ix fvs modl) = do
+tcIfaceTickish (IfaceBreakpoint bid fvs) = do
fvs' <- mapM tcIfaceExpr fvs
- return (Breakpoint NoExtField ix [f | Var f <- fvs'] modl)
+ return (Breakpoint NoExtField bid [f | Var f <- fvs'])
-------------------------
tcIfaceLit :: Literal -> IfL Literal
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -1,9 +1,12 @@
+
-- | GHC API debugger module for finding and setting breakpoints.
--
-- This module is user facing and is at least used by `GHCi` and `ghc-debugger`
-- to find and set breakpoints.
module GHC.Runtime.Debugger.Breakpoints where
+import GHC.Prelude
+
import Control.Monad.Catch
import Control.Monad
import Data.Array
@@ -13,10 +16,18 @@ import Data.Maybe
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as S
-import GHC
-import GHC.Prelude
+import GHC.ByteCode.Types (BreakIndex, ModBreaks(..))
+import GHC.Driver.Env
+import GHC.Driver.Monad
+import GHC.Driver.Session.Inspect
+import GHC.Runtime.Eval
import GHC.Runtime.Eval.Utils
+import GHC.Types.Name
import GHC.Types.SrcLoc
+import GHC.Types.Breakpoint
+import GHC.Unit.Module
+import GHC.Unit.Module.Graph
+import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
@@ -44,10 +55,10 @@ findBreakByLine line arr
ticks = arr ! line
starts_here = [ (ix,pan) | (ix, pan) <- ticks,
- GHC.srcSpanStartLine pan == line ]
+ srcSpanStartLine pan == line ]
(comp, incomp) = partition ends_here starts_here
- where ends_here (_,pan) = GHC.srcSpanEndLine pan == line
+ where ends_here (_,pan) = srcSpanEndLine pan == line
-- | Find a breakpoint in the 'TickArray' of a module, given a line number and a column coordinate.
findBreakByCoord :: (Int, Int) -> TickArray -> Maybe (BreakIndex, RealSrcSpan)
@@ -63,8 +74,8 @@ findBreakByCoord (line, col) arr
contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan Strict.Nothing `spans` (line,col) ]
after_here = [ tick | tick@(_,pan) <- ticks,
- GHC.srcSpanStartLine pan == line,
- GHC.srcSpanStartCol pan >= col ]
+ srcSpanStartLine pan == line,
+ srcSpanStartCol pan >= col ]
leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare) realSrcSpanEnd
@@ -112,7 +123,7 @@ resolveFunctionBreakpoint inp = do
Nothing -> do
-- No errors found, go and return the module info
let mod = fromMaybe (panic "resolveFunctionBreakpoint") mb_mod
- mb_mod_info <- GHC.getModuleInfo mod
+ mb_mod_info <- getModuleInfo mod
case mb_mod_info of
Nothing -> pure . Left $
text "Could not find ModuleInfo of " <> ppr mod
@@ -120,16 +131,16 @@ resolveFunctionBreakpoint inp = do
where
-- Try to lookup the module for an identifier that is in scope.
-- `parseName` throws an exception, if the identifier is not in scope
- lookupModuleInscope :: GHC.GhcMonad m => String -> m (Maybe Module)
+ lookupModuleInscope :: GhcMonad m => String -> m (Maybe Module)
lookupModuleInscope mod_top_lvl = do
- names <- GHC.parseName mod_top_lvl
- pure $ Just $ NE.head $ GHC.nameModule <$> names
+ names <- parseName mod_top_lvl
+ pure $ Just $ NE.head $ nameModule <$> names
-- Lookup the Module of a module name in the module graph
- lookupModuleInGraph :: GHC.GhcMonad m => String -> m (Maybe Module)
+ lookupModuleInGraph :: GhcMonad m => String -> m (Maybe Module)
lookupModuleInGraph mod_str = do
- graph <- GHC.getModuleGraph
- let hmods = ms_mod <$> GHC.mgModSummaries graph
+ graph <- getModuleGraph
+ let hmods = ms_mod <$> mgModSummaries graph
pure $ find ((== mod_str) . moduleNameString . moduleName) hmods
-- Check validity of an identifier to set a breakpoint:
@@ -137,21 +148,21 @@ resolveFunctionBreakpoint inp = do
-- 2. the identifier must be in an interpreted module
-- 3. the ModBreaks array for module `mod` must have an entry
-- for the function
- validateBP :: GHC.GhcMonad m => String -> String -> Maybe Module
+ validateBP :: GhcMonad m => String -> String -> Maybe Module
-> m (Maybe SDoc)
validateBP mod_str fun_str Nothing = pure $ Just $ quotes (text
(combineModIdent mod_str (takeWhile (/= '.') fun_str)))
<+> text "not in scope"
validateBP _ "" (Just _) = pure $ Just $ text "Function name is missing"
validateBP _ fun_str (Just modl) = do
- isInterpr <- GHC.moduleIsInterpreted modl
+ isInterpr <- moduleIsInterpreted modl
mb_err_msg <- case isInterpr of
False -> pure $ Just $ text "Module" <+> quotes (ppr modl) <+> text "is not interpreted"
True -> do
mb_modbreaks <- getModBreak modl
let found = case mb_modbreaks of
Nothing -> False
- Just mb -> fun_str `elem` (intercalate "." <$> elems (GHC.modBreaks_decls mb))
+ Just mb -> fun_str `elem` (intercalate "." <$> elems (modBreaks_decls mb))
if found
then pure Nothing
else pure $ Just $ text "No breakpoint found for" <+> quotes (text fun_str)
@@ -163,13 +174,13 @@ resolveFunctionBreakpoint inp = do
-- for
-- (a) this binder only (it maybe a top-level or a nested declaration)
-- (b) that do not have an enclosing breakpoint
-findBreakForBind :: String {-^ Name of bind to break at -} -> GHC.ModBreaks -> [(BreakIndex, RealSrcSpan)]
+findBreakForBind :: String {-^ Name of bind to break at -} -> ModBreaks -> [(BreakIndex, RealSrcSpan)]
findBreakForBind str_name modbreaks = filter (not . enclosed) ticks
where
ticks = [ (index, span)
- | (index, decls) <- assocs (GHC.modBreaks_decls modbreaks),
+ | (index, decls) <- assocs (modBreaks_decls modbreaks),
str_name == intercalate "." decls,
- RealSrcSpan span _ <- [GHC.modBreaks_locs modbreaks ! index] ]
+ RealSrcSpan span _ <- [modBreaks_locs modbreaks ! index] ]
enclosed (_,sp0) = any subspan ticks
where subspan (_,sp) = sp /= sp0 &&
realSrcSpanStart sp <= realSrcSpanStart sp0 &&
@@ -180,53 +191,53 @@ findBreakForBind str_name modbreaks = filter (not . enclosed) ticks
--------------------------------------------------------------------------------
-- | Maps line numbers to the breakpoint ticks existing at that line for a module.
-type TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)]
+type TickArray = Array Int [(BreakIndex,RealSrcSpan)]
-- | Construct the 'TickArray' for the given module.
makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray)
makeModuleLineMap m = do
- mi <- GHC.getModuleInfo m
- return $ mkTickArray . assocs . GHC.modBreaks_locs <$> (GHC.modInfoModBreaks =<< mi)
+ mi <- getModuleInfo m
+ return $ mkTickArray . assocs . modBreaks_locs <$> (modInfoModBreaks =<< mi)
where
mkTickArray :: [(BreakIndex, SrcSpan)] -> TickArray
mkTickArray ticks
= accumArray (flip (:)) [] (1, max_line)
[ (line, (nm,pan)) | (nm,RealSrcSpan pan _) <- ticks, line <- srcSpanLines pan ]
where
- max_line = foldr max 0 [ GHC.srcSpanEndLine sp | (_, RealSrcSpan sp _) <- ticks ]
- srcSpanLines pan = [ GHC.srcSpanStartLine pan .. GHC.srcSpanEndLine pan ]
+ max_line = foldr max 0 [ srcSpanEndLine sp | (_, RealSrcSpan sp _) <- ticks ]
+ srcSpanLines pan = [ srcSpanStartLine pan .. srcSpanEndLine pan ]
-- | Get the 'ModBreaks' of the given 'Module' when available
-getModBreak :: GHC.GhcMonad m
- => Module -> m (Maybe ModBreaks)
+getModBreak :: GhcMonad m => Module -> m (Maybe ModBreaks)
getModBreak m = do
- mod_info <- fromMaybe (panic "getModBreak") <$> GHC.getModuleInfo m
- pure $ GHC.modInfoModBreaks mod_info
+ mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
+ pure $ modInfoModBreaks mod_info
--------------------------------------------------------------------------------
-- Getting current breakpoint information
--------------------------------------------------------------------------------
-getCurrentBreakSpan :: GHC.GhcMonad m => m (Maybe SrcSpan)
+getCurrentBreakSpan :: GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan = do
- resumes <- GHC.getResumeContext
+ hug <- hsc_HUG <$> getSession
+ resumes <- getResumeContext
case resumes of
[] -> return Nothing
(r:_) -> do
- let ix = GHC.resumeHistoryIx r
+ let ix = resumeHistoryIx r
if ix == 0
- then return (Just (GHC.resumeSpan r))
+ then return (Just (resumeSpan r))
else do
- let hist = GHC.resumeHistory r !! (ix-1)
- pan <- GHC.getHistorySpan hist
+ let hist = resumeHistory r !! (ix-1)
+ pan <- liftIO $ getHistorySpan hug hist
return (Just pan)
-getCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)
+getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
- resumes <- GHC.getResumeContext
+ resumes <- getResumeContext
return $ case resumes of
[] -> Nothing
- (r:_) -> case GHC.resumeHistoryIx r of
- 0 -> ibi_tick_mod <$> GHC.resumeBreakpointId r
- ix -> Just $ GHC.getHistoryModule $ GHC.resumeHistory r !! (ix-1)
+ (r:_) -> case resumeHistoryIx r of
+ 0 -> ibi_tick_mod <$> resumeBreakpointId r
+ ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -144,25 +144,25 @@ import qualified GHC.Unit.Home.Graph as HUG
getResumeContext :: GhcMonad m => m [Resume]
getResumeContext = withSession (return . ic_resume . hsc_IC)
-mkHistory :: HscEnv -> ForeignHValue -> InternalBreakpointId -> IO History
-mkHistory hsc_env hval ibi = History hval ibi <$> findEnclosingDecls hsc_env ibi
+mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History
+mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
getHistoryModule :: History -> Module
getHistoryModule = ibi_tick_mod . historyBreakpointId
-getHistorySpan :: HscEnv -> History -> IO SrcSpan
-getHistorySpan hsc_env hist = do
+getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
+getHistorySpan hug hist = do
let ibi = historyBreakpointId hist
- brks <- readModBreaks hsc_env (ibi_tick_mod ibi)
+ brks <- readModBreaks hug (ibi_tick_mod ibi)
return $ modBreaks_locs brks ! ibi_tick_index ibi
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
-- by the coverage pass, which gives the list of lexically-enclosing bindings
-- for each tick.
-findEnclosingDecls :: HscEnv -> InternalBreakpointId -> IO [String]
-findEnclosingDecls hsc_env ibi = do
- brks <- readModBreaks hsc_env (ibi_tick_mod ibi)
+findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
+findEnclosingDecls hug ibi = do
+ brks <- readModBreaks hug (ibi_tick_mod ibi)
return $ modBreaks_decls brks ! ibi_tick_index ibi
-- | Update fixity environment in the current interactive context.
@@ -349,7 +349,8 @@ handleRunStatus step expr bindings final_ids status history0 = do
-- - or one of the stepping options in @EvalOpts@ caused us to stop at one
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
let ibi = evalBreakpointToId eval_break
- tick_brks <- liftIO $ readModBreaks hsc_env (ibi_tick_mod ibi)
+ let hug = hsc_HUG hsc_env
+ tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
let
span = modBreaks_locs tick_brks ! ibi_tick_index ibi
decl = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi
@@ -390,7 +391,7 @@ handleRunStatus step expr bindings final_ids status history0 = do
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
- history1 <- liftIO $ mkHistory hsc_env apStack_fhv ibi
+ history1 <- liftIO $ mkHistory hug apStack_fhv ibi
let !history' = history1 `consBL` history0
-- history is strict, otherwise our BoundedList is pointless.
return history'
@@ -443,27 +444,27 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just brkpt, Just cnt) -> setupBreakpoint hsc_env (toBreakpointId brkpt) cnt
+ (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
_ -> return ()
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv
let prevHistoryLst = fromListBL 50 hist
+ hug = hsc_HUG hsc_env
hist' = case mb_brkpt of
Nothing -> pure prevHistoryLst
Just bi
| breakHere False step span -> do
- hist1 <- liftIO (mkHistory hsc_env apStack bi)
+ hist1 <- liftIO (mkHistory hug apStack bi)
return $ hist1 `consBL` fromListBL 50 hist
| otherwise -> pure prevHistoryLst
handleRunStatus step expr bindings final_ids status =<< hist'
-setupBreakpoint :: GhcMonad m => HscEnv -> BreakpointId -> Int -> m () -- #19157
-setupBreakpoint hsc_env bi cnt = do
- let modl = bi_tick_mod bi
- modBreaks <- liftIO $ readModBreaks hsc_env modl
+setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157
+setupBreakpoint interp bi cnt = do
+ hug <- hsc_HUG <$> getSession
+ modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
let breakarray = modBreaks_flags modBreaks
- interp = hscInterp hsc_env
_ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt
pure ()
@@ -494,7 +495,7 @@ moveHist fn = do
span <- case mb_info of
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just ibi -> liftIO $ do
- brks <- readModBreaks hsc_env (ibi_tick_mod ibi)
+ brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
return $ modBreaks_locs brks ! ibi_tick_index ibi
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
@@ -525,11 +526,6 @@ moveHist fn = do
result_fs :: FastString
result_fs = fsLit "_result"
--- | Read the 'ModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
-readModBreaks :: HscEnv -> Module -> IO ModBreaks
-readModBreaks hsc_env mod = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule mod (hsc_HUG hsc_env)
-
-
bindLocalsAtBreakpoint
:: HscEnv
-> ForeignHValue
@@ -560,8 +556,9 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
-- Just case: we stopped at a breakpoint, we have information about the location
-- of the breakpoint and the free variables of the expression.
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
- info_brks <- readModBreaks hsc_env (ibi_info_mod ibi)
- tick_brks <- readModBreaks hsc_env (ibi_tick_mod ibi)
+ let hug = hsc_HUG hsc_env
+ info_brks <- readModBreaks hug (ibi_info_mod ibi)
+ tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
let info = expectJust $ IntMap.lookup (ibi_info_index ibi) (modBreaks_breakInfo info_brks)
interp = hscInterp hsc_env
occs = modBreaks_vars tick_brks ! ibi_tick_index ibi
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -27,10 +27,9 @@ module GHC.Runtime.Interpreter
, getClosure
, whereFrom
, getModBreaks
+ , readModBreaks
, seqHValue
, evalBreakpointToId
- , interpreterDynamic
- , interpreterProfiled
-- * The object-code linker
, initObjLinker
@@ -98,7 +97,6 @@ import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
import GHCi.Run
-import GHC.Platform.Ways
#endif
import Control.Concurrent
@@ -117,6 +115,7 @@ import qualified GHC.InfoProv as InfoProv
import GHC.Builtin.Names
import GHC.Types.Name
+import qualified GHC.Unit.Home.Graph as HUG
-- Standard libraries
import GHC.Exts
@@ -732,13 +731,12 @@ wormholeRef interp _r = case interpInstance interp of
ExternalInterp {}
-> throwIO (InstallationError "this operation requires -fno-external-interpreter")
--- -----------------------------------------------------------------------------
--- Misc utils
-
-fromEvalResult :: EvalResult a -> IO a
-fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
-fromEvalResult (EvalSuccess a) = return a
+--------------------------------------------------------------------------------
+-- * Finding breakpoint information
+--------------------------------------------------------------------------------
+-- | Get the breakpoint information from the ByteCode object associated to this
+-- 'HomeModInfo'.
getModBreaks :: HomeModInfo -> Maybe ModBreaks
getModBreaks hmi
| Just linkable <- homeModInfoByteCode hmi,
@@ -748,24 +746,15 @@ getModBreaks hmi
| otherwise
= Nothing -- probably object code
--- | Interpreter uses Profiling way
-interpreterProfiled :: Interp -> Bool
-interpreterProfiled interp = case interpInstance interp of
-#if defined(HAVE_INTERNAL_INTERPRETER)
- InternalInterp -> hostIsProfiled
-#endif
- ExternalInterp ext -> case ext of
- ExtIServ i -> iservConfProfiled (interpConfig i)
- ExtJS {} -> False -- we don't support profiling yet in the JS backend
- ExtWasm i -> wasmInterpProfiled $ interpConfig i
-
--- | Interpreter uses Dynamic way
-interpreterDynamic :: Interp -> Bool
-interpreterDynamic interp = case interpInstance interp of
-#if defined(HAVE_INTERNAL_INTERPRETER)
- InternalInterp -> hostIsDynamic
-#endif
- ExternalInterp ext -> case ext of
- ExtIServ i -> iservConfDynamic (interpConfig i)
- ExtJS {} -> False -- dynamic doesn't make sense for JS
- ExtWasm {} -> True -- wasm dyld can only load dynamic code
+-- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
+-- from the 'HomeUnitGraph'.
+readModBreaks :: HomeUnitGraph -> Module -> IO ModBreaks
+readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
+
+-- -----------------------------------------------------------------------------
+-- Misc utils
+
+fromEvalResult :: EvalResult a -> IO a
+fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
+fromEvalResult (EvalSuccess a) = return a
+
=====================================
compiler/GHC/Runtime/Interpreter/Types.hs
=====================================
@@ -24,7 +24,8 @@ module GHC.Runtime.Interpreter.Types
, interpSymbolSuffix
, eliminateInterpSymbol
, interpretedInterpSymbol
-
+ , interpreterProfiled
+ , interpreterDynamic
-- * IServ
, IServ
@@ -48,6 +49,9 @@ import GHCi.RemoteTypes
import GHCi.Message ( Pipe )
import GHC.Platform
+#if defined(HAVE_INTERNAL_INTERPRETER)
+import GHC.Platform.Ways
+#endif
import GHC.Utils.TmpFs
import GHC.Utils.Logger
import GHC.Unit.Env
@@ -136,6 +140,28 @@ data ExtInterpInstance c = ExtInterpInstance
-- ^ Instance specific extra fields
}
+-- | Interpreter uses Profiling way
+interpreterProfiled :: Interp -> Bool
+interpreterProfiled interp = case interpInstance interp of
+#if defined(HAVE_INTERNAL_INTERPRETER)
+ InternalInterp -> hostIsProfiled
+#endif
+ ExternalInterp ext -> case ext of
+ ExtIServ i -> iservConfProfiled (interpConfig i)
+ ExtJS {} -> False -- we don't support profiling yet in the JS backend
+ ExtWasm i -> wasmInterpProfiled $ interpConfig i
+
+-- | Interpreter uses Dynamic way
+interpreterDynamic :: Interp -> Bool
+interpreterDynamic interp = case interpInstance interp of
+#if defined(HAVE_INTERNAL_INTERPRETER)
+ InternalInterp -> hostIsDynamic
+#endif
+ ExternalInterp ext -> case ext of
+ ExtIServ i -> iservConfDynamic (interpConfig i)
+ ExtJS {} -> False -- dynamic doesn't make sense for JS
+ ExtWasm {} -> True -- wasm dyld can only load dynamic code
+
------------------------
-- JS Stuff
------------------------
=====================================
compiler/GHC/Stg/BcPrep.hs
=====================================
@@ -49,7 +49,7 @@ bcPrepRHS con@StgRhsCon{} = pure con
bcPrepExpr :: StgExpr -> BcPrepM StgExpr
-- explicitly match all constructors so we get a warning if we miss any
-bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _ _) rhs)
+bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs)
| isLiftedTypeKind (typeKind tick_ty) = do
id <- newId tick_ty
rhs' <- bcPrepExpr rhs
=====================================
compiler/GHC/Stg/FVs.hs
=====================================
@@ -257,8 +257,8 @@ exprFVs env = go
, let lcl_fvs' = unionDVarSet (tickish tick) lcl_fvs
= (StgTick tick e', imp_fvs, top_fvs, lcl_fvs')
where
- tickish (Breakpoint _ _ ids _) = mkDVarSet ids
- tickish _ = emptyDVarSet
+ tickish (Breakpoint _ _ ids) = mkDVarSet ids
+ tickish _ = emptyDVarSet
go_bind dc bind body = (dc bind' body', imp_fvs, top_fvs, lcl_fvs)
where
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -33,6 +33,7 @@ import GHC.Platform.Profile
import GHC.Runtime.Interpreter
import GHCi.FFI
import GHC.Types.Basic
+import GHC.Types.Breakpoint
import GHC.Utils.Outputable
import GHC.Types.Name
import GHC.Types.Id
@@ -388,7 +389,7 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
code <- schemeE d 0 p rhs
hsc_env <- getHscEnv
current_mod <- getCurrentModule
@@ -640,10 +641,9 @@ schemeE d s p (StgLet _ext binds body) = do
thunk_codes <- sequence compile_binds
return (alloc_code `appOL` concatOL thunk_codes `appOL` body_code)
-schemeE _d _s _p (StgTick (Breakpoint _ bp_id _ _) _rhs)
- = panic ("schemeE: Breakpoint without let binding: " ++
- show bp_id ++
- " forgot to run bcPrep?")
+schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs)
+ = pprPanic "schemeE: Breakpoint without let binding: " $
+ ppr bp_id <> text " forgot to run bcPrep?"
-- ignore other kinds of tick
schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
=====================================
compiler/GHC/Types/Breakpoint.hs
=====================================
@@ -8,6 +8,9 @@ where
import GHC.Prelude
import GHC.Unit.Module
+import GHC.Utils.Outputable
+import Control.DeepSeq
+import Data.Data (Data)
-- | Breakpoint identifier.
--
@@ -16,7 +19,7 @@ data BreakpointId = BreakpointId
{ bi_tick_mod :: !Module -- ^ Breakpoint tick module
, bi_tick_index :: !Int -- ^ Breakpoint tick index
}
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Data)
-- | Internal breakpoint identifier
--
@@ -53,3 +56,11 @@ toBreakpointId ibi = BreakpointId
-- So every breakpoint occurrence gets assigned a module-unique *info index* and
-- we store it alongside the occurrence module (*info module*) in the
-- InternalBreakpointId datatype.
+
+instance Outputable BreakpointId where
+ ppr BreakpointId{bi_tick_mod, bi_tick_index} =
+ text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index
+
+instance NFData BreakpointId where
+ rnf BreakpointId{bi_tick_mod, bi_tick_index} =
+ rnf bi_tick_mod `seq` rnf bi_tick_index
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -31,6 +31,7 @@ import GHC.Core.Type
import GHC.Unit.Module
+import GHC.Types.Breakpoint
import GHC.Types.CostCentre
import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan )
import GHC.Types.Var
@@ -128,7 +129,7 @@ data GenTickish pass =
-- and (b) substituting (don't substitute for them)
| Breakpoint
{ breakpointExt :: XBreakpoint pass
- , breakpointId :: !Int
+ , breakpointId :: !BreakpointId
, breakpointFVs :: [XTickishId pass]
-- ^ the order of this list is important:
-- it matches the order of the lists in the
@@ -136,7 +137,6 @@ data GenTickish pass =
--
-- Careful about substitution! See
-- Note [substTickish] in "GHC.Core.Subst".
- , breakpointModule :: Module
}
-- | A source note.
=====================================
compiler/ghc.cabal.in
=====================================
@@ -548,6 +548,7 @@ Library
GHC.Driver.Plugins.External
GHC.Driver.Ppr
GHC.Driver.Session
+ GHC.Driver.Session.Inspect
GHC.Driver.Session.Units
GHC.Hs
GHC.Hs.Basic
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/674a1380fa8dcc4715be6a028880cb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/674a1380fa8dcc4715be6a028880cb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-8] 8 commits: compiler: make ModBreaks serializable
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
30 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC
Commits:
aa10928a by Cheng Shao at 2025-06-30T16:45:01+01:00
compiler: make ModBreaks serializable
- - - - -
5989a722 by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
refactor: "Inspecting the session" moved from GHC
Moved utilities for inspecting the session from the GHC module to
GHC.Driver.Session.Inspect
Purely a clean up
- - - - -
ff7d68ab by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
cleanup: Pass the HUG to readModBreaks, not HscEnv
A minor cleanup. The associated history and setupBreakpoint functions
are changed accordingly.
- - - - -
cc8a6cd8 by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
cleanup: Move readModBreaks to GHC.Runtime.Interpreter
With some small docs changes
- - - - -
56218cbf by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
cleanup: Move interpreterProfiled to Interp.Types
Moves interpreterProfiled and interpreterDynamic to
GHC.Runtime.Interpreter.Types from GHC.Runtime.Interpreter.
- - - - -
e60ece5d by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
cleanup: Don't import GHC in Debugger.Breakpoints
Remove the top-level
import GHC
from GHC.Runtime.Debugger.Breakpoints
This makes the module dependencies more granular and cleans up the
qualified imports from the code.
- - - - -
de60ae45 by Rodrigo Mesquita at 2025-06-30T19:08:43+01:00
refactor: Use BreakpointId in Core and Ifaces
- - - - -
6502cff1 by Rodrigo Mesquita at 2025-06-30T19:19:02+01:00
Big refactor of breakpoints internal representation
Big better
At this point we now have to go and re-work the BrkArrays to consider internal breakpoints (generated in StgGen) and multi-threading. tomorrow.
Continue refactor
Lots of progress
littel better
compiler: make ModBreaks serializable
Mais...
BRK_FUN in rts
Fixes
Tweaks
Checkpoint but segfaults in GC
Start part 4....
simpler
allow allocating breakarrays outside of linking but in the linker env still
disassemble
tack todo
The BreakArray construction at link time was originally done by Cheng.
Co-authored-by: Cheng Shao <terrorjack(a)type.dance>
- - - - -
48 changed files:
- compiler/GHC.hs
- compiler/GHC/ByteCode/Asm.hs
- + compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Map/Expr.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Main.hs
- + compiler/GHC/Driver/Session/Inspect.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Eval/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/FVs.hs
- compiler/GHC/StgToByteCode.hs
- − compiler/GHC/Types/Breakpoint.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9e01b4d5e8c3d5a838e87b54b3832…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9e01b4d5e8c3d5a838e87b54b3832…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-9] refactor: Use BreakpointId in Core and Ifaces
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
30 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC
Commits:
674a1380 by Rodrigo Mesquita at 2025-06-30T18:13:57+01:00
refactor: Use BreakpointId in Core and Ifaces
- - - - -
21 changed files:
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Map/Expr.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/FVs.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/Breakpoint.hs
- compiler/GHC/Types/Tickish.hs
Changes:
=====================================
compiler/GHC/Core/FVs.hs
=====================================
@@ -287,7 +287,7 @@ exprs_fvs :: [CoreExpr] -> FV
exprs_fvs exprs = mapUnionFV expr_fvs exprs
tickish_fvs :: CoreTickish -> FV
-tickish_fvs (Breakpoint _ _ ids _) = FV.mkFVs ids
+tickish_fvs (Breakpoint _ _ ids) = FV.mkFVs ids
tickish_fvs _ = emptyFV
{- **********************************************************************
@@ -759,8 +759,8 @@ freeVars = go
, AnnTick tickish expr2 )
where
expr2 = go expr
- tickishFVs (Breakpoint _ _ ids _) = mkDVarSet ids
- tickishFVs _ = emptyDVarSet
+ tickishFVs (Breakpoint _ _ ids) = mkDVarSet ids
+ tickishFVs _ = emptyDVarSet
go (Type ty) = (tyCoVarsOfTypeDSet ty, AnnType ty)
go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co)
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -897,8 +897,8 @@ lintCoreExpr (Cast expr co)
lintCoreExpr (Tick tickish expr)
= do { case tickish of
- Breakpoint _ _ ids _ -> forM_ ids $ \id -> lintIdOcc id 0
- _ -> return ()
+ Breakpoint _ _ ids -> forM_ ids $ \id -> lintIdOcc id 0
+ _ -> return ()
; markAllJoinsBadIf block_joins $ lintCoreExpr expr }
where
block_joins = not (tickish `tickishScopesLike` SoftScope)
=====================================
compiler/GHC/Core/Map/Expr.hs
=====================================
@@ -198,11 +198,10 @@ eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where
eqDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Bool
eqDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where
- go (Breakpoint lext lid lids lmod) (Breakpoint rext rid rids rmod)
+ go (Breakpoint lext lid lids) (Breakpoint rext rid rids)
= lid == rid
&& D env1 lids == D env2 rids
&& lext == rext
- && lmod == rmod
go l r = l == r
-- Compares for equality, modulo alpha
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -2501,7 +2501,7 @@ occAnal env (Tick tickish body)
-- For a non-soft tick scope, we can inline lambdas only, so we
-- abandon tail calls, and do markAllInsideLam too: usage_lam
- | Breakpoint _ _ ids _ <- tickish
+ | Breakpoint _ _ ids <- tickish
= -- Never substitute for any of the Ids in a Breakpoint
addManyOccs usage_lam (mkVarSet ids)
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -1461,8 +1461,8 @@ simplTick env tickish expr cont
simplTickish env tickish
- | Breakpoint ext n ids modl <- tickish
- = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) modl
+ | Breakpoint ext bid ids <- tickish
+ = Breakpoint ext bid (mapMaybe (getDoneId . substId env) ids)
| otherwise = tickish
-- Push type application and coercion inside a tick
=====================================
compiler/GHC/Core/Ppr.hs
=====================================
@@ -31,6 +31,7 @@ import GHC.Prelude
import GHC.Core
import GHC.Core.Stats (exprStats)
+import GHC.Types.Breakpoint
import GHC.Types.Fixity (LexicalFixity(..))
import GHC.Types.Literal( pprLiteral )
import GHC.Types.Name( pprInfixName, pprPrefixName )
@@ -694,10 +695,10 @@ instance Outputable (XTickishId pass) => Outputable (GenTickish pass) where
ppr modl, comma,
ppr ix,
text ">"]
- ppr (Breakpoint _ext ix vars modl) =
+ ppr (Breakpoint _ext bid vars) =
hcat [text "break<",
- ppr modl, comma,
- ppr ix,
+ ppr (bi_tick_mod bid), comma,
+ ppr (bi_tick_index bid),
text ">",
parens (hcat (punctuate comma (map ppr vars)))]
ppr (ProfNote { profNoteCC = cc,
=====================================
compiler/GHC/Core/Subst.hs
=====================================
@@ -602,8 +602,8 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs
------------------
-- | Drop free vars from the breakpoint if they have a non-variable substitution.
substTickish :: Subst -> CoreTickish -> CoreTickish
-substTickish subst (Breakpoint ext n ids modl)
- = Breakpoint ext n (mapMaybe do_one ids) modl
+substTickish subst (Breakpoint ext bid ids)
+ = Breakpoint ext bid (mapMaybe do_one ids)
where
do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst
=====================================
compiler/GHC/Core/Tidy.hs
=====================================
@@ -235,8 +235,8 @@ tidyAlt env (Alt con vs rhs)
------------ Tickish --------------
tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish
-tidyTickish env (Breakpoint ext ix ids modl)
- = Breakpoint ext ix (map (tidyVarOcc env) ids) modl
+tidyTickish env (Breakpoint ext bid ids)
+ = Breakpoint ext bid (map (tidyVarOcc env) ids)
tidyTickish _ other_tickish = other_tickish
------------ Rules --------------
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -2492,11 +2492,10 @@ cheapEqExpr' ignoreTick e1 e2
-- Used by diffBinds, which is itself only used in GHC.Core.Lint.lintAnnots
eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool
-eqTickish env (Breakpoint lext lid lids lmod) (Breakpoint rext rid rids rmod)
+eqTickish env (Breakpoint lext lid lids) (Breakpoint rext rid rids)
= lid == rid &&
map (rnOccL env) lids == map (rnOccR env) rids &&
- lext == rext &&
- lmod == rmod
+ lext == rext
eqTickish _ l r = l == r
-- | Finds differences between core bindings, see @diffExpr@.
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -586,8 +586,8 @@ toIfaceTickish (ProfNote cc tick push) = IfaceSCC cc tick push
toIfaceTickish (HpcTick modl ix) = IfaceHpcTick modl ix
toIfaceTickish (SourceNote src (LexicalFastString names)) =
IfaceSource src names
-toIfaceTickish (Breakpoint _ ix fv m) =
- IfaceBreakpoint ix (toIfaceVar <$> fv) m
+toIfaceTickish (Breakpoint _ ix fv) =
+ IfaceBreakpoint ix (toIfaceVar <$> fv)
---------------------
toIfaceBind :: Bind Id -> IfaceBinding IfaceLetBndr
=====================================
compiler/GHC/CoreToStg.hs
=====================================
@@ -643,10 +643,10 @@ coreToStgArgs (arg : args) = do -- Non-type argument
coreToStgTick :: Type -- type of the ticked expression
-> CoreTickish
-> StgTickish
-coreToStgTick _ty (HpcTick m i) = HpcTick m i
-coreToStgTick _ty (SourceNote span nm) = SourceNote span nm
-coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope
-coreToStgTick !ty (Breakpoint _ bid fvs modl) = Breakpoint ty bid fvs modl
+coreToStgTick _ty (HpcTick m i) = HpcTick m i
+coreToStgTick _ty (SourceNote span nm) = SourceNote span nm
+coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope
+coreToStgTick !ty (Breakpoint _ bid fvs) = Breakpoint ty bid fvs
-- ---------------------------------------------------------------------------
-- The magic for lets:
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -842,9 +842,9 @@ cpeRhsE env (Tick tickish expr)
= do { body <- cpeBodyNF env expr
; return (emptyFloats, mkTick tickish' body) }
where
- tickish' | Breakpoint ext n fvs modl <- tickish
+ tickish' | Breakpoint ext bid fvs <- tickish
-- See also 'substTickish'
- = Breakpoint ext n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs) modl
+ = Breakpoint ext bid (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs)
| otherwise
= tickish
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.Driver.Flags (DumpFlag(..))
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Utils.Logger
+import GHC.Types.Breakpoint
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.Id
@@ -1235,7 +1236,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
Breakpoints -> do
i <- addMixEntry me
- pure (Breakpoint noExtField i ids (this_mod env))
+ pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids)
SourceNotes | RealSrcSpan pos' _ <- pos ->
return $ SourceNote pos' $ LexicalFastString cc_name
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -56,6 +56,7 @@ import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,
constraintKindTyConKey )
+import GHC.Types.Breakpoint
import GHC.Types.Unique ( hasKey )
import GHC.Iface.Type
import GHC.Iface.Recomp.Binary
@@ -699,7 +700,7 @@ data IfaceTickish
= IfaceHpcTick Module Int -- from HpcTick x
| IfaceSCC CostCentre Bool Bool -- from ProfNote
| IfaceSource RealSrcSpan FastString -- from SourceNote
- | IfaceBreakpoint Int [IfaceExpr] Module -- from Breakpoint
+ | IfaceBreakpoint BreakpointId [IfaceExpr] -- from Breakpoint
data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr
-- Note: IfLclName, not IfaceBndr (and same with the case binder)
@@ -1848,7 +1849,7 @@ pprIfaceTickish (IfaceSCC cc tick scope)
= braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)
pprIfaceTickish (IfaceSource src _names)
= braces (pprUserRealSpan True src)
-pprIfaceTickish (IfaceBreakpoint m ix fvs)
+pprIfaceTickish (IfaceBreakpoint (BreakpointId m ix) fvs)
= braces (text "break" <+> ppr m <+> ppr ix <+> ppr fvs)
------------------
@@ -2198,7 +2199,7 @@ freeNamesIfaceTyConParent (IfDataInstance ax tc tys)
= unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfAppArgs tys
freeNamesIfTickish :: IfaceTickish -> NameSet
-freeNamesIfTickish (IfaceBreakpoint _ fvs _) =
+freeNamesIfTickish (IfaceBreakpoint _ fvs) =
fnList freeNamesIfExpr fvs
freeNamesIfTickish _ = emptyNameSet
@@ -2919,7 +2920,7 @@ instance Binary IfaceTickish where
put_ bh (srcSpanEndLine src)
put_ bh (srcSpanEndCol src)
put_ bh name
- put_ bh (IfaceBreakpoint m ix fvs) = do
+ put_ bh (IfaceBreakpoint (BreakpointId m ix) fvs) = do
putByte bh 3
put_ bh m
put_ bh ix
@@ -2947,7 +2948,7 @@ instance Binary IfaceTickish where
3 -> do m <- get bh
ix <- get bh
fvs <- get bh
- return (IfaceBreakpoint m ix fvs)
+ return (IfaceBreakpoint (BreakpointId m ix) fvs)
_ -> panic ("get IfaceTickish " ++ show h)
instance Binary IfaceConAlt where
@@ -3206,7 +3207,7 @@ instance NFData IfaceTickish where
IfaceHpcTick m i -> rnf m `seq` rnf i
IfaceSCC cc b1 b2 -> rnf cc `seq` rnf b1 `seq` rnf b2
IfaceSource src str -> rnf src `seq` rnf str
- IfaceBreakpoint m i fvs -> rnf m `seq` rnf i `seq` rnf fvs
+ IfaceBreakpoint i fvs -> rnf i `seq` rnf fvs
instance NFData IfaceConAlt where
rnf = \case
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -955,7 +955,7 @@ dffvExpr :: CoreExpr -> DFFV ()
dffvExpr (Var v) = insert v
dffvExpr (App e1 e2) = dffvExpr e1 >> dffvExpr e2
dffvExpr (Lam v e) = extendScope v (dffvExpr e)
-dffvExpr (Tick (Breakpoint _ _ ids _) e) = mapM_ insert ids >> dffvExpr e
+dffvExpr (Tick (Breakpoint _ _ ids) e) = mapM_ insert ids >> dffvExpr e
dffvExpr (Tick _other e) = dffvExpr e
dffvExpr (Cast e _) = dffvExpr e
dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e)
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -1732,9 +1732,9 @@ tcIfaceTickish :: IfaceTickish -> IfL CoreTickish
tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix)
tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push)
tcIfaceTickish (IfaceSource src name) = return (SourceNote src (LexicalFastString name))
-tcIfaceTickish (IfaceBreakpoint ix fvs modl) = do
+tcIfaceTickish (IfaceBreakpoint bid fvs) = do
fvs' <- mapM tcIfaceExpr fvs
- return (Breakpoint NoExtField ix [f | Var f <- fvs'] modl)
+ return (Breakpoint NoExtField bid [f | Var f <- fvs'])
-------------------------
tcIfaceLit :: Literal -> IfL Literal
=====================================
compiler/GHC/Stg/BcPrep.hs
=====================================
@@ -49,7 +49,7 @@ bcPrepRHS con@StgRhsCon{} = pure con
bcPrepExpr :: StgExpr -> BcPrepM StgExpr
-- explicitly match all constructors so we get a warning if we miss any
-bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _ _) rhs)
+bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs)
| isLiftedTypeKind (typeKind tick_ty) = do
id <- newId tick_ty
rhs' <- bcPrepExpr rhs
=====================================
compiler/GHC/Stg/FVs.hs
=====================================
@@ -257,8 +257,8 @@ exprFVs env = go
, let lcl_fvs' = unionDVarSet (tickish tick) lcl_fvs
= (StgTick tick e', imp_fvs, top_fvs, lcl_fvs')
where
- tickish (Breakpoint _ _ ids _) = mkDVarSet ids
- tickish _ = emptyDVarSet
+ tickish (Breakpoint _ _ ids) = mkDVarSet ids
+ tickish _ = emptyDVarSet
go_bind dc bind body = (dc bind' body', imp_fvs, top_fvs, lcl_fvs)
where
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -33,6 +33,7 @@ import GHC.Platform.Profile
import GHC.Runtime.Interpreter
import GHCi.FFI
import GHC.Types.Basic
+import GHC.Types.Breakpoint
import GHC.Utils.Outputable
import GHC.Types.Name
import GHC.Types.Id
@@ -388,7 +389,7 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
code <- schemeE d 0 p rhs
hsc_env <- getHscEnv
current_mod <- getCurrentModule
@@ -640,10 +641,9 @@ schemeE d s p (StgLet _ext binds body) = do
thunk_codes <- sequence compile_binds
return (alloc_code `appOL` concatOL thunk_codes `appOL` body_code)
-schemeE _d _s _p (StgTick (Breakpoint _ bp_id _ _) _rhs)
- = panic ("schemeE: Breakpoint without let binding: " ++
- show bp_id ++
- " forgot to run bcPrep?")
+schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs)
+ = pprPanic "schemeE: Breakpoint without let binding: " $
+ ppr bp_id <> text " forgot to run bcPrep?"
-- ignore other kinds of tick
schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
=====================================
compiler/GHC/Types/Breakpoint.hs
=====================================
@@ -8,6 +8,9 @@ where
import GHC.Prelude
import GHC.Unit.Module
+import GHC.Utils.Outputable
+import Control.DeepSeq
+import Data.Data (Data)
-- | Breakpoint identifier.
--
@@ -16,7 +19,7 @@ data BreakpointId = BreakpointId
{ bi_tick_mod :: !Module -- ^ Breakpoint tick module
, bi_tick_index :: !Int -- ^ Breakpoint tick index
}
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Data)
-- | Internal breakpoint identifier
--
@@ -53,3 +56,11 @@ toBreakpointId ibi = BreakpointId
-- So every breakpoint occurrence gets assigned a module-unique *info index* and
-- we store it alongside the occurrence module (*info module*) in the
-- InternalBreakpointId datatype.
+
+instance Outputable BreakpointId where
+ ppr BreakpointId{bi_tick_mod, bi_tick_index} =
+ text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index
+
+instance NFData BreakpointId where
+ rnf BreakpointId{bi_tick_mod, bi_tick_index} =
+ rnf bi_tick_mod `seq` rnf bi_tick_index
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -31,6 +31,7 @@ import GHC.Core.Type
import GHC.Unit.Module
+import GHC.Types.Breakpoint
import GHC.Types.CostCentre
import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan )
import GHC.Types.Var
@@ -128,7 +129,7 @@ data GenTickish pass =
-- and (b) substituting (don't substitute for them)
| Breakpoint
{ breakpointExt :: XBreakpoint pass
- , breakpointId :: !Int
+ , breakpointId :: !BreakpointId
, breakpointFVs :: [XTickishId pass]
-- ^ the order of this list is important:
-- it matches the order of the lists in the
@@ -136,7 +137,6 @@ data GenTickish pass =
--
-- Careful about substitution! See
-- Note [substTickish] in "GHC.Core.Subst".
- , breakpointModule :: Module
}
-- | A source note.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/674a1380fa8dcc4715be6a028880cbf…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/674a1380fa8dcc4715be6a028880cbf…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/26039] Bump default language edition to GHC2024
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
30 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/26039 at Glasgow Haskell Compiler / GHC
Commits:
ea1ba9c0 by Rodrigo Mesquita at 2025-06-30T17:59:56+01:00
Bump default language edition to GHC2024
As per the accepted ghc-proposal#632
Fixes #26039
- - - - -
41 changed files:
- compiler/GHC/Driver/Flags.hs
- testsuite/tests/ado/all.T
- testsuite/tests/annotations/should_fail/all.T
- testsuite/tests/array/should_run/all.T
- testsuite/tests/core-to-stg/all.T
- testsuite/tests/deSugar/should_fail/all.T
- testsuite/tests/deriving/should_compile/all.T
- testsuite/tests/deriving/should_fail/all.T
- testsuite/tests/dmdanal/sigs/all.T
- testsuite/tests/gadt/all.T
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/ghci/prog-mhu002/all.T
- testsuite/tests/ghci/scripts/Makefile
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/indexed-types/should_compile/all.T
- testsuite/tests/linear/should_fail/all.T
- testsuite/tests/module/all.T
- testsuite/tests/overloadedrecflds/should_fail/all.T
- testsuite/tests/parser/should_fail/all.T
- testsuite/tests/partial-sigs/should_compile/all.T
- testsuite/tests/polykinds/all.T
- testsuite/tests/programs/andy_cherry/test.T
- testsuite/tests/rename/should_fail/all.T
- testsuite/tests/roles/should_fail/all.T
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/HaddockIssue849.stdout
- testsuite/tests/showIface/HaddockOpts.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/showIface/Makefile
- testsuite/tests/showIface/NoExportList.stdout
- testsuite/tests/showIface/PragmaDocs.stdout
- testsuite/tests/showIface/ReExports.stdout
- testsuite/tests/simplCore/T9646/test.T
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_run/all.T
- testsuite/tests/vdq-rta/should_fail/all.T
- testsuite/tests/warnings/should_fail/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea1ba9c0225b275a3af8cc7912e67c6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea1ba9c0225b275a3af8cc7912e67c6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
30 Jun '25
Rodrigo Mesquita pushed new branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/step-out-9
You're receiving this email because of your account on gitlab.haskell.org.
1
0
30 Jun '25
Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC
Commits:
a78189b7 by Simon Peyton Jones at 2025-06-30T17:23:21+01:00
Error message wibbles
- - - - -
19 changed files:
- compiler/GHC/Tc/Errors.hs
- testsuite/tests/impredicative/T17332.stderr
- testsuite/tests/quantified-constraints/T15290a.stderr
- testsuite/tests/quantified-constraints/T19690.stderr
- testsuite/tests/quantified-constraints/T19921.stderr
- testsuite/tests/quantified-constraints/T21006.stderr
- testsuite/tests/simplCore/should_compile/T26117.hs
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/typecheck/should_compile/T12427a.stderr
- testsuite/tests/typecheck/should_compile/TcSpecPragmas.stderr
- testsuite/tests/typecheck/should_fail/T14605.hs
- testsuite/tests/typecheck/should_fail/T14605.stderr
- testsuite/tests/typecheck/should_fail/T15801.stderr
- testsuite/tests/typecheck/should_fail/T18640a.stderr
- testsuite/tests/typecheck/should_fail/T18640b.stderr
- testsuite/tests/typecheck/should_fail/T19627.stderr
- testsuite/tests/typecheck/should_fail/T21530b.stderr
- testsuite/tests/typecheck/should_fail/T22912.stderr
- testsuite/tests/typecheck/should_fail/tcfail174.stderr
Changes:
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -2220,8 +2220,10 @@ Warn of loopy local equalities that were dropped.
mkQCErr :: HasDebugCallStack => SolverReportErrCtxt -> NonEmpty ErrorItem -> TcM SolverReport
mkQCErr ctxt items
+ | item1 :| _ <- tryFilter (not . ei_suppress) items
+ -- Ignore multiple qc-errors on the same line
= do { let msg = mkPlainMismatchMsg $
- CouldNotDeduce (getUserGivens ctxt) items Nothing
+ CouldNotDeduce (getUserGivens ctxt) (item1 :| []) Nothing
; return $ important ctxt msg }
=====================================
testsuite/tests/impredicative/T17332.stderr
=====================================
@@ -1,7 +1,6 @@
-
T17332.hs:13:7: error: [GHC-05617]
- • Could not solve: ‘a’
- arising from the head of a quantified constraint
+ • Could not solve: ‘forall (a :: Constraint). a’
arising from a use of ‘MkDict’
• In the expression: MkDict
In an equation for ‘aux’: aux = MkDict
+
=====================================
testsuite/tests/quantified-constraints/T15290a.stderr
=====================================
@@ -1,9 +1,9 @@
T15290a.hs:25:12: error: [GHC-18872]
- • Couldn't match representation of type: m (Int, IntStateT m a1)
- with that of: m (Int, StateT Int m a1)
+ • Couldn't match representation of type: forall a.
+ StateT Int m (StateT Int m a) -> StateT Int m a
+ with that of: forall a.
+ IntStateT m (IntStateT m a) -> IntStateT m a
arising from a use of ‘coerce’
- Note: We cannot know what roles the parameters to ‘m’ have;
- we must assume that the role is nominal.
• In the expression:
coerce
@(forall a. StateT Int m (StateT Int m a) -> StateT Int m a)
=====================================
testsuite/tests/quantified-constraints/T19690.stderr
=====================================
@@ -1,10 +1,5 @@
-
T19690.hs:12:16: error: [GHC-05617]
- • Could not deduce ‘c’
- arising from the head of a quantified constraint
- arising from a use of ‘go’
- from the context: Hold c
- bound by a quantified context at T19690.hs:12:16-17
+ • Could not solve: ‘Hold c => c’ arising from a use of ‘go’
• In the expression: go
In an equation for ‘anythingDict’:
anythingDict
@@ -12,5 +7,4 @@ T19690.hs:12:16: error: [GHC-05617]
where
go :: (Hold c => c) => Dict c
go = Dict
- • Relevant bindings include
- anythingDict :: Dict c (bound at T19690.hs:12:1)
+
=====================================
testsuite/tests/quantified-constraints/T19921.stderr
=====================================
@@ -1,12 +1,6 @@
-
T19921.hs:29:8: error: [GHC-05617]
- • Could not deduce ‘r’
- arising from the head of a quantified constraint
- arising from the head of a quantified constraint
+ • Could not solve: ‘((x \/ y) \/ z) ⇒ (x \/ (y \/ z))’
arising from a use of ‘Dict’
- from the context: (x \/ y) \/ z
- bound by a quantified context at T19921.hs:29:8-11
- or from: (x ⇒ r, (y \/ z) ⇒ r)
- bound by a quantified context at T19921.hs:29:8-11
• In the expression: Dict
In an equation for ‘dict’: dict = Dict
+
=====================================
testsuite/tests/quantified-constraints/T21006.stderr
=====================================
@@ -1,8 +1,7 @@
-
T21006.hs:14:10: error: [GHC-05617]
- • Could not deduce ‘c’
- arising from the head of a quantified constraint
+ • Could not solve: ‘forall b (c :: Constraint).
+ (Determines b, Determines c) =>
+ c’
arising from the superclasses of an instance declaration
- from the context: (Determines b, Determines c)
- bound by a quantified context at T21006.hs:14:10-15
• In the instance declaration for ‘OpCode’
+
=====================================
testsuite/tests/simplCore/should_compile/T26117.hs
=====================================
@@ -1,5 +1,10 @@
{-# LANGUAGE UndecidableInstances, TypeFamilies #-}
+{- In -ddump-simpl output we do not want to see
+ case == @(F Int) lvl2_sQO eta_B0 eta_B0 of {
+ where (==) is called at a known type
+-}
+
module T26117 where
type family F a
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -550,4 +550,6 @@ test('T25703a', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisati
test('T26115', [grep_errmsg(r'DFun')], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T26116', normal, compile, ['-O -ddump-rules'])
+test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+
=====================================
testsuite/tests/typecheck/should_compile/T12427a.stderr
=====================================
@@ -1,4 +1,3 @@
-
T12427a.hs:17:29: error: [GHC-91028]
• Couldn't match expected type ‘p’
with actual type ‘(forall b. [b] -> [b]) -> Int’
@@ -24,12 +23,11 @@ T12427a.hs:28:6: error: [GHC-91028]
• In the pattern: T1 _ x1
In a pattern binding: T1 _ x1 = undefined
-T12427a.hs:41:6: error: [GHC-25897]
- • Couldn't match type ‘b’ with ‘[b]’
+T12427a.hs:41:6: error: [GHC-83865]
+ • Couldn't match type: forall b. [b] -> [b]
+ with: forall a. a -> a
Expected: (forall b. [b] -> [b]) -> Int
Actual: (forall a. a -> a) -> Int
- ‘b’ is a rigid type variable bound by
- the type [b] -> [b]
- at T12427a.hs:41:1-19
• In the pattern: T1 _ x3
In a pattern binding: T1 _ x3 = undefined
+
=====================================
testsuite/tests/typecheck/should_compile/TcSpecPragmas.stderr
=====================================
@@ -8,8 +8,3 @@ TcSpecPragmas.hs:42:1: warning: [GHC-66582] [-Wuseless-specialisations (in -Wdef
The pragma does not specialise away any class dictionaries,
and neither is there any value specialisation.
-TcSpecPragmas.hs:54:1: warning: [GHC-66582] [-Wuseless-specialisations (in -Wdefault)]
- Dubious SPECIALISE pragma for ‘tyEq’.
- The pragma does not specialise away any class dictionaries,
- and neither is there any value specialisation.
-
=====================================
testsuite/tests/typecheck/should_fail/T14605.hs
=====================================
@@ -6,6 +6,8 @@
--
-- The ticket #14605 has a much longer example that
-- also fails; it does not use ImpredicativeTypes
+--
+-- The error message is not great; but it's an obscure program
module T14605 where
=====================================
testsuite/tests/typecheck/should_fail/T14605.stderr
=====================================
@@ -1,10 +1,8 @@
-
-T14605.hs:14:13: error: [GHC-10283]
- • Couldn't match representation of type ‘x’ with that of ‘()’
+T14605.hs:16:13: error: [GHC-18872]
+ • Couldn't match representation of type: forall x. ()
+ with that of: forall x. x
arising from a use of ‘coerce’
- ‘x’ is a rigid type variable bound by
- the type ()
- at T14605.hs:14:1-49
• In the expression: coerce @(forall x. ()) @(forall x. x)
In an equation for ‘duplicate’:
duplicate = coerce @(forall x. ()) @(forall x. x)
+
=====================================
testsuite/tests/typecheck/should_fail/T15801.stderr
=====================================
@@ -1,7 +1,6 @@
-
-T15801.hs:52:10: error: [GHC-18872]
- • Couldn't match representation of type: UnOp op_a -> UnOp b
- with that of: op_a --> b
- arising from the head of a quantified constraint
+T15801.hs:52:10: error: [GHC-05617]
+ • Could not solve: ‘forall (op_a :: Op (*)) (b :: Op (*)).
+ op_a -#- b’
arising from the superclasses of an instance declaration
• In the instance declaration for ‘OpRíki (Op (*))’
+
=====================================
testsuite/tests/typecheck/should_fail/T18640a.stderr
=====================================
@@ -1,9 +1,5 @@
-
-T18640a.hs:12:1: error: [GHC-25897]
- • Couldn't match kind ‘a’ with ‘*’
- Expected: forall (b :: k). * -> *
- Actual: forall (b :: k). * -> a
- ‘a’ is a rigid type variable bound by
- the type family declaration for ‘F2’
- at T18640a.hs:12:17
+T18640a.hs:12:1: error: [GHC-83865]
+ • Couldn't match expected kind: forall (b :: k). * -> *
+ with actual kind: forall (b :: k). * -> a
• In the type family declaration for ‘F2’
+
=====================================
testsuite/tests/typecheck/should_fail/T18640b.stderr
=====================================
@@ -1,12 +1,5 @@
-
-T18640b.hs:14:10: error: [GHC-25897]
- • Couldn't match kind ‘k’ with ‘a’
- Expected kind ‘forall b -> a’, but ‘F1’ has kind ‘forall k -> k’
- ‘k’ is a rigid type variable bound by
- the type k
- at T18640b.hs:14:3-11
- ‘a’ is a rigid type variable bound by
- a family instance declaration
- at T18640b.hs:14:6
+T18640b.hs:14:10: error: [GHC-83865]
+ • Expected kind ‘forall b -> a’, but ‘F1’ has kind ‘forall k -> k’
• In the type ‘F1’
In the type family declaration for ‘F3’
+
=====================================
testsuite/tests/typecheck/should_fail/T19627.stderr
=====================================
@@ -18,28 +18,3 @@ T19627.hs:108:3: error: [GHC-05617]
Not (p a b) -> b <#- a
In the class declaration for ‘Lol’
-T19627.hs:108:3: error: [GHC-05617]
- • Could not deduce ‘Not (Not (p0 a1 b1)) ~ p0 a1 b1’
- arising from a superclass required to satisfy ‘Prop (p0 a1 b1)’,
- arising from the head of a quantified constraint
- arising from a superclass required to satisfy ‘Iso p0’,
- arising from a superclass required to satisfy ‘Lol p0’,
- arising from a type ambiguity check for
- the type signature for ‘apartR’
- from the context: Lol p
- bound by the type signature for:
- apartR :: forall (p :: * -> * -> *) a b.
- Lol p =>
- Not (p a b) -> b <#- a
- at T19627.hs:108:3-34
- or from: (Prop a1, Prop b1)
- bound by a quantified context at T19627.hs:108:3-34
- The type variable ‘p0’ is ambiguous
- • In the ambiguity check for ‘apartR’
- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
- When checking the class method:
- apartR :: forall (p :: * -> * -> *) a b.
- Lol p =>
- Not (p a b) -> b <#- a
- In the class declaration for ‘Lol’
-
=====================================
testsuite/tests/typecheck/should_fail/T21530b.stderr
=====================================
@@ -1,8 +1,8 @@
-
T21530b.hs:9:5: error: [GHC-83865]
- • Couldn't match type: Eq a => a -> String
- with: a -> String
+ • Couldn't match type: forall a. (Show a, Eq a) => a -> String
+ with: forall a. Show a => a -> String
Expected: (forall a. Show a => a -> String) -> String
Actual: (forall a. (Show a, Eq a) => a -> String) -> String
• In the expression: f
In an equation for ‘g’: g = f
+
=====================================
testsuite/tests/typecheck/should_fail/T22912.stderr
=====================================
@@ -1,16 +1,6 @@
-
-T22912.hs:17:16: error: [GHC-39999]
- • Could not deduce ‘Implies c’
- arising from the head of a quantified constraint
+T22912.hs:17:16: error: [GHC-05617]
+ • Could not solve: ‘Exactly (Implies c) => Implies c’
arising from a use of ‘go’
- from the context: Exactly (Implies c)
- bound by a quantified context at T22912.hs:17:16-17
- Possible fix:
- add (Implies c) to the context of
- the type signature for:
- anythingDict :: forall (c :: Constraint). Dict c
- or If the constraint looks soluble from a superclass of the instance context,
- read 'Undecidable instances and loopy superclasses' in the user manual
• In the expression: go
In an equation for ‘anythingDict’:
anythingDict
@@ -18,3 +8,4 @@ T22912.hs:17:16: error: [GHC-39999]
where
go :: (Exactly (Implies c) => Implies c) => Dict c
go = Dict
+
=====================================
testsuite/tests/typecheck/should_fail/tcfail174.stderr
=====================================
@@ -1,33 +1,22 @@
-
-tcfail174.hs:20:14: error: [GHC-25897]
- • Couldn't match type ‘a1’ with ‘a’
+tcfail174.hs:20:14: error: [GHC-83865]
+ • Couldn't match type: forall a1. a1 -> a1
+ with: forall x. x -> a
Expected: Capture (forall x. x -> a)
Actual: Capture (forall a. a -> a)
- ‘a1’ is a rigid type variable bound by
- the type a -> a
- at tcfail174.hs:20:1-14
- ‘a’ is a rigid type variable bound by
- the inferred type of h1 :: Capture a
- at tcfail174.hs:20:1-14
• In the first argument of ‘Capture’, namely ‘g’
In the expression: Capture g
In an equation for ‘h1’: h1 = Capture g
• Relevant bindings include
h1 :: Capture a (bound at tcfail174.hs:20:1)
-tcfail174.hs:23:14: error: [GHC-25897]
- • Couldn't match type ‘a’ with ‘b’
+tcfail174.hs:23:14: error: [GHC-83865]
+ • Couldn't match type: forall a. a -> a
+ with: forall x. x -> b
Expected: Capture (forall x. x -> b)
Actual: Capture (forall a. a -> a)
- ‘a’ is a rigid type variable bound by
- the type a -> a
- at tcfail174.hs:1:1
- ‘b’ is a rigid type variable bound by
- the type signature for:
- h2 :: forall b. Capture b
- at tcfail174.hs:22:1-15
• In the first argument of ‘Capture’, namely ‘g’
In the expression: Capture g
In an equation for ‘h2’: h2 = Capture g
• Relevant bindings include
h2 :: Capture b (bound at tcfail174.hs:23:1)
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a78189b75f554af0fec8e5e03699bbd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a78189b75f554af0fec8e5e03699bbd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-8] Big refactor of breakpoints internal representation
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
30 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC
Commits:
f9e01b4d by Rodrigo Mesquita at 2025-06-30T16:41:51+01:00
Big refactor of breakpoints internal representation
Big better
At this point we now have to go and re-work the BrkArrays to consider internal breakpoints (generated in StgGen) and multi-threading. tomorrow.
Continue refactor
Lots of progress
littel better
compiler: make ModBreaks serializable
Mais...
BRK_FUN in rts
Fixes
Tweaks
Checkpoint but segfaults in GC
Start part 4....
simpler
allow allocating breakarrays outside of linking but in the linker env still
disassemble
tack todo
The BreakArray construction at link time was originally done by Cheng.
Co-authored-by: Cheng Shao <terrorjack(a)type.dance>
- - - - -
48 changed files:
- compiler/GHC.hs
- compiler/GHC/ByteCode/Asm.hs
- + compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Map/Expr.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Main.hs
- + compiler/GHC/Driver/Session/Inspect.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Eval/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/FVs.hs
- compiler/GHC/StgToByteCode.hs
- − compiler/GHC/Types/Breakpoint.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9e01b4d5e8c3d5a838e87b54b38329…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9e01b4d5e8c3d5a838e87b54b38329…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/overloaded_calls] Disable -fprof-late-overloaded-calls for join points.
by Andreas Klebinger (＠AndreasK) 30 Jun '25
by Andreas Klebinger (＠AndreasK) 30 Jun '25
30 Jun '25
Andreas Klebinger pushed to branch wip/andreask/overloaded_calls at Glasgow Haskell Compiler / GHC
Commits:
bfb7983f by Andreas Klebinger at 2025-06-30T16:35:27+02:00
Disable -fprof-late-overloaded-calls for join points.
Currently GHC considers cost centres as destructive to
join contexts. Or in other words this is not considered valid:
join f x = ...
in
... -> scc<tick> jmp
This makes the functionality of `-fprof-late-overloaded-calls` not feasible
for join points in general. We used to try to work around this by putting the
ticks on the rhs of the join point rather than around the jump. However beyond
the loss of accuracy this was broken for recursive join points as we ended up
with something like:
rec-join f x = scc<tick> ... jmp f x
Which similarly is not valid as the tick once again destroys the tail call.
One might think we could limit ourselves to non-recursive tail calls and do
something clever like:
join f x = scc<tick> ...
in ... jmp f x
And sometimes this works! But sometimes the full rhs would look something like:
join g x = ....
join f x = scc<tick> ... -> jmp g x
Which, would again no longer be valid. I believe in the long run we can make
cost centre ticks non-destructive to join points. Or we could keep track of
where we are/are not allowed to insert a cost centre. But in the short term I will
simply disable the annotation of join calls under this flag.
- - - - -
2 changed files:
- compiler/GHC/Core/LateCC/OverloadedCalls.hs
- docs/users_guide/profiling.rst
Changes:
=====================================
compiler/GHC/Core/LateCC/OverloadedCalls.hs
=====================================
@@ -29,6 +29,41 @@ import GHC.Types.Var
type OverloadedCallsCCState = Strict.Maybe SrcSpan
+{- Note [Overloaded Calls and join points]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Currently GHC considers cost centres as destructive to
+join contexts. Or in other words this is not considered valid:
+
+ join f x = ...
+ in
+ ... -> scc<tick> jmp
+
+This makes the functionality of `-fprof-late-overloaded-calls` not feasible
+for join points in general. We used to try to work around this by putting the
+ticks on the rhs of the join point rather than around the jump. However beyond
+the loss of accuracy this was broken for recursive join points as we ended up
+with something like:
+
+ rec-join f x = scc<tick> ... jmp f x
+
+Which similarly is not valid as the tick once again destroys the tail call.
+One might think we could limit ourselves to non-recursive tail calls and do
+something clever like:
+
+ join f x = scc<tick> ...
+ in ... jmp f x
+
+And sometimes this works! But sometimes the full rhs would look something like:
+
+ join g x = ....
+ join f x = scc<tick> ... -> jmp g x
+
+Which, would again no longer be valid. I believe in the long run we can make
+cost centre ticks non-destructive to join points. Or we could keep track of
+where we are/are not allowed to insert a cost centre. But in the short term I will
+simply disable the annotation of join calls under this flag.
+-}
+
-- | Insert cost centres on function applications with dictionary arguments. The
-- source locations attached to the cost centres is approximated based on the
-- "closest" source note encountered in the traversal.
@@ -52,21 +87,10 @@ overloadedCallsCC =
CoreBndr
-> LateCCM OverloadedCallsCCState CoreExpr
-> LateCCM OverloadedCallsCCState CoreExpr
- wrap_if_join b pexpr = do
+ wrap_if_join _b pexpr = do
+ -- See Note [Overloaded Calls and join points]
expr <- pexpr
- if isJoinId b && isOverloadedTy (exprType expr) then do
- let
- cc_name :: FastString
- cc_name = fsLit "join-rhs-" `appendFS` getOccFS b
-
- cc_srcspan <-
- fmap (Strict.fromMaybe (UnhelpfulSpan UnhelpfulNoLocationInfo)) $
- lift $ gets lateCCState_extra
-
- insertCC cc_name cc_srcspan expr
- else
- return expr
-
+ return expr
processExpr :: CoreExpr -> LateCCM OverloadedCallsCCState CoreExpr
processExpr expr =
@@ -99,6 +123,7 @@ overloadedCallsCC =
-- Avoid instrumenting join points.
-- (See comment in processBind above)
+ -- Also see Note [Overloaded Calls and join points]
&& not (isJoinVarExpr f)
then do
-- Extract a name and source location from the function being
=====================================
docs/users_guide/profiling.rst
=====================================
@@ -571,9 +571,7 @@ of your profiled program will be different to that of the unprofiled one.
Some overloaded calls may not be annotated, specifically in cases where the
optimizer turns an overloaded function into a join point. Calls to such
functions will not be wrapped in ``SCC`` annotations, since it would make
- them non-tail calls, which is a requirement for join points. Instead,
- ``SCC`` annotations are added around the body of overloaded join variables
- and given distinct names (``join-rhs-<var>``) to avoid confusion.
+ them non-tail calls, which is a requirement for join points.
.. ghc-flag:: -fprof-cafs
:shortdesc: Auto-add ``SCC``\\ s to all CAFs
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfb7983f7ba668aa42d2a26ae047a18…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfb7983f7ba668aa42d2a26ae047a18…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T18570] 3 commits: Calculate multiplicity for record selector functions
by Sjoerd Visscher (＠trac-sjoerd_visscher) 30 Jun '25
by Sjoerd Visscher (＠trac-sjoerd_visscher) 30 Jun '25
30 Jun '25
Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC
Commits:
33b192c2 by Sjoerd Visscher at 2025-06-30T15:48:12+02:00
Calculate multiplicity for record selector functions
Until now record selector functions always had multiplicity Many, but when all the other fields have been declared with multiplicity Many (including the case when there are no other fields), then the selector function is allowed to be used linearly too, as it is allowed to discard all the other fields. Since in that case the multiplicity can be both One and Many, the selector function is made multiplicity-polymorphic.
- - - - -
5c2e78f2 by Sjoerd Visscher at 2025-06-30T15:50:52+02:00
Fix hole fits
In case all type arguments are inferred, a useless "with a" was added to hole fits.
- - - - -
1c037b30 by Sjoerd Visscher at 2025-06-30T16:02:09+02:00
Fix field type mismatch error handling
Errors in check_fields don't fail in the monad. (This commit also makes this more clear in the code.) So they didn't trigger the recovery code in checkValidTyCl.
Fixes issue #26149
- - - - -
22 changed files:
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/bugs.rst
- docs/users_guide/exts/linear_types.rst
- + testsuite/tests/linear/should_compile/LinearRecordSelector.hs
- testsuite/tests/linear/should_compile/all.T
- + testsuite/tests/linear/should_fail/LinearRecordSelectorFail.hs
- + testsuite/tests/linear/should_fail/LinearRecordSelectorFail.stderr
- testsuite/tests/linear/should_fail/all.T
- testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
- testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout
- testsuite/tests/perf/compiler/T16875.stderr
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
- testsuite/tests/typecheck/should_fail/T12083a.hs
- testsuite/tests/typecheck/should_fail/T12083a.stderr
- testsuite/tests/typecheck/should_fail/T9739.hs
- testsuite/tests/typecheck/should_fail/T9739.stderr
- utils/haddock/html-test/ref/Bug294.html
Changes:
=====================================
compiler/GHC/Core/DataCon.hs
=====================================
@@ -44,6 +44,7 @@ module GHC.Core.DataCon (
dataConInstOrigArgTys, dataConRepArgTys, dataConResRepTyArgs,
dataConInstUnivs,
dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,
+ dataConOtherFieldsAllMultMany,
dataConSrcBangs,
dataConSourceArity, dataConVisArity, dataConRepArity,
dataConIsInfix,
@@ -1406,6 +1407,15 @@ dataConFieldType_maybe :: DataCon -> FieldLabelString
dataConFieldType_maybe con label
= find ((== label) . flLabel . fst) (dcFields con `zip` (scaledThing <$> dcOrigArgTys con))
+-- | Check if all the fields of the 'DataCon' have multiplicity 'Many',
+-- except for the given labelled field. In this case the selector
+-- of the given field can be a linear function, since it is allowed
+-- to discard all the other fields.
+dataConOtherFieldsAllMultMany :: DataCon -> FieldLabelString -> Bool
+dataConOtherFieldsAllMultMany con label
+ = all (\(fld, mult) -> flLabel fld == label || isManyTy mult)
+ (dcFields con `zip` (scaledMult <$> dcOrigArgTys con))
+
-- | Strictness/unpack annotations, from user; or, for imported
-- DataCons, from the interface file
-- The list is in one-to-one correspondence with the arity of the 'DataCon'
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3541,12 +3541,12 @@ pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
pprHoleFit _ (RawHoleFit sd) = sd
pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
hang display 2 provenance
- where tyApp = sep $ zipWithEqual pprArg vars hfWrap
+ where tyApps = concat $ zipWithEqual pprArg vars hfWrap
where pprArg b arg = case binderFlag b of
- Specified -> text "@" <> pprParendType arg
+ Specified -> [text "@" <> pprParendType arg]
-- Do not print type application for inferred
-- variables (#16456)
- Inferred -> empty
+ Inferred -> []
Required -> pprPanic "pprHoleFit: bad Required"
(ppr b <+> ppr arg)
tyAppVars = sep $ punctuate comma $
@@ -3573,9 +3573,9 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
IdHFCand id_ -> pprPrefixOcc id_
tyDisp = ppWhen sTy $ dcolon <+> ppr hfType
has = not . null
- wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars))
+ wrapDisp = ppWhen (has tyApps && (sWrp || sWrpVars))
$ text "with" <+> if sWrp || not sTy
- then occDisp <+> tyApp
+ then occDisp <+> sep tyApps
else tyAppVars
docs = case hfDoc of
Just d -> pprHsDocStrings d
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -4787,6 +4787,7 @@ checkValidTyCl tc
= setSrcSpan (getSrcSpan tc) $
addTyConCtxt tc $
recoverM recovery_code $
+ checkNoErrs $
do { traceTc "Starting validity for tycon" (ppr tc)
; checkValidTyCon tc
; checkTyConConsistentWithBoot tc -- See Note [TyCon boot consistency checking]
@@ -4818,6 +4819,9 @@ See indexed-types/should_fail/BadSock and #10896
Some notes:
+* Not all errors in `checkValidTyCon` fail in the monad. To make sure
+ we also recover from these, we use `checkNoErrs`. See (#26149)
+
* We must make fakes for promoted DataCons too. Consider (#15215)
data T a = MkT ...
data S a = ...T...MkT....
@@ -4991,7 +4995,7 @@ checkValidTyCon tc
check_fields ((label, con1) :| other_fields)
-- These fields all have the same name, but are from
-- different constructors in the data type
- = recoverM (return ()) $ mapM_ checkOne other_fields
+ = mapM_ checkOne other_fields
-- Check that all the fields in the group have the same type
-- NB: this check assumes that all the constructors of a given
-- data type use the same type variables
@@ -5001,8 +5005,9 @@ checkValidTyCon tc
lbl = flLabel label
checkOne (_, con2) -- Do it both ways to ensure they are structurally identical
- = do { checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
- ; checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
+ = traverse_ addErrTc $ firstJust -- Don't report the same error twice
+ (checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2)
+ (checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1)
where
res2 = dataConOrigResTy con2
fty2 = dataConFieldType con2 lbl
@@ -5027,10 +5032,13 @@ checkPartialRecordField all_cons fld
inst_tys = dataConResRepTyArgs con1
checkFieldCompat :: FieldLabelString -> DataCon -> DataCon
- -> Type -> Type -> Type -> Type -> TcM ()
+ -> Type -> Type -> Type -> Type -> Maybe TcRnMessage
checkFieldCompat fld con1 con2 res1 res2 fty1 fty2
- = do { checkTc (isJust mb_subst1) (TcRnCommonFieldResultTypeMismatch con1 con2 fld)
- ; checkTc (isJust mb_subst2) (TcRnCommonFieldTypeMismatch con1 con2 fld) }
+ = if isNothing mb_subst1
+ then Just $ TcRnCommonFieldResultTypeMismatch con1 con2 fld
+ else if isNothing mb_subst2
+ then Just $ TcRnCommonFieldTypeMismatch con1 con2 fld
+ else Nothing
where
mb_subst1 = tcMatchTy res1 res2
mb_subst2 = tcMatchTyX (expectJust mb_subst1) fty1 fty2
=====================================
compiler/GHC/Tc/TyCl/Utils.hs
=====================================
@@ -32,7 +32,7 @@ import GHC.Tc.Utils.Env
import GHC.Tc.Gen.Bind( tcValBinds )
import GHC.Tc.Utils.TcType
-import GHC.Builtin.Types( unitTy )
+import GHC.Builtin.Types( unitTy, manyDataConTy, multiplicityTy )
import GHC.Builtin.Uniques ( mkBuiltinUnique )
import GHC.Hs
@@ -71,6 +71,7 @@ import GHC.Types.Name.Env
import GHC.Types.Name.Reader ( mkRdrUnqual )
import GHC.Types.Id
import GHC.Types.Id.Info
+import GHC.Types.Var (mkTyVar)
import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Types.Unique.Set
@@ -853,11 +854,11 @@ mkRecSelBinds :: [TyCon] -> [(Id, LHsBind GhcRn)]
-- This makes life easier, because the later type checking will add
-- all necessary type abstractions and applications
mkRecSelBinds tycons
- = map mkRecSelBind [ (tc,fld) | tc <- tycons
- , fld <- tyConFieldLabels tc ]
+ = [ mkRecSelBind tc fld | tc <- tycons
+ , fld <- tyConFieldLabels tc ]
-mkRecSelBind :: (TyCon, FieldLabel) -> (Id, LHsBind GhcRn)
-mkRecSelBind (tycon, fl)
+mkRecSelBind :: TyCon -> FieldLabel -> (Id, LHsBind GhcRn)
+mkRecSelBind tycon fl
= mkOneRecordSelector all_cons (RecSelData tycon) fl
FieldSelectors -- See Note [NoFieldSelectors and naughty record selectors]
where
@@ -916,17 +917,24 @@ mkOneRecordSelector all_cons idDetails fl has_sel
-- thus suppressing making a binding
-- A slight hack!
+ all_other_fields_unrestricted = all all_other_unrestricted all_cons
+ where
+ all_other_unrestricted PatSynCon{} = False
+ all_other_unrestricted (RealDataCon dc) = dataConOtherFieldsAllMultMany dc lbl
+
sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors]
- | otherwise = mkForAllTys sel_tvbs $
+ | otherwise = mkForAllTys (sel_tvbs ++ mult_tvb) $
-- Urgh! See Note [The stupid context] in GHC.Core.DataCon
- mkPhiTy (conLikeStupidTheta con1) $
+ mkPhiTy (conLikeStupidTheta con1) $
-- req_theta is empty for normal DataCon
- mkPhiTy req_theta $
- mkVisFunTyMany data_ty $
- -- Record selectors are always typed with Many. We
- -- could improve on it in the case where all the
- -- fields in all the constructor have multiplicity Many.
+ mkPhiTy req_theta $
+ mkVisFunTy sel_mult data_ty $
field_ty
+ non_partial = length all_cons == length cons_w_field -- See Note [Multiplicity and partial selectors]
+ (mult_tvb, sel_mult) = if non_partial && all_other_fields_unrestricted
+ then ([mkForAllTyBinder (Invisible InferredSpec) mult_var], mkTyVarTy mult_var)
+ else ([], manyDataConTy)
+ mult_var = mkTyVar (mkSysTvName (mkBuiltinUnique 1) (fsLit "m")) multiplicityTy
-- make the binding: sel (C2 { fld = x }) = x
-- sel (C7 { fld = x }) = x
@@ -1165,4 +1173,13 @@ Therefore, when used in the right-hand side of `unT`, GHC attempts to
instantiate `a` with `(forall b. b -> b) -> Int`, which is impredicative.
To make sure that GHC is OK with this, we enable ImpredicativeTypes internally
when typechecking these HsBinds so that the user does not have to.
+
+Note [Multiplicity and partial selectors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+While all logic for making record selectors multiplicity-polymorphic also applies
+to partial selectors, there is a technical difficulty: the catch-all default case
+that is added throws away its argument, and so cannot be linear. A simple workaround
+was not found. There may exist a more complicated workaround, but the combination of
+linear types and partial selectors is not expected to be very popular in practice, so
+it was decided to not allow multiplicity-polymorphic partial selectors at all.
-}
=====================================
docs/users_guide/9.14.1-notes.rst
=====================================
@@ -67,6 +67,13 @@ Language
This causes the constructor to have type ``Rec :: Int %'Many -> Char %1 -> Record``.
+ Also record selector functions are now multiplicity-polymorphic when possible.
+ In the above example the selector function ``y`` now has type
+ ``y :: Record %m -> Char``, because the ``x`` field is allowed to be discarded.
+ In particular this always applies to the selector of a newtype wrapper.
+ (Note that in theory this should also work with partial record selectors,
+ but for technical reasons this is not supported.)
+
* The :extension:`ExplicitNamespaces` extension now allows the ``data``
namespace specifier in import and export lists.
=====================================
docs/users_guide/bugs.rst
=====================================
@@ -701,6 +701,9 @@ Bugs in GHC
- Because of a toolchain limitation we are unable to support full Unicode paths
on Windows. On Windows we support up to Latin-1. See :ghc-ticket:`12971` for more.
+- For technical reasons, partial record selectors cannot be made
+ multiplicity-polymorphic, so they are always unrestricted.
+
.. _bugs-ghci:
Bugs in GHCi (the interactive GHC)
=====================================
docs/users_guide/exts/linear_types.rst
=====================================
@@ -238,7 +238,7 @@ to use ``MkT1`` in higher order functions. The additional multiplicity
argument ``m`` is marked as inferred (see
:ref:`inferred-vs-specified`), so that there is no conflict with
visible type application. When displaying types, unless
-``-XLinearTypes`` is enabled, multiplicity polymorphic functions are
+``-XLinearTypes`` is enabled, multiplicity-polymorphic functions are
printed as regular functions (see :ref:`printing-linear-types`);
therefore constructors appear to have regular function types.
@@ -256,21 +256,33 @@ using GADT syntax or record syntax. Given
::
data T2 a b c where
- MkT2 :: a -> b %1 -> c %1 -> T2 a b c -- Note unrestricted arrow in the first argument
+ MkT2 :: a -> b %1 -> c -> T2 a b c -- Note the unrestricted arrows on a and c
-the value ``MkT2 x y z`` can be constructed only if ``x`` is
-unrestricted. On the other hand, a linear function which is matching
-on ``MkT2 x y z`` must consume ``y`` and ``z`` exactly once, but there
-is no restriction on ``x``. The same example can be written using record syntax:
+the value ``MkT2 x y z`` can be constructed only if ``x`` and
+``z`` are unrestricted. On the other hand, a linear function which is
+matching on ``MkT2 x y z`` must consume ``y`` exactly once, but there
+is no restriction on ``x`` and ``z``.
+The same example can be written using record syntax:
::
- data T2 a b c = MkT2 { x %'Many :: a, y :: b, z :: c }
+ data T2 a b c = MkT2 { x %'Many :: a, y :: b, z %'Many :: c }
Again, the constructor ``MkT2`` has type ``MkT2 :: a -> b %1 -> c %1 -> T2 a b c``.
Note that by default record fields are linear, only unrestricted fields
-require a multiplicity annotation. The annotation has no effect on the record selectors.
-So ``x`` has type ``x :: T2 a b c -> a`` and similarly ``y`` has type ``y :: T2 a b c -> b``.
+require a multiplicity annotation.
+
+The multiplicity of record selectors is inferred from the multiplicity of the fields. Note that
+the effect of a selector is to discard all the other fields, so it can only be linear if all the
+other fields are unrestricted. So ``x`` has type ``x :: T2 a b c -> a``, because the ``y`` field
+is not unrestricted. But the ``x`` and ``z`` fields are unrestricted, so the selector for ``y``
+can be linear, and therefore it is made to be multiplicity-polymorphic: ``y :: T2 a b c %m -> b``.
+In particular this always applies to the selector of a newtype wrapper.
+
+In the case of multiple constructors, this logic is repeated for each constructor. So a selector
+is only made multiplicity-polymorphic if for every constructor all the other fields are unrestricted.
+(For technical reasons, partial record selectors cannot be made multiplicity-polymorphic, so they
+are always unrestricted.)
It is also possible to define a multiplicity-polymorphic field:
=====================================
testsuite/tests/linear/should_compile/LinearRecordSelector.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE LinearTypes, DataKinds, OverloadedRecordDot, RebindableSyntax #-}
+module LinearRecordSelector where
+
+import GHC.Exts (Multiplicity(..))
+import Prelude
+
+data Test = A { test :: Int, test2 %Many :: String } | B { test %Many :: Int, test3 %Many :: Char }
+
+test1 :: Test %1 -> Int
+test1 a = test a
+
+testM :: Test -> Int
+testM a = test a
+
+testX :: Test %m -> Int
+testX = test
+
+newtype NT = NT { unNT :: Int }
+
+nt :: NT %m -> Int
+nt a = unNT a
=====================================
testsuite/tests/linear/should_compile/all.T
=====================================
@@ -36,6 +36,7 @@ test('LinearTH3', normal, compile, [''])
test('LinearTH4', req_th, compile, [''])
test('LinearHole', normal, compile, [''])
test('LinearDataConSections', normal, compile, [''])
+test('LinearRecordSelector', normal, compile, ['-dcore-lint'])
test('T18731', normal, compile, [''])
test('T19400', unless(compiler_debugged(), skip), compile, [''])
test('T20023', normal, compile, [''])
=====================================
testsuite/tests/linear/should_fail/LinearRecordSelectorFail.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE LinearTypes, DataKinds, OverloadedRecordDot, RebindableSyntax #-}
+module LinearRecordSelector where
+
+import GHC.Exts (Multiplicity(..))
+import Prelude
+
+data Test1 = A1 { testA11 :: Int, testA12 :: String }
+
+-- Fails because testA12 is linear
+test1 :: Test1 %1 -> Int
+test1 a = testA11 a
+
+data Test2 = A2 { testA2 :: Int } | B2 { testB2 %Many :: Char }
+
+-- Fails because testA2 is partial
+test2 :: Test2 %1 -> Int
+test2 a = testA2 a
=====================================
testsuite/tests/linear/should_fail/LinearRecordSelectorFail.stderr
=====================================
@@ -0,0 +1,10 @@
+LinearRecordSelectorFail.hs:11:7: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘a’
+ • In an equation for ‘test1’: test1 a = testA11 a
+
+LinearRecordSelectorFail.hs:17:7: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘a’
+ • In an equation for ‘test2’: test2 a = testA2 a
+
=====================================
testsuite/tests/linear/should_fail/all.T
=====================================
@@ -11,6 +11,7 @@ test('LinearNoExt', normal, compile_fail, [''])
test('LinearNoExtU', normal, compile_fail, [''])
test('LinearAsPat', normal, compile_fail, [''])
test('LinearLazyPat', normal, compile_fail, [''])
+test('LinearRecordSelectorFail', normal, compile_fail, [''])
test('LinearRecordUpdate', normal, compile_fail, [''])
test('LinearSeq', normal, compile_fail, [''])
test('LinearViewPattern', normal, compile_fail, [''])
=====================================
testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
=====================================
@@ -1,4 +1,3 @@
-
DRFHoleFits.hs:7:7: error: [GHC-88464]
• Found hole: _ :: T -> Int
• In the expression: _ :: T -> Int
@@ -6,8 +5,8 @@ DRFHoleFits.hs:7:7: error: [GHC-88464]
• Relevant bindings include
bar :: T -> Int (bound at DRFHoleFits.hs:7:1)
Valid hole fits include
- foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
bar :: T -> Int (defined at DRFHoleFits.hs:7:1)
+ foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
DRFHoleFits.hs:8:7: error: [GHC-88464]
• Found hole: _ :: A.S -> Int
@@ -20,3 +19,4 @@ DRFHoleFits.hs:8:7: error: [GHC-88464]
A.foo :: A.S -> Int
(imported qualified from ‘DRFHoleFits_A’ at DRFHoleFits.hs:3:1-35
(and originally defined at DRFHoleFits_A.hs:5:16-18))
+
=====================================
testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout
=====================================
@@ -1,5 +1,8 @@
data Main.R = Main.MkR {Main.foo :: GHC.Internal.Types.Int}
-Main.foo :: Main.R -> GHC.Internal.Types.Int
-Main.foo :: Main.R -> GHC.Internal.Types.Int
-Main.foo :: Main.R -> GHC.Internal.Types.Int
+Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
+ Main.R %m_0 -> GHC.Internal.Types.Int
+Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
+ Main.R %m_0 -> GHC.Internal.Types.Int
+Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
+ Main.R %m_0 -> GHC.Internal.Types.Int
42
=====================================
testsuite/tests/perf/compiler/T16875.stderr
=====================================
@@ -6,7 +6,5 @@ T16875.hs:12:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• In an equation for ‘a’: a = _
• Relevant bindings include a :: p (bound at T16875.hs:12:1)
Valid hole fits include
- a :: forall {p}. p
- with a
- (defined at T16875.hs:12:1)
+ a :: forall {p}. p (defined at T16875.hs:12:1)
=====================================
testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
=====================================
@@ -1,22 +1,32 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 82, types: 52, coercions: 29, joins: 0/0}
+ = {terms: 83, types: 55, coercions: 31, joins: 0/0}
--- RHS size: {terms: 3, types: 3, coercions: 0, joins: 0/0}
-unsafeToInteger1 :: forall (n :: Nat). Signed n -> Signed n
+-- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0}
+unsafeToInteger1
+ :: forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
+ Signed n %m -> Signed n
[GblId, Arity=1, Unf=OtherCon []]
-unsafeToInteger1 = \ (@(n :: Nat)) (ds :: Signed n) -> ds
+unsafeToInteger1
+ = \ (@(n :: Nat))
+ (@(m :: GHC.Internal.Types.Multiplicity))
+ (ds :: Signed n) ->
+ ds
--- RHS size: {terms: 1, types: 0, coercions: 8, joins: 0/0}
-unsafeToInteger :: forall (n :: Nat). Signed n -> Integer
+-- RHS size: {terms: 1, types: 0, coercions: 10, joins: 0/0}
+unsafeToInteger
+ :: forall (n :: Nat) {m :: GHC.Internal.Types.Multiplicity}.
+ Signed n %m -> Integer
[GblId[[RecSel]], Arity=1, Unf=OtherCon []]
unsafeToInteger
= unsafeToInteger1
- `cast` (forall (n :: <Nat>_N).
- <Signed n>_R %<Many>_N ->_R OpaqueNoCastWW.N:Signed <n>_P
- :: (forall (n :: Nat). Signed n -> Signed n)
- ~R# (forall (n :: Nat). Signed n -> Integer))
+ `cast` (forall (n :: <Nat>_N) (m :: <GHC.Internal.Types.Multiplicity>_N).
+ <Signed n>_R %<m>_N ->_R OpaqueNoCastWW.N:Signed <n>_P
+ :: (forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
+ Signed n %m -> Signed n)
+ ~R# (forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
+ Signed n %m -> Integer))
-- RHS size: {terms: 8, types: 7, coercions: 21, joins: 0/0}
times [InlPrag=OPAQUE]
=====================================
testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
=====================================
@@ -1,3 +1,4 @@
-CommonFieldTypeMismatch.hs:3:1: [GHC-91827]
- Constructors A1 and A2 give different types for field ‘fld’
- In the data type declaration for ‘A’
+CommonFieldTypeMismatch.hs:3:1: error: [GHC-91827]
+ • Constructors A1 and A2 give different types for field ‘fld’
+ • In the data type declaration for ‘A’
+
=====================================
testsuite/tests/typecheck/should_fail/T12083a.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
module T12803a where
type Constrd a = Num a ⇒ a
=====================================
testsuite/tests/typecheck/should_fail/T12083a.stderr
=====================================
@@ -1,14 +1,14 @@
-
-T12083a.hs:6:1: error: [GHC-91510]
+T12083a.hs:7:1: error: [GHC-91510]
• Illegal qualified type: Num a => a
• In the type synonym declaration for ‘Constrd’
Suggested fix:
Perhaps you intended to use the ‘RankNTypes’ extension (implied by ‘ImpredicativeTypes’)
-T12083a.hs:10:26: error: [GHC-25709]
+T12083a.hs:11:26: error: [GHC-25709]
• Data constructor ‘ExistentiallyLost’ has existential type variables, a context, or a specialised result type
ExistentiallyLost :: forall u. TC u => u -> ExistentiallyLost
• In the definition of data constructor ‘ExistentiallyLost’
In the data type declaration for ‘ExistentiallyLost’
Suggested fix:
Enable any of the following extensions: ‘ExistentialQuantification’ or ‘GADTs’
+
=====================================
testsuite/tests/typecheck/should_fail/T9739.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
module T9739 where
class Class3 a => Class1 a where
=====================================
testsuite/tests/typecheck/should_fail/T9739.stderr
=====================================
@@ -1,5 +1,4 @@
-
-T9739.hs:4:1: error: [GHC-29210]
+T9739.hs:5:1: error: [GHC-29210]
• Superclass cycle for ‘Class1’
one of whose superclasses is ‘Class3’
one of whose superclasses is ‘Class1’
@@ -7,10 +6,11 @@ T9739.hs:4:1: error: [GHC-29210]
Suggested fix:
Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
-T9739.hs:9:1: error: [GHC-29210]
+T9739.hs:10:1: error: [GHC-29210]
• Superclass cycle for ‘Class3’
one of whose superclasses is ‘Class1’
one of whose superclasses is ‘Class3’
• In the class declaration for ‘Class3’
Suggested fix:
Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
+
=====================================
utils/haddock/html-test/ref/Bug294.html
=====================================
@@ -159,9 +159,13 @@
><p class="src"
><a id="v:problemField" class="def"
>problemField</a
- > :: TO <a href="#" title="Bug294"
+ > :: <span class="keyword"
+ >forall</span
+ > {m :: <a href="#" title="GHC.Exts"
+ >Multiplicity</a
+ >}. TO <a href="#" title="Bug294"
>A</a
- > -> <a href="#" title="Bug294"
+ > %m -> <a href="#" title="Bug294"
>A</a
> <a href="#" class="selflink"
>#</a
@@ -171,9 +175,13 @@
><p class="src"
><a id="v:problemField-39-" class="def"
>problemField'</a
- > :: DO <a href="#" title="Bug294"
+ > :: <span class="keyword"
+ >forall</span
+ > {m :: <a href="#" title="GHC.Exts"
+ >Multiplicity</a
+ >}. DO <a href="#" title="Bug294"
>A</a
- > -> <a href="#" title="Bug294"
+ > %m -> <a href="#" title="Bug294"
>A</a
> <a href="#" class="selflink"
>#</a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17c678ec195acbad05742013cd3355…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17c678ec195acbad05742013cd3355…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-8] Big refactor of breakpoints internal representation
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
by Rodrigo Mesquita (＠alt-romes) 30 Jun '25
30 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC
Commits:
b88ecc3c by Rodrigo Mesquita at 2025-06-30T14:34:50+01:00
Big refactor of breakpoints internal representation
Big better
At this point we now have to go and re-work the BrkArrays to consider internal breakpoints (generated in StgGen) and multi-threading. tomorrow.
Continue refactor
Lots of progress
littel better
compiler: make ModBreaks serializable
Mais...
BRK_FUN in rts
Fixes
Tweaks
Checkpoint but segfaults in GC
Start part 4....
simpler
allow allocating breakarrays outside of linking but in the linker env still
disassemble
tack todo
The BreakArray construction at link time was originally done by Cheng.
Co-authored-by: Cheng Shao <terrorjack(a)type.dance>
- - - - -
47 changed files:
- compiler/GHC.hs
- compiler/GHC/ByteCode/Asm.hs
- + compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Map/Expr.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Main.hs
- + compiler/GHC/Driver/Session/Inspect.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Eval/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/FVs.hs
- compiler/GHC/StgToByteCode.hs
- − compiler/GHC/Types/Breakpoint.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Interpreter.c
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b88ecc3c5a5d01e05d1cb9f18c636c0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b88ecc3c5a5d01e05d1cb9f18c636c0…
You're receiving this email because of your account on gitlab.haskell.org.
1
0