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/54ee4bca623e0b0f34148559ed75143... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54ee4bca623e0b0f34148559ed75143... You're receiving this email because of your account on gitlab.haskell.org.