- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/ghci-no-simpl] 2 commits: compiler: use modified dflags/session with -O0 in hscCompileCoreExpr
by Cheng Shao (＠TerrorJack) 14 Sep '25

14 Sep '25

Cheng Shao pushed to branch wip/ghci-no-simpl at Glasgow Haskell Compiler / GHC Commits: 63bb86db by Cheng Shao at 2025-09-14T12:53:55+02:00 compiler: use modified dflags/session with -O0 in hscCompileCoreExpr This commit makes the compiler use modified dflags/session with -O0 in hscCompileCoreExpr to do less work in not just the Core simplification step, but also later steps like CorePrep. - - - - - 81f0e496 by Cheng Shao at 2025-09-14T12:54:14+02:00 compiler: remove unused simplifyExpr logic This commit removes the now unused simplifyExpr logic in the tree. - - - - - 4 changed files: - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Main.hs Changes: ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -6,7 +6,7 @@ {-# LANGUAGE CPP #-} -module GHC.Core.Opt.Pipeline ( core2core, simplifyExpr ) where +module GHC.Core.Opt.Pipeline ( core2core ) where import GHC.Prelude @@ -27,7 +27,7 @@ import GHC.Core.Ppr ( pprCoreBindings ) import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) -import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) +import GHC.Core.Opt.Simplify ( simplifyPgm ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} module GHC.Core.Opt.Simplify - ( SimplifyExprOpts(..), SimplifyOpts(..) - , simplifyExpr, simplifyPgm + ( SimplifyOpts(..) + , simplifyPgm ) where import GHC.Prelude @@ -11,20 +11,18 @@ import GHC.Driver.Flags import GHC.Core import GHC.Core.Rules -import GHC.Core.Ppr ( pprCoreBindings, pprCoreExpr ) -import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) -import GHC.Core.Stats ( coreBindsSize, coreBindsStats, exprSize ) +import GHC.Core.Ppr ( pprCoreBindings ) +import GHC.Core.Opt.OccurAnal ( occurAnalysePgm ) +import GHC.Core.Stats ( coreBindsSize, coreBindsStats ) import GHC.Core.Utils ( mkTicks, stripTicksTop ) import GHC.Core.Lint ( LintPassResultConfig, dumpPassResult, lintPassResult ) -import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules ) +import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplImpRules ) import GHC.Core.Opt.Simplify.Utils ( activeRule ) import GHC.Core.Opt.Simplify.Inline ( activeUnfolding ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Stats ( simplCountN ) -import GHC.Core.FamInstEnv -import GHC.Utils.Error ( withTiming ) import GHC.Utils.Logger as Logger import GHC.Utils.Outputable import GHC.Utils.Constants (debugIsOn) @@ -44,72 +42,6 @@ import GHC.Types.Unique.FM import Control.Monad import Data.Foldable ( for_ ) -{- -************************************************************************ -* * - Gentle simplification -* * -************************************************************************ --} - --- | Configuration record for `simplifyExpr`. --- The values of this datatype are /only/ driven by the demands of that function. -data SimplifyExprOpts = SimplifyExprOpts - { se_fam_inst :: ![FamInst] - , se_mode :: !SimplMode - , se_top_env_cfg :: !TopEnvConfig - } - -simplifyExpr :: Logger - -> ExternalUnitCache - -> SimplifyExprOpts - -> CoreExpr - -> IO CoreExpr --- ^ Simplify an expression using 'simplExprGently'. --- --- See 'simplExprGently' for details. -simplifyExpr logger euc opts expr - = withTiming logger (text "Simplify [expr]") (const ()) $ - do { eps <- eucEPS euc ; - ; let fam_envs = ( eps_fam_inst_env eps - , extendFamInstEnvList emptyFamInstEnv $ se_fam_inst opts - ) - simpl_env = mkSimplEnv (se_mode opts) fam_envs - top_env_cfg = se_top_env_cfg opts - read_eps_rules = eps_rule_base <$> eucEPS euc - read_ruleenv = updExternalPackageRules emptyRuleEnv <$> read_eps_rules - - ; let sz = exprSize expr - - ; (expr', counts) <- initSmpl logger read_ruleenv top_env_cfg sz $ - simplExprGently simpl_env expr - - ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats - "Simplifier statistics" FormatText (pprSimplCount counts) - - ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression" - FormatCore - (pprCoreExpr expr') - - ; return expr' - } - -simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr --- ^ Simplifies an expression by doing occurrence analysis, then simplification, --- and repeating (twice currently), because one pass alone leaves tons of crud. --- --- Used only: --- --- 1. for user expressions typed in at the interactive prompt (see 'GHC.Driver.Main.hscStmt'), --- 2. for Template Haskell splices (see 'GHC.Tc.Gen.Splice.runMeta'). --- --- The name 'Gently' suggests that the SimplMode is InitialPhase, --- and in fact that is so.... but the 'Gently' in 'simplExprGently' doesn't --- enforce that; it just simplifies the expression twice. -simplExprGently env expr = do - expr1 <- simplExpr env (occurAnalyseExpr expr) - simplExpr env (occurAnalyseExpr expr1) - {- ************************************************************************ * * ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -1,6 +1,5 @@ module GHC.Driver.Config.Core.Opt.Simplify - ( initSimplifyExprOpts - , initSimplifyOpts + ( initSimplifyOpts , initSimplMode , initGentleSimplMode ) where @@ -9,7 +8,7 @@ import GHC.Prelude import GHC.Core.Rules ( RuleBase ) import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) -import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) ) +import GHC.Core.Opt.Simplify ( SimplifyOpts(..) ) import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..), SimplPhase(..) ) import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) ) @@ -19,26 +18,9 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts ) import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt ) -import GHC.Runtime.Context ( InteractiveContext(..) ) - import GHC.Types.Basic ( CompilerPhase(..) ) import GHC.Types.Var ( Var ) -initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts -initSimplifyExprOpts dflags ic = SimplifyExprOpts - { se_fam_inst = snd $ ic_instances ic - , se_mode = (initSimplMode dflags InitialPhase "GHCi") - { sm_inline = False - -- Do not do any inlining, in case we expose some - -- unboxed tuple stuff that confuses the bytecode - -- interpreter - } - , se_top_env_cfg = TopEnvConfig - { te_history_size = historySize dflags - , te_tick_factor = simplTickFactor dflags - } - } - initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let -- This is a particularly ugly construction, but we will get rid of it in !8341. ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2709,28 +2709,35 @@ hscCompileCoreExpr hsc_env loc expr = Just h -> h hsc_env loc expr hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded) -hscCompileCoreExpr' hsc_env srcspan ds_expr = do - {- Simplify it -} - let dflags = hsc_dflags hsc_env +hscCompileCoreExpr' hsc_env' srcspan ds_expr = do + -- Use modified `dflags` and session that sets -O0 and do less work + -- throughout the Core -> ByteCode pipeline under + -- `-funoptimized-core-for-interpreter`, even if current session + -- enables `-O1` or above. + let dflags' = hsc_dflags hsc_env' + unopt = gopt Opt_UnoptimizedCoreForInterpreter dflags' + dflags + | unopt = updOptLevel 0 dflags' + | otherwise = dflags' + hsc_env + | unopt = hsc_env' {hsc_dflags = dflags} + | otherwise = hsc_env' let logger = hsc_logger hsc_env + {- Simplify it -} let simpl_expr - -- Do less work under `-funoptimized-core-for-interpreter`, - -- use modified `dflags` that sets `-O0` here even if current - -- session enables `-O1` or above. - -- -- When generating bytecode for ghci via `hscParsedStmt`, we -- still need to enable inlining! For `let foo = Foo ...`, the -- ghci debugger expects `:print foo` to show `foo = <Foo> ...` -- without forcing `foo` first, without inlining `foo` -- would remain a top-level thunk instead of a datacon -- closure. We can skip inlining for TH splices though. - | gopt Opt_UnoptimizedCoreForInterpreter dflags = + | unopt = ( if srcspan == interactiveSrcSpan then simpleOptExpr else simpleOptExprNoInline ) - (initSimpleOpts $ updOptLevel 0 dflags) + (initSimpleOpts dflags) ds_expr | otherwise = simpleOptExpr (initSimpleOpts dflags) ds_expr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c307ec77223a2336196961e375ee75… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c307ec77223a2336196961e375ee75… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ghci-no-simpl] 2 commits: compiler: use modified dflags/session with -O0 in hscCompileCoreExpr
by Cheng Shao (＠TerrorJack) 14 Sep '25

14 Sep '25

Cheng Shao pushed to branch wip/ghci-no-simpl at Glasgow Haskell Compiler / GHC Commits: 5d35dc97 by Cheng Shao at 2025-09-14T12:35:55+02:00 compiler: use modified dflags/session with -O0 in hscCompileCoreExpr This commit makes the compiler use modified dflags/session with -O0 in hscCompileCoreExpr to do less work in not just the Core simplification step, but also later steps, especially the STG -> STG pipeline. - - - - - c307ec77 by Cheng Shao at 2025-09-14T12:35:55+02:00 compiler: remove unused simplifyExpr logic This commit removes the now unused simplifyExpr logic in the tree. - - - - - 4 changed files: - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Main.hs Changes: ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -6,7 +6,7 @@ {-# LANGUAGE CPP #-} -module GHC.Core.Opt.Pipeline ( core2core, simplifyExpr ) where +module GHC.Core.Opt.Pipeline ( core2core ) where import GHC.Prelude @@ -27,7 +27,7 @@ import GHC.Core.Ppr ( pprCoreBindings ) import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) -import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) +import GHC.Core.Opt.Simplify ( simplifyPgm ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} module GHC.Core.Opt.Simplify - ( SimplifyExprOpts(..), SimplifyOpts(..) - , simplifyExpr, simplifyPgm + ( SimplifyOpts(..) + , simplifyPgm ) where import GHC.Prelude @@ -11,20 +11,18 @@ import GHC.Driver.Flags import GHC.Core import GHC.Core.Rules -import GHC.Core.Ppr ( pprCoreBindings, pprCoreExpr ) -import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) -import GHC.Core.Stats ( coreBindsSize, coreBindsStats, exprSize ) +import GHC.Core.Ppr ( pprCoreBindings ) +import GHC.Core.Opt.OccurAnal ( occurAnalysePgm ) +import GHC.Core.Stats ( coreBindsSize, coreBindsStats ) import GHC.Core.Utils ( mkTicks, stripTicksTop ) import GHC.Core.Lint ( LintPassResultConfig, dumpPassResult, lintPassResult ) -import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules ) +import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplImpRules ) import GHC.Core.Opt.Simplify.Utils ( activeRule ) import GHC.Core.Opt.Simplify.Inline ( activeUnfolding ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Stats ( simplCountN ) -import GHC.Core.FamInstEnv -import GHC.Utils.Error ( withTiming ) import GHC.Utils.Logger as Logger import GHC.Utils.Outputable import GHC.Utils.Constants (debugIsOn) @@ -44,72 +42,6 @@ import GHC.Types.Unique.FM import Control.Monad import Data.Foldable ( for_ ) -{- -************************************************************************ -* * - Gentle simplification -* * -************************************************************************ --} - --- | Configuration record for `simplifyExpr`. --- The values of this datatype are /only/ driven by the demands of that function. -data SimplifyExprOpts = SimplifyExprOpts - { se_fam_inst :: ![FamInst] - , se_mode :: !SimplMode - , se_top_env_cfg :: !TopEnvConfig - } - -simplifyExpr :: Logger - -> ExternalUnitCache - -> SimplifyExprOpts - -> CoreExpr - -> IO CoreExpr --- ^ Simplify an expression using 'simplExprGently'. --- --- See 'simplExprGently' for details. -simplifyExpr logger euc opts expr - = withTiming logger (text "Simplify [expr]") (const ()) $ - do { eps <- eucEPS euc ; - ; let fam_envs = ( eps_fam_inst_env eps - , extendFamInstEnvList emptyFamInstEnv $ se_fam_inst opts - ) - simpl_env = mkSimplEnv (se_mode opts) fam_envs - top_env_cfg = se_top_env_cfg opts - read_eps_rules = eps_rule_base <$> eucEPS euc - read_ruleenv = updExternalPackageRules emptyRuleEnv <$> read_eps_rules - - ; let sz = exprSize expr - - ; (expr', counts) <- initSmpl logger read_ruleenv top_env_cfg sz $ - simplExprGently simpl_env expr - - ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats - "Simplifier statistics" FormatText (pprSimplCount counts) - - ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression" - FormatCore - (pprCoreExpr expr') - - ; return expr' - } - -simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr --- ^ Simplifies an expression by doing occurrence analysis, then simplification, --- and repeating (twice currently), because one pass alone leaves tons of crud. --- --- Used only: --- --- 1. for user expressions typed in at the interactive prompt (see 'GHC.Driver.Main.hscStmt'), --- 2. for Template Haskell splices (see 'GHC.Tc.Gen.Splice.runMeta'). --- --- The name 'Gently' suggests that the SimplMode is InitialPhase, --- and in fact that is so.... but the 'Gently' in 'simplExprGently' doesn't --- enforce that; it just simplifies the expression twice. -simplExprGently env expr = do - expr1 <- simplExpr env (occurAnalyseExpr expr) - simplExpr env (occurAnalyseExpr expr1) - {- ************************************************************************ * * ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -1,6 +1,5 @@ module GHC.Driver.Config.Core.Opt.Simplify - ( initSimplifyExprOpts - , initSimplifyOpts + ( initSimplifyOpts , initSimplMode , initGentleSimplMode ) where @@ -9,7 +8,7 @@ import GHC.Prelude import GHC.Core.Rules ( RuleBase ) import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) -import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) ) +import GHC.Core.Opt.Simplify ( SimplifyOpts(..) ) import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..), SimplPhase(..) ) import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) ) @@ -19,26 +18,9 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts ) import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt ) -import GHC.Runtime.Context ( InteractiveContext(..) ) - import GHC.Types.Basic ( CompilerPhase(..) ) import GHC.Types.Var ( Var ) -initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts -initSimplifyExprOpts dflags ic = SimplifyExprOpts - { se_fam_inst = snd $ ic_instances ic - , se_mode = (initSimplMode dflags InitialPhase "GHCi") - { sm_inline = False - -- Do not do any inlining, in case we expose some - -- unboxed tuple stuff that confuses the bytecode - -- interpreter - } - , se_top_env_cfg = TopEnvConfig - { te_history_size = historySize dflags - , te_tick_factor = simplTickFactor dflags - } - } - initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let -- This is a particularly ugly construction, but we will get rid of it in !8341. ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2709,28 +2709,35 @@ hscCompileCoreExpr hsc_env loc expr = Just h -> h hsc_env loc expr hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded) -hscCompileCoreExpr' hsc_env srcspan ds_expr = do - {- Simplify it -} - let dflags = hsc_dflags hsc_env +hscCompileCoreExpr' hsc_env' srcspan ds_expr = do + -- Use modified `dflags` and session that sets -O0 and do less work + -- throughout the Core -> ByteCode pipeline under + -- `-funoptimized-core-for-interpreter`, even if current session + -- enables `-O1` or above. + let dflags' = hsc_dflags hsc_env' + unopt = gopt Opt_UnoptimizedCoreForInterpreter dflags' + dflags + | unopt = updOptLevel 0 dflags' + | otherwise = dflags' + hsc_env + | unopt = hsc_env' {hsc_dflags = dflags} + | otherwise = hsc_env' let logger = hsc_logger hsc_env + {- Simplify it -} let simpl_expr - -- Do less work under `-funoptimized-core-for-interpreter`, - -- use modified `dflags` that sets `-O0` here even if current - -- session enables `-O1` or above. - -- -- When generating bytecode for ghci via `hscParsedStmt`, we -- still need to enable inlining! For `let foo = Foo ...`, the -- ghci debugger expects `:print foo` to show `foo = <Foo> ...` -- without forcing `foo` first, without inlining `foo` -- would remain a top-level thunk instead of a datacon -- closure. We can skip inlining for TH splices though. - | gopt Opt_UnoptimizedCoreForInterpreter dflags = + | unopt = ( if srcspan == interactiveSrcSpan then simpleOptExpr else simpleOptExprNoInline ) - (initSimpleOpts $ updOptLevel 0 dflags) + (initSimpleOpts dflags) ds_expr | otherwise = simpleOptExpr (initSimpleOpts dflags) ds_expr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbc6f309570160457258b7de3a286a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbc6f309570160457258b7de3a286a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ghci-no-simpl] 3 commits: compiler: use proper interactiveSrcSpan instead of srcLocSpan interactiveSrcLoc
by Cheng Shao (＠TerrorJack) 14 Sep '25

14 Sep '25

Cheng Shao pushed to branch wip/ghci-no-simpl at Glasgow Haskell Compiler / GHC Commits: 54d00f30 by Cheng Shao at 2025-09-14T11:40:38+02:00 compiler: use proper interactiveSrcSpan instead of srcLocSpan interactiveSrcLoc This commit makes the compiler use proper `interactiveSrcSpan` instead of `srcLocSpan interactiveSrcLoc`, which returns a result surprisingly not equal to `interactiveSrcSpan`! Also removes the now unused `generatedSrcLoc` and `interactiveSrcLoc`. - - - - - 9b0d9d92 by Cheng Shao at 2025-09-14T11:40:38+02:00 compiler: use simpleOptExpr instead of simplifyExpr in hscCompileCoreExpr This commit makes hscCompileCoreExpr use simpleOptExpr instead of simplifyExpr, so to make it faster by doing less work when compiling TH splices or ghci statements to bytecode. ------------------------- Metric Decrease: MultiLayerModulesTH_OneShot ------------------------- - - - - - fbc6f309 by Cheng Shao at 2025-09-14T11:41:01+02:00 compiler: remove unused simplifyExpr logic - - - - - 6 changed files: - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session/Inspect.hs - compiler/GHC/Types/SrcLoc.hs Changes: ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -6,7 +6,7 @@ {-# LANGUAGE CPP #-} -module GHC.Core.Opt.Pipeline ( core2core, simplifyExpr ) where +module GHC.Core.Opt.Pipeline ( core2core ) where import GHC.Prelude @@ -27,7 +27,7 @@ import GHC.Core.Ppr ( pprCoreBindings ) import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) -import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) +import GHC.Core.Opt.Simplify ( simplifyPgm ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} module GHC.Core.Opt.Simplify - ( SimplifyExprOpts(..), SimplifyOpts(..) - , simplifyExpr, simplifyPgm + ( SimplifyOpts(..) + , simplifyPgm ) where import GHC.Prelude @@ -11,20 +11,18 @@ import GHC.Driver.Flags import GHC.Core import GHC.Core.Rules -import GHC.Core.Ppr ( pprCoreBindings, pprCoreExpr ) -import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) -import GHC.Core.Stats ( coreBindsSize, coreBindsStats, exprSize ) +import GHC.Core.Ppr ( pprCoreBindings ) +import GHC.Core.Opt.OccurAnal ( occurAnalysePgm ) +import GHC.Core.Stats ( coreBindsSize, coreBindsStats ) import GHC.Core.Utils ( mkTicks, stripTicksTop ) import GHC.Core.Lint ( LintPassResultConfig, dumpPassResult, lintPassResult ) -import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules ) +import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplImpRules ) import GHC.Core.Opt.Simplify.Utils ( activeRule ) import GHC.Core.Opt.Simplify.Inline ( activeUnfolding ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Stats ( simplCountN ) -import GHC.Core.FamInstEnv -import GHC.Utils.Error ( withTiming ) import GHC.Utils.Logger as Logger import GHC.Utils.Outputable import GHC.Utils.Constants (debugIsOn) @@ -44,72 +42,6 @@ import GHC.Types.Unique.FM import Control.Monad import Data.Foldable ( for_ ) -{- -************************************************************************ -* * - Gentle simplification -* * -************************************************************************ --} - --- | Configuration record for `simplifyExpr`. --- The values of this datatype are /only/ driven by the demands of that function. -data SimplifyExprOpts = SimplifyExprOpts - { se_fam_inst :: ![FamInst] - , se_mode :: !SimplMode - , se_top_env_cfg :: !TopEnvConfig - } - -simplifyExpr :: Logger - -> ExternalUnitCache - -> SimplifyExprOpts - -> CoreExpr - -> IO CoreExpr --- ^ Simplify an expression using 'simplExprGently'. --- --- See 'simplExprGently' for details. -simplifyExpr logger euc opts expr - = withTiming logger (text "Simplify [expr]") (const ()) $ - do { eps <- eucEPS euc ; - ; let fam_envs = ( eps_fam_inst_env eps - , extendFamInstEnvList emptyFamInstEnv $ se_fam_inst opts - ) - simpl_env = mkSimplEnv (se_mode opts) fam_envs - top_env_cfg = se_top_env_cfg opts - read_eps_rules = eps_rule_base <$> eucEPS euc - read_ruleenv = updExternalPackageRules emptyRuleEnv <$> read_eps_rules - - ; let sz = exprSize expr - - ; (expr', counts) <- initSmpl logger read_ruleenv top_env_cfg sz $ - simplExprGently simpl_env expr - - ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats - "Simplifier statistics" FormatText (pprSimplCount counts) - - ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression" - FormatCore - (pprCoreExpr expr') - - ; return expr' - } - -simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr --- ^ Simplifies an expression by doing occurrence analysis, then simplification, --- and repeating (twice currently), because one pass alone leaves tons of crud. --- --- Used only: --- --- 1. for user expressions typed in at the interactive prompt (see 'GHC.Driver.Main.hscStmt'), --- 2. for Template Haskell splices (see 'GHC.Tc.Gen.Splice.runMeta'). --- --- The name 'Gently' suggests that the SimplMode is InitialPhase, --- and in fact that is so.... but the 'Gently' in 'simplExprGently' doesn't --- enforce that; it just simplifies the expression twice. -simplExprGently env expr = do - expr1 <- simplExpr env (occurAnalyseExpr expr) - simplExpr env (occurAnalyseExpr expr1) - {- ************************************************************************ * * ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -1,6 +1,5 @@ module GHC.Driver.Config.Core.Opt.Simplify - ( initSimplifyExprOpts - , initSimplifyOpts + ( initSimplifyOpts , initSimplMode , initGentleSimplMode ) where @@ -9,7 +8,7 @@ import GHC.Prelude import GHC.Core.Rules ( RuleBase ) import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) -import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) ) +import GHC.Core.Opt.Simplify ( SimplifyOpts(..) ) import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..), SimplPhase(..) ) import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) ) @@ -19,26 +18,9 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts ) import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt ) -import GHC.Runtime.Context ( InteractiveContext(..) ) - import GHC.Types.Basic ( CompilerPhase(..) ) import GHC.Types.Var ( Var ) -initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts -initSimplifyExprOpts dflags ic = SimplifyExprOpts - { se_fam_inst = snd $ ic_instances ic - , se_mode = (initSimplMode dflags InitialPhase "GHCi") - { sm_inline = False - -- Do not do any inlining, in case we expose some - -- unboxed tuple stuff that confuses the bytecode - -- interpreter - } - , se_top_env_cfg = TopEnvConfig - { te_history_size = historySize dflags - , te_tick_factor = simplTickFactor dflags - } - } - initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let -- This is a particularly ugly construction, but we will get rid of it in !8341. ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -121,8 +121,8 @@ import GHC.Driver.Errors import GHC.Driver.Messager import GHC.Driver.Errors.Types import GHC.Driver.CodeOutput +import GHC.Driver.Config import GHC.Driver.Config.Cmm.Parser (initCmmParserConfig) -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts ) import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO ) import GHC.Driver.Config.Core.Lint.Interactive ( lintInteractiveExpr ) import GHC.Driver.Config.CoreToStg @@ -181,6 +181,7 @@ import GHC.Core.Utils ( exprType ) import GHC.Core.ConLike import GHC.Core.Opt.Pipeline import GHC.Core.Opt.Pipeline.Types ( CoreToDo (..)) +import GHC.Core.SimpleOpt import GHC.Core.TyCon import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -2448,8 +2449,7 @@ hscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do -- It's important NOT to have package 'interactive' as thisUnitId -- for linking, else we try to link 'main' and can't find it. -- Whereas the linker already knows to ignore 'interactive' - let src_span = srcLocSpan interactiveSrcLoc - (hval,_,_) <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr + (hval,_,_) <- liftIO $ hscCompileCoreExpr hsc_env interactiveSrcSpan ds_expr return $ Just (ids, hval, fix_env) @@ -2512,8 +2512,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do (mkCgInteractiveGuts tidy_cg) iNTERACTIVELoc - let src_span = srcLocSpan interactiveSrcLoc - _ <- liftIO $ loadDecls interp hsc_env src_span linkable + _ <- liftIO $ loadDecls interp hsc_env interactiveSrcSpan linkable {- Load static pointer table entries -} liftIO $ hscAddSptEntries hsc_env (cg_spt_entries tidy_cg) @@ -2712,15 +2711,29 @@ hscCompileCoreExpr hsc_env loc expr = hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded) hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Simplify it -} - -- Question: should we call SimpleOpt.simpleOptExpr here instead? - -- It is, well, simpler, and does less inlining etc. let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let ic = hsc_IC hsc_env - let unit_env = hsc_unit_env hsc_env - let simplify_expr_opts = initSimplifyExprOpts dflags ic - simpl_expr <- simplifyExpr logger (ue_eps unit_env) simplify_expr_opts ds_expr + let simpl_expr + -- Do less work under `-funoptimized-core-for-interpreter`, + -- use modified `dflags` that sets `-O0` here even if current + -- session enables `-O1` or above. + -- + -- When generating bytecode for ghci via `hscParsedStmt`, we + -- still need to enable inlining! For `let foo = Foo ...`, the + -- ghci debugger expects `:print foo` to show `foo = <Foo> ...` + -- without forcing `foo` first, without inlining `foo` + -- would remain a top-level thunk instead of a datacon + -- closure. We can skip inlining for TH splices though. + | gopt Opt_UnoptimizedCoreForInterpreter dflags = + ( if srcspan == interactiveSrcSpan + then simpleOptExpr + else simpleOptExprNoInline + ) + (initSimpleOpts $ updOptLevel 0 dflags) + ds_expr + | otherwise = + simpleOptExpr (initSimpleOpts dflags) ds_expr -- Create a unique temporary binding -- ===================================== compiler/GHC/Driver/Session/Inspect.hs ===================================== @@ -133,7 +133,7 @@ availsToGlobalRdrEnv hsc_env mod avails 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_dloc = interactiveSrcSpan, is_level = NormalLevel } getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) @@ -198,4 +198,3 @@ modInfoSafe = minf_safe modInfoModBreaks :: ModuleInfo -> Maybe InternalModBreaks modInfoModBreaks = minf_modBreaks - ===================================== compiler/GHC/Types/SrcLoc.hs ===================================== @@ -19,8 +19,6 @@ module GHC.Types.SrcLoc ( leftmostColumn, noSrcLoc, -- "I'm sorry, I haven't a clue" - generatedSrcLoc, -- Code generated within the compiler - interactiveSrcLoc, -- Code from an interactive session advanceSrcLoc, advanceBufPos, @@ -255,10 +253,8 @@ getBufPos (RealSrcLoc _ mbpos) = mbpos getBufPos (UnhelpfulLoc _) = Strict.Nothing -- | Built-in "bad" 'SrcLoc' values for particular locations -noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc +noSrcLoc :: SrcLoc noSrcLoc = UnhelpfulLoc (fsLit "<no location info>") -generatedSrcLoc = UnhelpfulLoc (fsLit "<compiler-generated code>") -interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive>") -- | Creates a "bad" 'SrcLoc' that has no detailed information about its location mkGeneralSrcLoc :: FastString -> SrcLoc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54ee4bca623e0b0f34148559ed7514… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54ee4bca623e0b0f34148559ed7514… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED] Cleanup unused imports
by Sven Tennie (＠supersven) 14 Sep '25

14 Sep '25

Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC Commits: a3f5b3ab by Sven Tennie at 2025-09-14T09:24:59+00:00 Cleanup unused imports - - - - - 1 changed file: - hadrian/src/Rules/Generate.hs Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -5,11 +5,10 @@ module Rules.Generate ( ) where import Development.Shake.FilePath -import Data.Char (isSpace) import Base import qualified Context import Expression -import Hadrian.Oracles.TextFile (getTargetTarget, lookupStageBuildConfig) +import Hadrian.Oracles.TextFile (lookupStageBuildConfig) import Oracles.Flag hiding (arSupportsAtFile, arSupportsDashL) import Oracles.ModuleFiles import Oracles.Setting View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3f5b3abae3317e4fdf57fc9a4c68a6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3f5b3abae3317e4fdf57fc9a4c68a6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED] Cleanup: Delete unused binding
by Sven Tennie (＠supersven) 14 Sep '25

14 Sep '25

Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC Commits: 220d380b by Sven Tennie at 2025-09-14T08:52:03+00:00 Cleanup: Delete unused binding - - - - - 1 changed file: - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -32,7 +32,6 @@ toolArgs = do compileAndLinkHs :: Args compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do ways <- getLibraryWays - stage <- getStage useColor <- shakeColor <$> expr getShakeOptions let hasVanilla = elem vanilla ways hasDynamic = elem dynamic ways View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/220d380b7b1085725753e9c944e954b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/220d380b7b1085725753e9c944e954b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED
by Sven Tennie (＠supersven) 14 Sep '25

14 Sep '25

Sven Tennie pushed new branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/hadrian-cross-stage2-re… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ghci-no-simpl] 7 commits: Use mkVirtHeapOffsets for reconstructing terms in RTTI
by Cheng Shao (＠TerrorJack) 14 Sep '25

14 Sep '25

Cheng Shao pushed to branch wip/ghci-no-simpl at Glasgow Haskell Compiler / GHC Commits: 8f3d80ff by Luite Stegeman at 2025-09-13T08:43:09+02:00 Use mkVirtHeapOffsets for reconstructing terms in RTTI This makes mkVirtHeapOffsets the single source of truth for finding field offsets in closures. - - - - - eb389338 by Luite Stegeman at 2025-09-13T08:43:09+02:00 Sort non-pointer fields by size for more efficient packing This sorts non-pointer fields in mkVirtHeapOffsets, always storing the largest field first. The relative order of equally sized fields remains unchanged. This reduces wasted padding/alignment space in closures with differently sized fields. - - - - - 99b233f4 by Alison at 2025-09-13T16:51:04-04:00 ghc-heap: Fix race condition with profiling builds Apply the same fix from Closures.hs (64fd0fac83) to Heap.hs by adding empty imports to make way-dependent dependencies visible to `ghc -M`. Fixes #15197, #26407 - - - - - c892dd78 by Cheng Shao at 2025-09-14T09:19:25+02:00 genprimopcode: add hls support This commit adds hie.yaml to genprimopcode so that one can use hls to hack on it. - - - - - a9cd271d by Cheng Shao at 2025-09-14T09:19:25+02:00 genprimopcode: ensure seq is also included in PrimopWrappers.hs This patch changes genprimopcode and ensure seq is also included in PrimopWrappers.hs. This is needed when bytecode calls the seq primop. Co-authored-by: Codex <codex(a)openai.com> - - - - - 9502796c by Cheng Shao at 2025-09-14T09:19:25+02:00 compiler: use simpleOptExpr instead of simplifyExpr in hscCompileCoreExpr This commit makes hscCompileCoreExpr use simpleOptExpr instead of simplifyExpr, so to make it faster by doing less work when compiling TH splices to bytecode. ------------------------- Metric Decrease: MultiLayerModulesTH_OneShot ------------------------- - - - - - 54ee4bca by Cheng Shao at 2025-09-14T09:19:25+02:00 compiler: remove unused simplifyExpr logic - - - - - 14 changed files: - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/StgToCmm/Layout.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - testsuite/tests/codeGen/should_run/T13825-unit.hs - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout - testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout-ws-32 - utils/genprimopcode/Main.hs - + utils/genprimopcode/hie.yaml Changes: ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -6,7 +6,7 @@ {-# LANGUAGE CPP #-} -module GHC.Core.Opt.Pipeline ( core2core, simplifyExpr ) where +module GHC.Core.Opt.Pipeline ( core2core ) where import GHC.Prelude @@ -27,7 +27,7 @@ import GHC.Core.Ppr ( pprCoreBindings ) import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) -import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) +import GHC.Core.Opt.Simplify ( simplifyPgm ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} module GHC.Core.Opt.Simplify - ( SimplifyExprOpts(..), SimplifyOpts(..) - , simplifyExpr, simplifyPgm + ( SimplifyOpts(..) + , simplifyPgm ) where import GHC.Prelude @@ -11,20 +11,18 @@ import GHC.Driver.Flags import GHC.Core import GHC.Core.Rules -import GHC.Core.Ppr ( pprCoreBindings, pprCoreExpr ) -import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) -import GHC.Core.Stats ( coreBindsSize, coreBindsStats, exprSize ) +import GHC.Core.Ppr ( pprCoreBindings ) +import GHC.Core.Opt.OccurAnal ( occurAnalysePgm ) +import GHC.Core.Stats ( coreBindsSize, coreBindsStats ) import GHC.Core.Utils ( mkTicks, stripTicksTop ) import GHC.Core.Lint ( LintPassResultConfig, dumpPassResult, lintPassResult ) -import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules ) +import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplImpRules ) import GHC.Core.Opt.Simplify.Utils ( activeRule ) import GHC.Core.Opt.Simplify.Inline ( activeUnfolding ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Stats ( simplCountN ) -import GHC.Core.FamInstEnv -import GHC.Utils.Error ( withTiming ) import GHC.Utils.Logger as Logger import GHC.Utils.Outputable import GHC.Utils.Constants (debugIsOn) @@ -44,72 +42,6 @@ import GHC.Types.Unique.FM import Control.Monad import Data.Foldable ( for_ ) -{- -************************************************************************ -* * - Gentle simplification -* * -************************************************************************ --} - --- | Configuration record for `simplifyExpr`. --- The values of this datatype are /only/ driven by the demands of that function. -data SimplifyExprOpts = SimplifyExprOpts - { se_fam_inst :: ![FamInst] - , se_mode :: !SimplMode - , se_top_env_cfg :: !TopEnvConfig - } - -simplifyExpr :: Logger - -> ExternalUnitCache - -> SimplifyExprOpts - -> CoreExpr - -> IO CoreExpr --- ^ Simplify an expression using 'simplExprGently'. --- --- See 'simplExprGently' for details. -simplifyExpr logger euc opts expr - = withTiming logger (text "Simplify [expr]") (const ()) $ - do { eps <- eucEPS euc ; - ; let fam_envs = ( eps_fam_inst_env eps - , extendFamInstEnvList emptyFamInstEnv $ se_fam_inst opts - ) - simpl_env = mkSimplEnv (se_mode opts) fam_envs - top_env_cfg = se_top_env_cfg opts - read_eps_rules = eps_rule_base <$> eucEPS euc - read_ruleenv = updExternalPackageRules emptyRuleEnv <$> read_eps_rules - - ; let sz = exprSize expr - - ; (expr', counts) <- initSmpl logger read_ruleenv top_env_cfg sz $ - simplExprGently simpl_env expr - - ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats - "Simplifier statistics" FormatText (pprSimplCount counts) - - ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression" - FormatCore - (pprCoreExpr expr') - - ; return expr' - } - -simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr --- ^ Simplifies an expression by doing occurrence analysis, then simplification, --- and repeating (twice currently), because one pass alone leaves tons of crud. --- --- Used only: --- --- 1. for user expressions typed in at the interactive prompt (see 'GHC.Driver.Main.hscStmt'), --- 2. for Template Haskell splices (see 'GHC.Tc.Gen.Splice.runMeta'). --- --- The name 'Gently' suggests that the SimplMode is InitialPhase, --- and in fact that is so.... but the 'Gently' in 'simplExprGently' doesn't --- enforce that; it just simplifies the expression twice. -simplExprGently env expr = do - expr1 <- simplExpr env (occurAnalyseExpr expr) - simplExpr env (occurAnalyseExpr expr1) - {- ************************************************************************ * * ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -1,6 +1,5 @@ module GHC.Driver.Config.Core.Opt.Simplify - ( initSimplifyExprOpts - , initSimplifyOpts + ( initSimplifyOpts , initSimplMode , initGentleSimplMode ) where @@ -9,7 +8,7 @@ import GHC.Prelude import GHC.Core.Rules ( RuleBase ) import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) -import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) ) +import GHC.Core.Opt.Simplify ( SimplifyOpts(..) ) import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..), SimplPhase(..) ) import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) ) @@ -19,26 +18,9 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts ) import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt ) -import GHC.Runtime.Context ( InteractiveContext(..) ) - import GHC.Types.Basic ( CompilerPhase(..) ) import GHC.Types.Var ( Var ) -initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts -initSimplifyExprOpts dflags ic = SimplifyExprOpts - { se_fam_inst = snd $ ic_instances ic - , se_mode = (initSimplMode dflags InitialPhase "GHCi") - { sm_inline = False - -- Do not do any inlining, in case we expose some - -- unboxed tuple stuff that confuses the bytecode - -- interpreter - } - , se_top_env_cfg = TopEnvConfig - { te_history_size = historySize dflags - , te_tick_factor = simplTickFactor dflags - } - } - initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let -- This is a particularly ugly construction, but we will get rid of it in !8341. ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -121,8 +121,8 @@ import GHC.Driver.Errors import GHC.Driver.Messager import GHC.Driver.Errors.Types import GHC.Driver.CodeOutput +import GHC.Driver.Config import GHC.Driver.Config.Cmm.Parser (initCmmParserConfig) -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts ) import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO ) import GHC.Driver.Config.Core.Lint.Interactive ( lintInteractiveExpr ) import GHC.Driver.Config.CoreToStg @@ -181,6 +181,7 @@ import GHC.Core.Utils ( exprType ) import GHC.Core.ConLike import GHC.Core.Opt.Pipeline import GHC.Core.Opt.Pipeline.Types ( CoreToDo (..)) +import GHC.Core.SimpleOpt import GHC.Core.TyCon import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -2712,15 +2713,17 @@ hscCompileCoreExpr hsc_env loc expr = hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded) hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Simplify it -} - -- Question: should we call SimpleOpt.simpleOptExpr here instead? - -- It is, well, simpler, and does less inlining etc. let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let ic = hsc_IC hsc_env - let unit_env = hsc_unit_env hsc_env - let simplify_expr_opts = initSimplifyExprOpts dflags ic - simpl_expr <- simplifyExpr logger (ue_eps unit_env) simplify_expr_opts ds_expr + let simpl_expr = + simpleOptExpr + ( initSimpleOpts $ + if gopt Opt_UnoptimizedCoreForInterpreter dflags + then updOptLevel 0 dflags + else dflags + ) + ds_expr -- Create a unique temporary binding -- ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -74,12 +74,12 @@ import GHC.Utils.Outputable as Ppr import GHC.Utils.Panic import GHC.Char import GHC.Exts.Heap -import GHC.Runtime.Heap.Layout ( roundUpTo ) +import GHC.Runtime.Heap.Layout (ByteOff) import GHC.IO (throwIO) import Control.Monad import Data.Maybe -import Data.List ((\\)) +import Data.List ((\\), mapAccumL) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import GHC.Exts @@ -89,6 +89,10 @@ import Foreign hiding (shiftL, shiftR) import System.IO.Unsafe import GHC.InfoProv +import GHC.StgToCmm.Closure ( NonVoid(NonVoid)) +import GHC.StgToCmm.Layout (mkVirtHeapOffsets, ClosureHeader(..)) +import Data.Array (Array, (!), array) + --------------------------------------------- -- * A representation of semi evaluated Terms --------------------------------------------- @@ -922,63 +926,80 @@ extractSubTerms :: (Type -> ForeignHValue -> TcM Term) -> [Word] -- ^ data arguments -> [Type] -> TcM [Term] -extractSubTerms recurse ptr_args data_args = liftM thdOf3 . go 0 0 +extractSubTerms recurse ptr_args data_args tys = do + dflags <- getDynFlags + let profile = targetProfile dflags + (n_primreps, r) = mapAccumL collectReps 0 tys + (rep_tys, make_term) = unzip r + (_tot_words, ptr_words, nv_rep_offsets) = + mkVirtHeapOffsets profile NoHeader (map NonVoid $ concat rep_tys) + rep_offsets = map (\(NonVoid x, off) -> (x, off)) nv_rep_offsets + -- index maps the Int index of each PrimRep to its ByteOff + index :: Array Int ByteOff + index = array (0, n_primreps-1) rep_offsets + mapM (\m -> m index ptr_words) make_term where - go ptr_i arr_i [] = return (ptr_i, arr_i, []) - go ptr_i arr_i (ty:tys) + + {- Collect all PrimReps from the Type, indexing each with an Int. + Also returns a function to construct the Term once the heap offset of + each indexed PrimRep is known. + -} + collectReps :: Int -- first index to use + -> Type + -> ( Int -- next available index + , ( [(PrimRep, Int)] -- indexed PrimReps + , Array Int ByteOff -> Int -> TcM Term + )) + collectReps n ty | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty , isUnboxedTupleTyCon tc - -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon - = do (ptr_i, arr_i, terms0) <- - go ptr_i arr_i (dropRuntimeRepArgs elem_tys) - (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys - return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) - | otherwise - = case typePrimRep ty of - [rep_ty] -> do - (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty - (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys - return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys - (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys - return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) - - go_unary_types ptr_i arr_i [] = return (ptr_i, arr_i, []) - go_unary_types ptr_i arr_i (rep_ty:rep_tys) = do - tv <- newVar liftedTypeKind - (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i tv rep_ty - (ptr_i, arr_i, terms1) <- go_unary_types ptr_i arr_i rep_tys - return (ptr_i, arr_i, term0 : terms1) - - go_rep ptr_i arr_i ty rep + -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon + = let (n', sub) = mapAccumL collectReps n (dropRuntimeRepArgs elem_tys) + (reps, mk_terms) = unzip sub + in (n', (concat reps, + \idx ptr_words -> unboxedTupleTerm ty <$> + mapM (\mk -> mk idx ptr_words) mk_terms)) + | otherwise = + case typePrimRep ty of + [rep] -> (n + 1 + ,([(rep, n)] + ,\idx ptr_words -> mkTerm ptr_words ty rep (idx ! n))) + reps -> let n_reps = length reps + indexed_reps = zip reps [n..] + mk idx ptr_words = + unboxedTupleTerm ty <$> + mapM (\(rep, i) -> mkTerm ptr_words ty rep (idx ! i)) + indexed_reps + in (n + n_reps, (indexed_reps, mk)) + + + + mkTerm :: Int -> Type -> PrimRep -> ByteOff -> TcM Term + mkTerm ptr_words ty rep byte_offset | isGcPtrRep rep = do - t <- recurse ty $ ptr_args !! ptr_i - return (ptr_i + 1, arr_i, t) + platform <- getPlatform + let word_size = platformWordSizeInBytes platform + (word_offset, r) = byte_offset `quotRem` word_size + massert (word_offset < length ptr_args) + massert (r == 0) + r <- recurse ty (ptr_args !! (byte_offset `quot` word_size)) + pure r | otherwise = do - -- This is a bit involved since we allow packing multiple fields - -- within a single word. See also - -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding platform <- getPlatform let word_size = platformWordSizeInBytes platform - endian = platformByteOrder platform - size_b = primRepSizeB platform rep - -- Align the start offset (eg, 2-byte value should be 2-byte - -- aligned). But not more than to a word. The offset calculation - -- should be the same with the offset calculation in - -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding. - !aligned_idx = roundUpTo arr_i (min word_size size_b) - !new_arr_i = aligned_idx + size_b - ws | size_b < word_size = - [index size_b aligned_idx word_size endian] - | otherwise = - let (q, r) = size_b `quotRem` word_size - in assert (r == 0 ) - [ data_args !! i - | o <- [0.. q - 1] - , let i = (aligned_idx `quot` word_size) + o - ] - return (ptr_i, new_arr_i, Prim ty ws) + endian = platformByteOrder platform + size_b = primRepSizeB platform rep + ws | size_b < word_size + = [index size_b (byte_offset - word_size * ptr_words) word_size endian] + | otherwise + = + let (q, r) = size_b `quotRem` word_size + in assert (r == 0 ) + [ data_args !! i + | o <- [0.. q - 1] + , let i = (byte_offset `quot` word_size) - ptr_words + o + ] + return (Prim ty ws) unboxedTupleTerm ty terms = Term ty (Right (tupleDataCon Unboxed (length terms))) ===================================== compiler/GHC/StgToCmm/Layout.hs ===================================== @@ -56,7 +56,8 @@ import GHC.Platform.Profile import GHC.Unit import GHC.Utils.Misc -import Data.List (mapAccumL, partition) +import Data.List (mapAccumL, partition, sortBy) +import Data.Ord (comparing) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Constants (debugIsOn) @@ -459,10 +460,19 @@ mkVirtHeapOffsetsWithPadding profile header things = ThunkHeader -> thunkHdrSize profile hdr_bytes = wordsToBytes platform hdr_words - (ptrs, non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things + (ptrs, unsorted_non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things + + -- Sort the non-pointer fields by their size, starting with the largest + -- size, so that we can pack them more efficiently. + + cmp_sizes (NonVoid (rep1, _)) (NonVoid (rep2, _)) = + comparing (primRepSizeB platform) rep2 rep1 + + non_ptrs = sortBy cmp_sizes unsorted_non_ptrs (bytes_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs + (tot_bytes, non_ptrs_w_offsets) = mapAccumL computeOffset bytes_of_ptrs non_ptrs ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -67,10 +67,26 @@ import GHC.Exts.Heap.ClosureTypes import GHC.Exts.Heap.Constants import GHC.Exts.Heap.ProfInfo.Types #if defined(PROFILING) +import GHC.Exts.Heap.InfoTable () -- See Note [No way-dependent imports] import GHC.Exts.Heap.InfoTableProf #else import GHC.Exts.Heap.InfoTable +import GHC.Exts.Heap.InfoTableProf () -- See Note [No way-dependent imports] + +{- +Note [No way-dependent imports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`ghc -M` currently assumes that the imports for a module are the same +in every way. This is arguably a bug, but breaking this assumption by +importing different things in different ways can cause trouble. For +example, this module in the profiling way imports and uses +GHC.Exts.Heap.InfoTableProf. When it was not also imported in the +vanilla way, there were intermittent build failures due to this module +being compiled in the profiling way before GHC.Exts.Heap.InfoTableProf +in the profiling way. (#15197) +-} #endif + import GHC.Exts.Heap.Utils import qualified GHC.Exts.Heap.FFIClosures as FFIClosures import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI ===================================== testsuite/tests/codeGen/should_run/T13825-unit.hs ===================================== @@ -25,8 +25,8 @@ tests :: Ghc () tests = do (_, _, off) <- runTest [("a", FloatRep), ("b", DoubleRep)] assert_32_64 (map fmt off) - ["F(a,4)", "F(b,8)"] - ["F(a,8)", "P(4,12)", "F(b,16)"] + ["F(b,4)", "F(a,12)"] + ["F(b,8)", "F(a,16)", "P(4,20)"] (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep)] assert_32_64 (map fmt off) @@ -40,8 +40,8 @@ tests = do (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep), ("c", Int64Rep)] assert_32_64 (map fmt off) - ["F(a,4)", "F(b,8)", "F(c,12)"] - ["F(a,8)", "F(b,12)", "F(c,16)"] + ["F(c,4)", "F(a,12)", "F(b,16)"] + ["F(c,8)", "F(a,16)", "F(b,20)"] (_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", FloatRep)] assert_32_64 (map fmt off) @@ -50,8 +50,8 @@ tests = do (_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", Int64Rep)] assert_32_64 (map fmt off) - ["F(a,4)", "F(b,12)", "F(c,16)"] - ["F(a,8)", "F(b,16)", "P(4,20)", "F(c,24)"] + ["F(a,4)", "F(c,12)", "F(b,20)"] + ["F(a,8)", "F(c,16)", "F(b,24)", "P(4,28)"] assert_32_64 :: (Eq a, Show a) => a -> a -> a -> Ghc () ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout ===================================== @@ -3481,6 +3481,7 @@ module GHC.PrimopWrappers where remWord8# :: GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# resizeMutableByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> (# GHC.Internal.Prim.State# s, GHC.Internal.Prim.MutableByteArray# s #) retry# :: forall a_levpoly. GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, a_levpoly #) + seq :: forall a b_reppoly. a -> b_reppoly -> b_reppoly setAddrRange# :: GHC.Internal.Prim.Addr# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld setByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> GHC.Internal.Prim.State# s setOtherThreadAllocationCounter# :: GHC.Internal.Prim.Int64# -> GHC.Internal.Prim.ThreadId# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 ===================================== @@ -3484,6 +3484,7 @@ module GHC.PrimopWrappers where remWord8# :: GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# resizeMutableByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> (# GHC.Internal.Prim.State# s, GHC.Internal.Prim.MutableByteArray# s #) retry# :: forall a_levpoly. GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, a_levpoly #) + seq :: forall a b_reppoly. a -> b_reppoly -> b_reppoly setAddrRange# :: GHC.Internal.Prim.Addr# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld setByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> GHC.Internal.Prim.State# s setOtherThreadAllocationCounter# :: GHC.Internal.Prim.Int64# -> GHC.Internal.Prim.ThreadId# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld ===================================== testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout ===================================== @@ -29,4 +29,4 @@ size: 10 ### u_maybeW32 U_MaybeW32 NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) -size: 9 +size: 6 ===================================== testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout-ws-32 ===================================== @@ -29,4 +29,4 @@ size: 11 ### u_maybeW32 U_MaybeW32 NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) -size: 17 +size: 11 ===================================== utils/genprimopcode/Main.hs ===================================== @@ -510,7 +510,7 @@ gen_wrappers (Info _ entries) want_wrapper :: Entry -> Bool want_wrapper entry = and - [ is_primop entry + [ (is_primop entry || is_seq_pseudoop entry) , not $ name entry `elem` magical_primops , not $ is_vector entry -- We currently don't generate wrappers for vector primops. @@ -520,6 +520,12 @@ gen_wrappers (Info _ entries) -- suppose this choice can be revisited? ] + -- We also want a wrapper for the `seq` pseudoop, since GHCi + -- expects to find a value binding in PrimopWrappers. + is_seq_pseudoop :: Entry -> Bool + is_seq_pseudoop (PseudoOpSpec { name = n }) = n == "seq" + is_seq_pseudoop _ = False + magical_primops :: [String] magical_primops = [ "tagToEnum#" ===================================== utils/genprimopcode/hie.yaml ===================================== @@ -0,0 +1,2 @@ +cradle: + cabal: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc0e9d59e614e97ab6dc1ac67251ff… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc0e9d59e614e97ab6dc1ac67251ff… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23162-spj] 32 commits: Handle heap allocation failure in I/O primops
by Simon Peyton Jones (＠simonpj) 13 Sep '25

13 Sep '25

Simon Peyton Jones pushed to branch wip/T23162-spj at Glasgow Haskell Compiler / GHC Commits: 62ae97de by Duncan Coutts at 2025-09-12T13:23:33-04:00 Handle heap allocation failure in I/O primops The current I/O managers do not use allocateMightFail, but future ones will. To support this properly we need to be able to return to the primop with a failure. We simply use a bool return value. Currently however, we will just throw an exception rather than calling the GC because that's what all the other primops do too. For the general issue of primops invoking GC and retrying, see https://gitlab.haskell.org/ghc/ghc/-/issues/24105 - - - - - cb9093f5 by Duncan Coutts at 2025-09-12T13:23:33-04:00 Move (and rename) scheduleStartSignalHandlers into RtsSignals.h Previously it was a local helper (static) function in Schedule.c. Rename it to startPendingSignalHandlers and deifine it as an inline header function in RtsSignals.h. So it should still be fast. Each (new style) I/O manager is going to need to do the same, so eliminating the duplication now makes sense. - - - - - 9736d44a by Duncan Coutts at 2025-09-12T13:23:33-04:00 Reduce detail in printThreadBlockage I/O blocking cases The printThreadBlockage is used in debug tracing output. For the cases BlockedOn{Read,Write,Delay} the output previously included the fd that was being waited on, and the delay target wake time. Superficially this sounds useful, but it's clearly not that useful because it was already wrong for the Win32 non-threaded I/O manager. In that situation it will print garbage (the async_result pointer, cast to a fd or a time). So given that it apparently never mattered that the information was accurate, then it's hardly a big jump to say it doesn't matter if it is present at all. A good reason to remove it is that otherwise we have to make a new API and a per-I/O manager implementation to fetch the information. And for some I/O manager implementations, this information is not available. It is not available in the win32 non-threaded I/O manager. And for some future Linux ones, there is no need for the fd to be stored, so storing it would be just extra space used for very little gain. So the simplest thing is to just remove the detail. - - - - - bc0f2d5d by Duncan Coutts at 2025-09-12T13:23:33-04:00 Add TimeoutQueue.{c,h} and corresponding tests A data structure used to efficiently manage a collection of timeouts. It is a priority queue based on absolute expiry time. It uses 64bit high-precision Time for the keys. The values are normal closures which allows for example using MVars for unblocking. It is common in many applications for timeouts to be created and then deleted or altered before they expire. Thus the choice of data structure for timeouts should support this efficiently. The implementation choice here is a leftist heap with the extra feature that it supports deleting arbitrary elements, provided the caller retain a pointer to the element. While the deleteMin operation takes O(log n) time, as in all heap structures, the delete operation for arbitrary elements /typically/ takes O(1), and only O(log n) in the worst case. In practice, when managing thousands of timeouts it can be a factor of 10 faster to delete a random timeout queue element than to remove the minimum element. This supports the common use case. The plan is to use it in some of the RTS-side I/O managers to support their timer functionality. In this use case the heap value will be an MVar used for each timeout to unblock waiting threads. - - - - - d1679c9d by Duncan Coutts at 2025-09-12T13:23:33-04:00 Add ClosureTable.{c,h} and corresponding tests A table of pointers to closures on the GC heap with stable indexes. It provides O(1) alloc, free and lookup. The table can be expanded using a simple doubling strategy: in which case allocation is typically O(1) and occasionally O(n) for overall amortised O(1). No shrinking is used. The table itself is heap allocated, and points to other heap objects. As such it's necessary to use markClosureTable to ensure the table is used as a GC root to keep the table entries alive, and maintain proper pointers to them as the GC moves heap objects about. It is designed to be allocated and accesses exclusively from a single capability, enabling it to work without any locking. It is thus similar to the StablePtr table, but per-capability which removes the need for locking. It _should_ also provide lower GC pause times with the non-moving GC by spending only O(1) time in markClosureTable, vs O(n) for markStablePtrTable. The plan is to use it in some of the I/O managers to keep track of in-flight I/O operations (but not timers). This allows the tracking info to be kept on the (unpinned) GC heap, and shared with Haskell code, and by putting a pointer to the tracking information in a table, the index remains stable and can be passed via foreign code (like the kernel). - - - - - 78cb8dd5 by Duncan Coutts at 2025-09-12T13:23:33-04:00 Add the StgAsyncIOOp closure type This is intended to be used by multiple I/O managers to help with tracking in-flight I/O operations. It is called asynchronous because from the point of view of the RTS we have many such operations in progress at once. From the point of view of a Haskell thread of course it can look synchronous. - - - - - a2839896 by Duncan Coutts at 2025-09-12T13:23:33-04:00 Add StgAsyncIOOp and StgTimeoutQueue to tso->block_info These will be used by new I/O managers, for threads blocked on I/O or timeouts. - - - - - fdc2451c by Duncan Coutts at 2025-09-12T13:23:33-04:00 Add a new I/O manager based on poll() This is a proof of concept I/O manager, to show how to add new ones neatly, using the ClosureTable and TimeoutQueue infrastructure. It uses the old unix poll() API, so it is of course limited in performance by that, but it should have the benefit of wide compatibility. Also we neatly avoid a name clash with the existing select() I/O manager. Compared to the select() I/O manager: 1. beause it uses poll() it is not limited to 1024 file descriptors (but it's still O(n) so don't expect great performance); 2. it should have much faster threadDelay (when using it in lots of threads at once) because it's based on the new TimeoutQueue which is O(log n) rather than O(n). Some of the code related to timers/timouts is put into a shared module rts/posix/Timeout.{h,c} since it is intended to be shared with other similar I/O managers. - - - - - 6c273b76 by Duncan Coutts at 2025-09-12T13:23:34-04:00 Document the I/O managers in the user guide and note the new poll I/O manager in the release notes. - - - - - 824fab74 by Duncan Coutts at 2025-09-12T13:23:34-04:00 Use the poll() I/O manager by default That is, for the non-threaded RTS, prefer the poll I/O manager over the legacy select() one, if both can be enabled. This patch is primarily for CI testing, so we should probably remove this patch before merging. We can change defaults later after wider testing and feedback. - - - - - 39392532 by Luite Stegeman at 2025-09-12T13:24:16-04:00 Support larger unboxed sums Change known constructor encoding for sums in interfaces to use 11 bits for both the arity and the alternative (up from 8 and 6, respectively) - - - - - 2af12e21 by Luite Stegeman at 2025-09-12T13:24:16-04:00 Decompose padding smallest-first in Cmm toplevel data constructors This makes each individual padding value aligned - - - - - 418fa78f by Luite Stegeman at 2025-09-12T13:24:16-04:00 Use slots smaller than word as tag for smaller unboxed sums This packs unboxed sums more efficiently by allowing Word8, Word16 and Word32 for the tag field if the number of constructors is small enough - - - - - 8d7e912f by Rodrigo Mesquita at 2025-09-12T17:57:24-04:00 ghc-toolchain: Use ByteOrder rather than new Endianness Don't introduce a duplicate datatype when the previous one is equivalent and already used elsewhere. This avoids unnecessary translation between the two. - - - - - 7d378476 by Rodrigo Mesquita at 2025-09-12T17:57:24-04:00 Read Toolchain.Target files rather than 'settings' This commit makes GHC read `lib/targets/default.target`, a file with a serialized value of `ghc-toolchain`'s `GHC.Toolchain.Target`. Moreover, it removes all the now-redundant entries from `lib/settings` that are configured as part of a `Target` but were being written into `settings`. This makes it easier to support multiple targets from the same compiler (aka runtime retargetability). `ghc-toolchain` can be re-run many times standalone to produce a `Target` description for different targets, and, in the future, GHC will be able to pick at runtime amongst different `Target` files. This commit only makes it read the default `Target` configured in-tree or configured when installing the bindist. The remaining bits of `settings` need to be moved to `Target` in follow up commits, but ultimately they all should be moved since they are per-target relevant. Fixes #24212 On Windows, the constant overhead of parsing a slightly more complex data structure causes some small-allocation tests to wiggle around 1 to 2 extra MB (1-2% in these cases). ------------------------- Metric Increase: MultiLayerModulesTH_OneShot T10421 T10547 T12234 T12425 T13035 T18140 T18923 T9198 TcPlugin_RewritePerf ------------------------- - - - - - e0780a16 by Rodrigo Mesquita at 2025-09-12T17:57:24-04:00 ghc-toolchain: Move TgtHasLibm to per-Target file TargetHasLibm is now part of the per-target configuration Towards #26227 - - - - - 8235dd8c by Rodrigo Mesquita at 2025-09-12T17:57:24-04:00 ghc-toolchain: Move UseLibdw to per-Target file To support DWARF unwinding, the RTS must be built with the -f+libdw flag and with the -DUSE_LIBDW macro definition. These flags are passed on build by Hadrian when --enable-dwarf-unwinding is specified at configure time. Whether the RTS was built with support for DWARF is a per-target property, and as such, it was moved to the per-target GHC.Toolchain.Target.Target file. Additionally, we keep in the target file the include and library paths for finding libdw, since libdw should be checked at configure time (be it by configure, or ghc-toolchain, that libdw is properly available). Preserving the user-given include paths for libdw facilitates in the future building the RTS on demand for a given target (if we didn't keep that user input, we couldn't) Towards #26227 - - - - - d5ecf2e8 by Rodrigo Mesquita at 2025-09-12T17:57:25-04:00 ghc-toolchain: Make "Support SMP" a query on a Toolchain.Target "Support SMP" is merely a function of target, so we can represent it as such in `ghc-toolchain`. Hadrian queries the Target using this predicate to determine how to build GHC, and GHC queries the Target similarly to report under --info whether it "Support SMP" Towards #26227 - - - - - e07b031a by Rodrigo Mesquita at 2025-09-12T17:57:25-04:00 ghc-toolchain: Make "tgt rts linker only supports shared libs" function on Target Just like with "Support SMP", "target RTS linker only supports shared libraries" is a predicate on a `Target` so we can just compute it when necessary from the given `Target`. Towards #26227 - - - - - 14123ee6 by Simon Peyton Jones at 2025-09-12T17:58:07-04:00 Solve forall-constraints via an implication, again In this earlier commit: commit 953fd8f1dc080f1c56e3a60b4b7157456949be29 Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Mon Jul 21 10:06:43 2025 +0100 Solve forall-constraints immediately, or not at all I used a all-or-nothing strategy for quantified constraints (aka forall-constraints). But alas that fell foul of #26315, and #26376. So this MR goes back to solving a quantified constraint by turning it into an implication; UNLESS we are simplifying constraints from a SPECIALISE pragma, in which case the all-or-nothing strategy is great. See: Note [Solving a Wanted forall-constraint] Other stuff in this MR: * TcSMode becomes a record of flags, rather than an enumeration type; much nicer. * Some fancy footwork to avoid error messages worsening again (The above MR made them better; we want to retain that.) See `GHC.Tc.Errors.Ppr.pprQCOriginExtra`. ------------------------- Metric Decrease: T24471 ------------------------- - - - - - e6c192e2 by Simon Peyton Jones at 2025-09-12T17:58:07-04:00 Add a test case for #26396 ...same bug ast #26315 - - - - - d06afd89 by Richard Eisenberg at 2025-09-13T21:04:23+01:00 Move some fundep solving to new spot Work in progress...[skip ci] This completes moving dict fundeps to the main loop We need wanted/wanted fundeps too ...and some other refactors Wibbles Make FunDeps into a new module Solve new_eqs rather than adding them to WantedConstraints Wibble Import wibbles Comments only [skip ci] WIP on FunDeps [skip ci] Work in progress [skip ci] More WIP Wibbles to fundeps [skip ci] Kill off kickOutAfterUnification More wibbles Need to remove the unification-count stuff entirely and do more tidying up -- this commit is mainly for CI Wibbles solver Iterate the simples more often than plugins Start to extend to equalities Whitespace only Small improvements Wibbles - - - - - a1e2d28a by Simon Peyton Jones at 2025-09-13T21:04:29+01:00 Improved error messages from fundep changes - - - - - 3c895f69 by Simon Peyton Jones at 2025-09-13T21:04:29+01:00 Wibbles - - - - - 22950682 by Simon Peyton Jones at 2025-09-13T21:04:30+01:00 Fix typo - - - - - 45d461d5 by Simon Peyton Jones at 2025-09-13T21:04:30+01:00 Wibbles - - - - - 0e632247 by Simon Peyton Jones at 2025-09-13T21:07:33+01:00 Nuke FunDepOrigin1 and 2 - - - - - 6423cfc4 by Simon Peyton Jones at 2025-09-13T21:07:36+01:00 Wibble - - - - - d02a0f5d by Simon Peyton Jones at 2025-09-13T21:09:02+01:00 More refactoring - - - - - 58cfe2b5 by Simon Peyton Jones at 2025-09-13T21:09:06+01:00 More tidying up - - - - - e4879a8e by Simon Peyton Jones at 2025-09-13T21:09:25+01:00 Yet more - - - - - 6aa7a192 by Simon Peyton Jones at 2025-09-13T23:01:17+01:00 Wibbles - - - - - 173 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/SysTools/BaseDir.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - + compiler/GHC/Tc/Solver/FunDeps.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Solver/Solve.hs-boot - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/RepType.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - docs/users_guide/9.16.1-notes.rst - docs/users_guide/runtime_control.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Base.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/src/GHC/RTS/Flags.hs - libraries/ghc-boot/GHC/Settings/Utils.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs - m4/fp_find_libdw.m4 - − m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - + m4/subst_tooldir.m4 - mk/hsc2hs.in - + rts/ClosureTable.c - + rts/ClosureTable.h - rts/IOManager.c - rts/IOManager.h - rts/IOManagerInternals.h - rts/PrimOps.cmm - rts/RtsSignals.h - rts/Schedule.c - rts/StgMiscClosures.cmm - rts/Threads.c - + rts/TimeoutQueue.c - + rts/TimeoutQueue.h - rts/configure.ac - rts/include/rts/Constants.h - rts/include/rts/Flags.h - rts/include/rts/storage/Closures.h - rts/include/rts/storage/TSO.h - rts/include/stg/MiscClosures.h - + rts/posix/Poll.c - + rts/posix/Poll.h - + rts/posix/Timeout.c - + rts/posix/Timeout.h - rts/rts.cabal - testsuite/tests/backpack/should_fail/bkpfail11.stderr - testsuite/tests/backpack/should_fail/bkpfail43.stderr - testsuite/tests/codeGen/should_compile/T25166.stdout → testsuite/tests/codeGen/should_compile/T25166.stdout-ws-32 - + testsuite/tests/codeGen/should_compile/T25166.stdout-ws-64 - testsuite/tests/dependent/should_fail/T13135_simple.stderr - + testsuite/tests/deriving/should_compile/T26396.hs - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/deriving/should_fail/T12768.stderr - testsuite/tests/deriving/should_fail/T1496.stderr - testsuite/tests/deriving/should_fail/T21302.stderr - testsuite/tests/deriving/should_fail/T22696b.stderr - testsuite/tests/deriving/should_fail/T3621.stderr - testsuite/tests/deriving/should_fail/T5498.stderr - testsuite/tests/deriving/should_fail/T7148.stderr - testsuite/tests/deriving/should_fail/T7148a.stderr - testsuite/tests/ghc-api/T20757.hs - testsuite/tests/ghc-api/settings-escape/T24265.hs - testsuite/tests/ghc-api/settings-escape/T24265.stderr - + testsuite/tests/ghc-api/settings-escape/ghc-install-folder/lib with spaces/targets/.gitkeep - testsuite/tests/impredicative/T17332.stderr - testsuite/tests/indexed-types/should_fail/T14369.stderr - testsuite/tests/indexed-types/should_fail/T9662.stderr - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr - testsuite/tests/parser/should_fail/T20654a.stderr - testsuite/tests/partial-sigs/should_fail/T14040a.stderr - testsuite/tests/polykinds/T6068.stdout - testsuite/tests/quantified-constraints/T19690.stderr - testsuite/tests/quantified-constraints/T19921.stderr - testsuite/tests/quantified-constraints/T21006.stderr - testsuite/tests/roles/should_fail/RolesIArray.stderr - + testsuite/tests/rts/ClosureTable.hs - + testsuite/tests/rts/ClosureTable_c.c - + testsuite/tests/rts/TimeoutQueue.c - + testsuite/tests/rts/TimeoutQueue.stdout - testsuite/tests/rts/all.T - testsuite/tests/simplCore/should_compile/DsSpecPragmas.hs - testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr - testsuite/tests/typecheck/no_skolem_info/T14040.stderr - testsuite/tests/typecheck/should_compile/T13651.hs - testsuite/tests/typecheck/should_compile/T14434.hs - + testsuite/tests/typecheck/should_compile/T14745.hs - + testsuite/tests/typecheck/should_compile/T26376.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/tc126.hs - testsuite/tests/typecheck/should_fail/AmbigFDs.hs - − testsuite/tests/typecheck/should_fail/AmbigFDs.stderr - testsuite/tests/typecheck/should_fail/FD3.stderr - testsuite/tests/typecheck/should_fail/FDsFromGivens2.stderr - testsuite/tests/typecheck/should_fail/T13506.stderr - testsuite/tests/typecheck/should_fail/T15801.stderr - testsuite/tests/typecheck/should_fail/T16512a.stderr - testsuite/tests/typecheck/should_fail/T18851b.hs - − testsuite/tests/typecheck/should_fail/T18851b.stderr - testsuite/tests/typecheck/should_fail/T18851c.hs - − testsuite/tests/typecheck/should_fail/T18851c.stderr - testsuite/tests/typecheck/should_fail/T19415.stderr - testsuite/tests/typecheck/should_fail/T19415b.stderr - testsuite/tests/typecheck/should_fail/T19627.stderr - testsuite/tests/typecheck/should_fail/T20666.stderr - testsuite/tests/typecheck/should_fail/T20666a.stderr - testsuite/tests/typecheck/should_fail/T20666b.stderr - testsuite/tests/typecheck/should_fail/T22912.stderr - testsuite/tests/typecheck/should_fail/T23427.stderr - testsuite/tests/typecheck/should_fail/T25325.stderr - testsuite/tests/typecheck/should_fail/T5246.stderr - testsuite/tests/typecheck/should_fail/T5978.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/T9612.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail143.stderr - + testsuite/tests/unboxedsums/UbxSumUnpackedSize.hs - + testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout - + testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout-ws-32 - testsuite/tests/unboxedsums/all.T - testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs - utils/ghc-pkg/Main.hs - utils/ghc-pkg/ghc-pkg.cabal.in - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - + utils/ghc-toolchain/src/GHC/Toolchain/Library.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aab7d3366fc6211722b2c8affa1dc7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aab7d3366fc6211722b2c8affa1dc7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] ghc-heap: Fix race condition with profiling builds
by Marge Bot (＠marge-bot) 13 Sep '25

13 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 99b233f4 by Alison at 2025-09-13T16:51:04-04:00 ghc-heap: Fix race condition with profiling builds Apply the same fix from Closures.hs (64fd0fac83) to Heap.hs by adding empty imports to make way-dependent dependencies visible to `ghc -M`. Fixes #15197, #26407 - - - - - 1 changed file: - libraries/ghc-heap/GHC/Exts/Heap.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -67,10 +67,26 @@ import GHC.Exts.Heap.ClosureTypes import GHC.Exts.Heap.Constants import GHC.Exts.Heap.ProfInfo.Types #if defined(PROFILING) +import GHC.Exts.Heap.InfoTable () -- See Note [No way-dependent imports] import GHC.Exts.Heap.InfoTableProf #else import GHC.Exts.Heap.InfoTable +import GHC.Exts.Heap.InfoTableProf () -- See Note [No way-dependent imports] + +{- +Note [No way-dependent imports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`ghc -M` currently assumes that the imports for a module are the same +in every way. This is arguably a bug, but breaking this assumption by +importing different things in different ways can cause trouble. For +example, this module in the profiling way imports and uses +GHC.Exts.Heap.InfoTableProf. When it was not also imported in the +vanilla way, there were intermittent build failures due to this module +being compiled in the profiling way before GHC.Exts.Heap.InfoTableProf +in the profiling way. (#15197) +-} #endif + import GHC.Exts.Heap.Utils import qualified GHC.Exts.Heap.FFIClosures as FFIClosures import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99b233f45064ec8a10df28cd53ed70c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99b233f45064ec8a10df28cd53ed70c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: Use mkVirtHeapOffsets for reconstructing terms in RTTI
by Marge Bot (＠marge-bot) 13 Sep '25

13 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8f3d80ff by Luite Stegeman at 2025-09-13T08:43:09+02:00 Use mkVirtHeapOffsets for reconstructing terms in RTTI This makes mkVirtHeapOffsets the single source of truth for finding field offsets in closures. - - - - - eb389338 by Luite Stegeman at 2025-09-13T08:43:09+02:00 Sort non-pointer fields by size for more efficient packing This sorts non-pointer fields in mkVirtHeapOffsets, always storing the largest field first. The relative order of equally sized fields remains unchanged. This reduces wasted padding/alignment space in closures with differently sized fields. - - - - - 5 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/StgToCmm/Layout.hs - testsuite/tests/codeGen/should_run/T13825-unit.hs - testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout - testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout-ws-32 Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -74,12 +74,12 @@ import GHC.Utils.Outputable as Ppr import GHC.Utils.Panic import GHC.Char import GHC.Exts.Heap -import GHC.Runtime.Heap.Layout ( roundUpTo ) +import GHC.Runtime.Heap.Layout (ByteOff) import GHC.IO (throwIO) import Control.Monad import Data.Maybe -import Data.List ((\\)) +import Data.List ((\\), mapAccumL) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import GHC.Exts @@ -89,6 +89,10 @@ import Foreign hiding (shiftL, shiftR) import System.IO.Unsafe import GHC.InfoProv +import GHC.StgToCmm.Closure ( NonVoid(NonVoid)) +import GHC.StgToCmm.Layout (mkVirtHeapOffsets, ClosureHeader(..)) +import Data.Array (Array, (!), array) + --------------------------------------------- -- * A representation of semi evaluated Terms --------------------------------------------- @@ -922,63 +926,80 @@ extractSubTerms :: (Type -> ForeignHValue -> TcM Term) -> [Word] -- ^ data arguments -> [Type] -> TcM [Term] -extractSubTerms recurse ptr_args data_args = liftM thdOf3 . go 0 0 +extractSubTerms recurse ptr_args data_args tys = do + dflags <- getDynFlags + let profile = targetProfile dflags + (n_primreps, r) = mapAccumL collectReps 0 tys + (rep_tys, make_term) = unzip r + (_tot_words, ptr_words, nv_rep_offsets) = + mkVirtHeapOffsets profile NoHeader (map NonVoid $ concat rep_tys) + rep_offsets = map (\(NonVoid x, off) -> (x, off)) nv_rep_offsets + -- index maps the Int index of each PrimRep to its ByteOff + index :: Array Int ByteOff + index = array (0, n_primreps-1) rep_offsets + mapM (\m -> m index ptr_words) make_term where - go ptr_i arr_i [] = return (ptr_i, arr_i, []) - go ptr_i arr_i (ty:tys) + + {- Collect all PrimReps from the Type, indexing each with an Int. + Also returns a function to construct the Term once the heap offset of + each indexed PrimRep is known. + -} + collectReps :: Int -- first index to use + -> Type + -> ( Int -- next available index + , ( [(PrimRep, Int)] -- indexed PrimReps + , Array Int ByteOff -> Int -> TcM Term + )) + collectReps n ty | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty , isUnboxedTupleTyCon tc - -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon - = do (ptr_i, arr_i, terms0) <- - go ptr_i arr_i (dropRuntimeRepArgs elem_tys) - (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys - return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) - | otherwise - = case typePrimRep ty of - [rep_ty] -> do - (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty - (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys - return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys - (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys - return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) - - go_unary_types ptr_i arr_i [] = return (ptr_i, arr_i, []) - go_unary_types ptr_i arr_i (rep_ty:rep_tys) = do - tv <- newVar liftedTypeKind - (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i tv rep_ty - (ptr_i, arr_i, terms1) <- go_unary_types ptr_i arr_i rep_tys - return (ptr_i, arr_i, term0 : terms1) - - go_rep ptr_i arr_i ty rep + -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon + = let (n', sub) = mapAccumL collectReps n (dropRuntimeRepArgs elem_tys) + (reps, mk_terms) = unzip sub + in (n', (concat reps, + \idx ptr_words -> unboxedTupleTerm ty <$> + mapM (\mk -> mk idx ptr_words) mk_terms)) + | otherwise = + case typePrimRep ty of + [rep] -> (n + 1 + ,([(rep, n)] + ,\idx ptr_words -> mkTerm ptr_words ty rep (idx ! n))) + reps -> let n_reps = length reps + indexed_reps = zip reps [n..] + mk idx ptr_words = + unboxedTupleTerm ty <$> + mapM (\(rep, i) -> mkTerm ptr_words ty rep (idx ! i)) + indexed_reps + in (n + n_reps, (indexed_reps, mk)) + + + + mkTerm :: Int -> Type -> PrimRep -> ByteOff -> TcM Term + mkTerm ptr_words ty rep byte_offset | isGcPtrRep rep = do - t <- recurse ty $ ptr_args !! ptr_i - return (ptr_i + 1, arr_i, t) + platform <- getPlatform + let word_size = platformWordSizeInBytes platform + (word_offset, r) = byte_offset `quotRem` word_size + massert (word_offset < length ptr_args) + massert (r == 0) + r <- recurse ty (ptr_args !! (byte_offset `quot` word_size)) + pure r | otherwise = do - -- This is a bit involved since we allow packing multiple fields - -- within a single word. See also - -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding platform <- getPlatform let word_size = platformWordSizeInBytes platform - endian = platformByteOrder platform - size_b = primRepSizeB platform rep - -- Align the start offset (eg, 2-byte value should be 2-byte - -- aligned). But not more than to a word. The offset calculation - -- should be the same with the offset calculation in - -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding. - !aligned_idx = roundUpTo arr_i (min word_size size_b) - !new_arr_i = aligned_idx + size_b - ws | size_b < word_size = - [index size_b aligned_idx word_size endian] - | otherwise = - let (q, r) = size_b `quotRem` word_size - in assert (r == 0 ) - [ data_args !! i - | o <- [0.. q - 1] - , let i = (aligned_idx `quot` word_size) + o - ] - return (ptr_i, new_arr_i, Prim ty ws) + endian = platformByteOrder platform + size_b = primRepSizeB platform rep + ws | size_b < word_size + = [index size_b (byte_offset - word_size * ptr_words) word_size endian] + | otherwise + = + let (q, r) = size_b `quotRem` word_size + in assert (r == 0 ) + [ data_args !! i + | o <- [0.. q - 1] + , let i = (byte_offset `quot` word_size) - ptr_words + o + ] + return (Prim ty ws) unboxedTupleTerm ty terms = Term ty (Right (tupleDataCon Unboxed (length terms))) ===================================== compiler/GHC/StgToCmm/Layout.hs ===================================== @@ -56,7 +56,8 @@ import GHC.Platform.Profile import GHC.Unit import GHC.Utils.Misc -import Data.List (mapAccumL, partition) +import Data.List (mapAccumL, partition, sortBy) +import Data.Ord (comparing) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Constants (debugIsOn) @@ -459,10 +460,19 @@ mkVirtHeapOffsetsWithPadding profile header things = ThunkHeader -> thunkHdrSize profile hdr_bytes = wordsToBytes platform hdr_words - (ptrs, non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things + (ptrs, unsorted_non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things + + -- Sort the non-pointer fields by their size, starting with the largest + -- size, so that we can pack them more efficiently. + + cmp_sizes (NonVoid (rep1, _)) (NonVoid (rep2, _)) = + comparing (primRepSizeB platform) rep2 rep1 + + non_ptrs = sortBy cmp_sizes unsorted_non_ptrs (bytes_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs + (tot_bytes, non_ptrs_w_offsets) = mapAccumL computeOffset bytes_of_ptrs non_ptrs ===================================== testsuite/tests/codeGen/should_run/T13825-unit.hs ===================================== @@ -25,8 +25,8 @@ tests :: Ghc () tests = do (_, _, off) <- runTest [("a", FloatRep), ("b", DoubleRep)] assert_32_64 (map fmt off) - ["F(a,4)", "F(b,8)"] - ["F(a,8)", "P(4,12)", "F(b,16)"] + ["F(b,4)", "F(a,12)"] + ["F(b,8)", "F(a,16)", "P(4,20)"] (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep)] assert_32_64 (map fmt off) @@ -40,8 +40,8 @@ tests = do (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep), ("c", Int64Rep)] assert_32_64 (map fmt off) - ["F(a,4)", "F(b,8)", "F(c,12)"] - ["F(a,8)", "F(b,12)", "F(c,16)"] + ["F(c,4)", "F(a,12)", "F(b,16)"] + ["F(c,8)", "F(a,16)", "F(b,20)"] (_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", FloatRep)] assert_32_64 (map fmt off) @@ -50,8 +50,8 @@ tests = do (_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", Int64Rep)] assert_32_64 (map fmt off) - ["F(a,4)", "F(b,12)", "F(c,16)"] - ["F(a,8)", "F(b,16)", "P(4,20)", "F(c,24)"] + ["F(a,4)", "F(c,12)", "F(b,20)"] + ["F(a,8)", "F(c,16)", "F(b,24)", "P(4,28)"] assert_32_64 :: (Eq a, Show a) => a -> a -> a -> Ghc () ===================================== testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout ===================================== @@ -29,4 +29,4 @@ size: 10 ### u_maybeW32 U_MaybeW32 NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) -size: 9 +size: 6 ===================================== testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout-ws-32 ===================================== @@ -29,4 +29,4 @@ size: 11 ### u_maybeW32 U_MaybeW32 NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) -size: 17 +size: 11 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6c192e2ccdc6e7ac939ea70d891f1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6c192e2ccdc6e7ac939ea70d891f1… You're receiving this email because of your account on gitlab.haskell.org.

1 0