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

Commits:

4 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
    
    ... ... @@ -2712,15 +2713,10 @@ hscCompileCoreExpr hsc_env loc expr =
    2712 2713
     hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
    
    2713 2714
     hscCompileCoreExpr' hsc_env srcspan ds_expr = do
    
    2714 2715
       {- Simplify it -}
    
    2715
    -  -- Question: should we call SimpleOpt.simpleOptExpr here instead?
    
    2716
    -  -- It is, well, simpler, and does less inlining etc.
    
    2717 2716
       let dflags = hsc_dflags hsc_env
    
    2718 2717
       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 2718
     
    
    2723
    -  simpl_expr <- simplifyExpr logger (ue_eps unit_env) simplify_expr_opts ds_expr
    
    2719
    +  let simpl_expr = simpleOptExpr (initSimpleOpts dflags) ds_expr
    
    2724 2720
     
    
    2725 2721
       -- Create a unique temporary binding
    
    2726 2722
       --