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