ghc/compiler/simplCore/SimplPgm.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1996
   3 %
   4 \section[SimplPgm]{Interface to the simplifier}
   5
   6 \begin{code}
   7 module SimplPgm ( simplifyPgm ) where
   8
   9 #include "HsVersions.h"
  10
  11 import CmdLineOpts      ( opt_D_verbose_core2core, opt_D_dump_simpl_iterations,
  12                           switchIsOn, SimplifierSwitch(..), SwitchResult
  13                         )
  14 import CoreSyn
  15 import CoreUnfold       ( SimpleUnfolding )
  16 import CoreUtils        ( substCoreExpr )
  17 import Id               ( mkIdEnv, lookupIdEnv, IdEnv
  18                         )
  19 import Maybes           ( catMaybes )
  20 import OccurAnal        ( occurAnalyseBinds )
  21 import PprCore          ( pprCoreBinding ) -- added SOF
  22 import SimplEnv
  23 import SimplMonad
  24 import Simplify         ( simplTopBinds )
  25 import TyVar            ( TyVarEnv )
  26 import UniqSupply       ( thenUs, returnUs, mapUs,
  27                           splitUniqSupply, UniqSM,
  28                           UniqSupply
  29                          )
  30 import Util             ( isIn, isn'tIn, removeDups )
  31 import Outputable
  32
  33 import GlaExts          ( trace )
  34 \end{code}
  35
  36 \begin{code}
  37 simplifyPgm :: [CoreBinding]    -- input
  38             -> (SimplifierSwitch->SwitchResult)
  39             -> SimplCount       -- info about how many times
  40                                 -- each transformation has occurred
  41             -> UniqSupply
  42             -> ([CoreBinding],  -- output
  43                  Int,           -- info about how much happened
  44                  SimplCount)    -- accumulated simpl stats
  45
  46 simplifyPgm binds s_sw_chkr simpl_stats us
  47   = --case (splitUniqSupply us)              of { (s1, s2) ->
  48     case (initSmpl us (simpl_pgm 0 1 binds)) of { ((pgm2, it_count, simpl_stats2), _) ->
  49     (pgm2, it_count, combineSimplCounts simpl_stats simpl_stats2) }
  50   where
  51     simpl_switch_is_on  = switchIsOn s_sw_chkr
  52
  53     max_simpl_iterations = getSimplIntSwitch s_sw_chkr MaxSimplifierIterations
  54
  55     simpl_pgm :: Int -> Int -> [CoreBinding] -> SmplM ([CoreBinding], Int, SimplCount)
  56
  57     simpl_pgm n iterations pgm
  58       = -- find out what top-level binders are used,
  59         -- and prepare to unfold all the "simple" bindings
  60         let
  61             tagged_pgm = _scc_ "OccAnal" occurAnalyseBinds pgm simpl_switch_is_on
  62         in
  63               -- do the business
  64         simplTopBinds (nullSimplEnv s_sw_chkr) tagged_pgm `thenSmpl` \ new_pgm ->
  65
  66               -- Quit if we didn't actually do anything; otherwise,
  67               -- try again (if suitable flags)
  68
  69         simplCount                              `thenSmpl` \ r ->
  70         detailedSimplCount                      `thenSmpl` \ dr ->
  71         let
  72             show_status = pprTrace "Simplifer run: " (vcat [
  73                 hcat [ptext SLIT("iteration "),
  74                            int iterations,
  75                            ptext SLIT(" out of "),
  76                            int max_simpl_iterations],
  77                 text (showSimplCount dr),
  78                 if opt_D_dump_simpl_iterations then
  79                         vcat (map (pprCoreBinding) new_pgm)
  80                 else
  81                         empty
  82                 ])
  83         in
  84
  85         (if opt_D_verbose_core2core
  86          || simpl_switch_is_on  ShowSimplifierProgress
  87          then show_status
  88          else id)
  89
  90         (let stop_now = r == n {-nothing happened-}
  91                      || (if iterations >= max_simpl_iterations then
  92                             (if max_simpl_iterations > 1 {-otherwise too boring-} then
  93                                 trace
  94                                 ("NOTE: Simplifier still going after " ++
  95                                   show max_simpl_iterations ++
  96                                   " iterations; bailing out.")
  97                              else id)
  98                             True
  99                          else
 100                             False)
 101         in
 102         if stop_now then
 103             returnSmpl (new_pgm, iterations, dr)
 104         else
 105             simpl_pgm r (iterations + 1) new_pgm
 106         )
 107 \end{code}
 108