Cheng Shao pushed to branch wip/ghci-no-simpl at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • compiler/GHC/Core/Opt/Pipeline.hs
    ... ... @@ -6,7 +6,7 @@
    6 6
    7 7 
     {-# LANGUAGE CPP #-}
    8 8
    9 
    -module GHC.Core.Opt.Pipeline ( core2core, simplifyExpr ) where
    9 
    +module GHC.Core.Opt.Pipeline ( core2core ) where
    10 10
    11 11 
     import GHC.Prelude
    12 12
    ... ... @@ -27,7 +27,7 @@ import GHC.Core.Ppr ( pprCoreBindings )
    27 27 
     import GHC.Core.Utils   ( dumpIdInfoOfProgram )
    28 28 
     import GHC.Core.Lint    ( lintAnnots )
    29 29 
     import GHC.Core.Lint.Interactive ( interactiveInScope )
    30 
    -import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm )
    30 
    +import GHC.Core.Opt.Simplify ( simplifyPgm )
    31 31 
     import GHC.Core.Opt.Simplify.Monad
    32 32 
     import GHC.Core.Opt.Monad
    33 33 
     import GHC.Core.Opt.Pipeline.Types

  • compiler/GHC/Core/Opt/Simplify.hs
    1 1 
     {-# LANGUAGE CPP #-}
    2 2
    3 3 
     module GHC.Core.Opt.Simplify
    4 
    -  ( SimplifyExprOpts(..), SimplifyOpts(..)
    5 
    -  , simplifyExpr, simplifyPgm
    4 
    +  ( SimplifyOpts(..)
    5 
    +  , simplifyPgm
    6 6 
       ) where
    7 7
    8 8 
     import GHC.Prelude
    ... ... @@ -11,20 +11,18 @@ import GHC.Driver.Flags
    11 11
    12 12 
     import GHC.Core
    13 13 
     import GHC.Core.Rules
    14 
    -import GHC.Core.Ppr     ( pprCoreBindings, pprCoreExpr )
    15 
    -import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
    16 
    -import GHC.Core.Stats   ( coreBindsSize, coreBindsStats, exprSize )
    14 
    +import GHC.Core.Ppr     ( pprCoreBindings )
    15 
    +import GHC.Core.Opt.OccurAnal ( occurAnalysePgm )
    16 
    +import GHC.Core.Stats   ( coreBindsSize, coreBindsStats )
    17 17 
     import GHC.Core.Utils   ( mkTicks, stripTicksTop )
    18 18 
     import GHC.Core.Lint    ( LintPassResultConfig, dumpPassResult, lintPassResult )
    19 
    -import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules )
    19 
    +import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplImpRules )
    20 20 
     import GHC.Core.Opt.Simplify.Utils  ( activeRule )
    21 21 
     import GHC.Core.Opt.Simplify.Inline ( activeUnfolding )
    22 22 
     import GHC.Core.Opt.Simplify.Env
    23 23 
     import GHC.Core.Opt.Simplify.Monad
    24 24 
     import GHC.Core.Opt.Stats ( simplCountN )
    25 
    -import GHC.Core.FamInstEnv
    26 25
    27 
    -import GHC.Utils.Error  ( withTiming )
    28 26 
     import GHC.Utils.Logger as Logger
    29 27 
     import GHC.Utils.Outputable
    30 28 
     import GHC.Utils.Constants (debugIsOn)
    ... ... @@ -44,72 +42,6 @@ import GHC.Types.Unique.FM
    44 42 
     import Control.Monad
    45 43 
     import Data.Foldable ( for_ )
    46 44
    47 
    -{-
    48 
    -************************************************************************
    49 
    -*                                                                      *
    50 
    -        Gentle simplification
    51 
    -*                                                                      *
    52 
    -************************************************************************
    53 
    --}
    54 
    -
    55 
    --- | Configuration record for `simplifyExpr`.
    56 
    --- The values of this datatype are /only/ driven by the demands of that function.
    57 
    -data SimplifyExprOpts = SimplifyExprOpts
    58 
    -  { se_fam_inst :: ![FamInst]
    59 
    -  , se_mode :: !SimplMode
    60 
    -  , se_top_env_cfg :: !TopEnvConfig
    61 
    -  }
    62 
    -
    63 
    -simplifyExpr :: Logger
    64 
    -             -> ExternalUnitCache
    65 
    -             -> SimplifyExprOpts
    66 
    -             -> CoreExpr
    67 
    -             -> IO CoreExpr
    68 
    --- ^ Simplify an expression using 'simplExprGently'.
    69 
    ---
    70 
    --- See 'simplExprGently' for details.
    71 
    -simplifyExpr logger euc opts expr
    72 
    -  = withTiming logger (text "Simplify [expr]") (const ()) $
    73 
    -    do  { eps <- eucEPS euc ;
    74 
    -        ; let fam_envs = ( eps_fam_inst_env eps
    75 
    -                         , extendFamInstEnvList emptyFamInstEnv $ se_fam_inst opts
    76 
    -                         )
    77 
    -              simpl_env = mkSimplEnv (se_mode opts) fam_envs
    78 
    -              top_env_cfg = se_top_env_cfg opts
    79 
    -              read_eps_rules = eps_rule_base <$> eucEPS euc
    80 
    -              read_ruleenv = updExternalPackageRules emptyRuleEnv <$> read_eps_rules
    81 
    -
    82 
    -        ; let sz = exprSize expr
    83 
    -
    84 
    -        ; (expr', counts) <- initSmpl logger read_ruleenv top_env_cfg sz $
    85 
    -                             simplExprGently simpl_env expr
    86 
    -
    87 
    -        ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats
    88 
    -                  "Simplifier statistics" FormatText (pprSimplCount counts)
    89 
    -
    90 
    -        ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression"
    91 
    -                        FormatCore
    92 
    -                        (pprCoreExpr expr')
    93 
    -
    94 
    -        ; return expr'
    95 
    -        }
    96 
    -
    97 
    -simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
    98 
    --- ^ Simplifies an expression by doing occurrence analysis, then simplification,
    99 
    --- and repeating (twice currently), because one pass alone leaves tons of crud.
    100 
    ---
    101 
    --- Used only:
    102 
    ---
    103 
    ---   1. for user expressions typed in at the interactive prompt (see 'GHC.Driver.Main.hscStmt'),
    104 
    ---   2. for Template Haskell splices (see 'GHC.Tc.Gen.Splice.runMeta').
    105 
    ---
    106 
    --- The name 'Gently' suggests that the SimplMode is InitialPhase,
    107 
    --- and in fact that is so.... but the 'Gently' in 'simplExprGently' doesn't
    108 
    --- enforce that; it just simplifies the expression twice.
    109 
    -simplExprGently env expr = do
    110 
    -    expr1 <- simplExpr env (occurAnalyseExpr expr)
    111 
    -    simplExpr env (occurAnalyseExpr expr1)
    112 
    -
    113 45 
     {-
    114 46 
     ************************************************************************
    115 47 
     *                                                                      *

  • compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
    1 1 
     module GHC.Driver.Config.Core.Opt.Simplify
    2 
    -  ( initSimplifyExprOpts
    3 
    -  , initSimplifyOpts
    2 
    +  ( initSimplifyOpts
    4 3 
       , initSimplMode
    5 4 
       , initGentleSimplMode
    6 5 
       ) where
    ... ... @@ -9,7 +8,7 @@ import GHC.Prelude
    9 8
    10 9 
     import GHC.Core.Rules ( RuleBase )
    11 10 
     import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) )
    12 
    -import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) )
    11 
    +import GHC.Core.Opt.Simplify ( SimplifyOpts(..) )
    13 12 
     import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..), SimplPhase(..) )
    14 13 
     import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) )
    15 14
    ... ... @@ -19,26 +18,9 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts )
    19 18 
     import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts )
    20 19 
     import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt )
    21 20
    22 
    -import GHC.Runtime.Context ( InteractiveContext(..) )
    23 
    -
    24 21 
     import GHC.Types.Basic ( CompilerPhase(..) )
    25 22 
     import GHC.Types.Var ( Var )
    26 23
    27 
    -initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts
    28 
    -initSimplifyExprOpts dflags ic = SimplifyExprOpts
    29 
    -  { se_fam_inst = snd $ ic_instances ic
    30 
    -  , se_mode = (initSimplMode dflags InitialPhase "GHCi")
    31 
    -    { sm_inline = False
    32 
    -      -- Do not do any inlining, in case we expose some
    33 
    -      -- unboxed tuple stuff that confuses the bytecode
    34 
    -      -- interpreter
    35 
    -    }
    36 
    -  , se_top_env_cfg = TopEnvConfig
    37 
    -    { te_history_size = historySize dflags
    38 
    -    , te_tick_factor = simplTickFactor dflags
    39 
    -    }
    40 
    -  }
    41 
    -
    42 24 
     initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts
    43 25 
     initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let
    44 26 
       -- 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
    121 121 
     import GHC.Driver.Messager
    122 122 
     import GHC.Driver.Errors.Types
    123 123 
     import GHC.Driver.CodeOutput
    124 
    +import GHC.Driver.Config
    124 125 
     import GHC.Driver.Config.Cmm.Parser (initCmmParserConfig)
    125 
    -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts )
    126 126 
     import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO )
    127 127 
     import GHC.Driver.Config.Core.Lint.Interactive ( lintInteractiveExpr )
    128 128 
     import GHC.Driver.Config.CoreToStg
    ... ... @@ -181,6 +181,7 @@ import GHC.Core.Utils ( exprType )
    181 181 
     import GHC.Core.ConLike
    182 182 
     import GHC.Core.Opt.Pipeline
    183 183 
     import GHC.Core.Opt.Pipeline.Types      ( CoreToDo (..))
    184 
    +import GHC.Core.SimpleOpt
    184 185 
     import GHC.Core.TyCon
    185 186 
     import GHC.Core.InstEnv
    186 187 
     import GHC.Core.FamInstEnv
    ... ... @@ -2448,8 +2449,7 @@ hscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do
    2448 2449 
       -- It's important NOT to have package 'interactive' as thisUnitId
    2449 2450 
       -- for linking, else we try to link 'main' and can't find it.
    2450 2451 
       -- Whereas the linker already knows to ignore 'interactive'
    2451 
    -  let src_span = srcLocSpan interactiveSrcLoc
    2452 
    -  (hval,_,_) <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
    2452 
    +  (hval,_,_) <- liftIO $ hscCompileCoreExpr hsc_env interactiveSrcSpan ds_expr
    2453 2453
    2454 2454 
       return $ Just (ids, hval, fix_env)
    2455 2455
    ... ... @@ -2512,8 +2512,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
    2512 2512 
           (mkCgInteractiveGuts tidy_cg)
    2513 2513 
           iNTERACTIVELoc
    2514 2514
    2515 
    -    let src_span = srcLocSpan interactiveSrcLoc
    2516 
    -    _ <- liftIO $ loadDecls interp hsc_env src_span linkable
    2515 
    +    _ <- liftIO $ loadDecls interp hsc_env interactiveSrcSpan linkable
    2517 2516
    2518 2517 
         {- Load static pointer table entries -}
    2519 2518 
         liftIO $ hscAddSptEntries hsc_env (cg_spt_entries tidy_cg)
    ... ... @@ -2712,15 +2711,29 @@ hscCompileCoreExpr hsc_env loc expr =
    2712 2711 
     hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
    2713 2712 
     hscCompileCoreExpr' hsc_env srcspan ds_expr = do
    2714 2713 
       {- Simplify it -}
    2715 
    -  -- Question: should we call SimpleOpt.simpleOptExpr here instead?
    2716 
    -  -- It is, well, simpler, and does less inlining etc.
    2717 2714 
       let dflags = hsc_dflags hsc_env
    2718 2715 
       let logger = hsc_logger hsc_env
    2719 
    -  let ic = hsc_IC hsc_env
    2720 
    -  let unit_env = hsc_unit_env hsc_env
    2721 
    -  let simplify_expr_opts = initSimplifyExprOpts dflags ic
    2722 2716
    2723 
    -  simpl_expr <- simplifyExpr logger (ue_eps unit_env) simplify_expr_opts ds_expr
    2717 
    +  let simpl_expr
    2718 
    +        -- Do less work under `-funoptimized-core-for-interpreter`,
    2719 
    +        -- use modified `dflags` that sets `-O0` here even if current
    2720 
    +        -- session enables `-O1` or above.
    2721 
    +        --
    2722 
    +        -- When generating bytecode for ghci via `hscParsedStmt`, we
    2723 
    +        -- still need to enable inlining! For `let foo = Foo ...`, the
    2724 
    +        -- ghci debugger expects `:print foo` to show `foo = <Foo> ...`
    2725 
    +        -- without forcing `foo` first, without inlining `foo`
    2726 
    +        -- would remain a top-level thunk instead of a datacon
    2727 
    +        -- closure. We can skip inlining for TH splices though.
    2728 
    +        | gopt Opt_UnoptimizedCoreForInterpreter dflags =
    2729 
    +            ( if srcspan == interactiveSrcSpan
    2730 
    +                then simpleOptExpr
    2731 
    +                else simpleOptExprNoInline
    2732 
    +            )
    2733 
    +              (initSimpleOpts $ updOptLevel 0 dflags)
    2734 
    +              ds_expr
    2735 
    +        | otherwise =
    2736 
    +            simpleOptExpr (initSimpleOpts dflags) ds_expr
    2724 2737
    2725 2738 
       -- Create a unique temporary binding
    2726 2739 
       --

  • compiler/GHC/Driver/Session/Inspect.hs
    ... ... @@ -133,7 +133,7 @@ availsToGlobalRdrEnv hsc_env mod avails
    133 133 
         imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
    134 134 
         decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
    135 135 
                              is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual,
    136 
    -                         is_dloc = srcLocSpan interactiveSrcLoc,
    136 
    +                         is_dloc = interactiveSrcSpan,
    137 137 
                              is_level = NormalLevel }
    138 138
    139 139 
     getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
    ... ... @@ -198,4 +198,3 @@ modInfoSafe = minf_safe
    198 198
    199 199 
     modInfoModBreaks :: ModuleInfo -> Maybe InternalModBreaks
    200 200 
     modInfoModBreaks = minf_modBreaks
    201 
    -

  • compiler/GHC/Types/SrcLoc.hs
    ... ... @@ -19,8 +19,6 @@ module GHC.Types.SrcLoc (
    19 19 
             leftmostColumn,
    20 20
    21 21 
             noSrcLoc,               -- "I'm sorry, I haven't a clue"
    22 
    -        generatedSrcLoc,        -- Code generated within the compiler
    23 
    -        interactiveSrcLoc,      -- Code from an interactive session
    24 22
    25 23 
             advanceSrcLoc,
    26 24 
             advanceBufPos,
    ... ... @@ -255,10 +253,8 @@ getBufPos (RealSrcLoc _ mbpos) = mbpos
    255 253 
     getBufPos (UnhelpfulLoc _) = Strict.Nothing
    256 254
    257 255 
     -- | Built-in "bad" 'SrcLoc' values for particular locations
    258 
    -noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
    256 
    +noSrcLoc :: SrcLoc
    259 257 
     noSrcLoc          = UnhelpfulLoc (fsLit "<no location info>")
    260 
    -generatedSrcLoc   = UnhelpfulLoc (fsLit "<compiler-generated code>")
    261 
    -interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive>")
    262 258
    263 259 
     -- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
    264 260 
     mkGeneralSrcLoc :: FastString -> SrcLoc

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help