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,
  14                           switchIsOn, SimplifierSwitch(..)
  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           ( ppAboves, ppBesides, ppInt, ppChar, ppStr )
  25 import SimplEnv
  26 import SimplMonad
  27 import Simplify         ( simplTopBinds )
  28 import TyVar            ( nullTyVarEnv, SYN_IE(TyVarEnv) )
  29 import UniqSupply       ( thenUs, returnUs, mapUs, splitUniqSupply, SYN_IE(UniqSM) )
  30 import Util             ( isIn, isn'tIn, removeDups, pprTrace )
  31 \end{code}
  32
  33 \begin{code}
  34 simplifyPgm :: [CoreBinding]    -- input
  35             -> (SimplifierSwitch->SwitchResult)
  36             -> SimplCount       -- info about how many times
  37                                 -- each transformation has occurred
  38             -> UniqSupply
  39             -> ([CoreBinding],  -- output
  40                  Int,           -- info about how much happened
  41                  SimplCount)    -- accumulated simpl stats
  42
  43 simplifyPgm binds s_sw_chkr simpl_stats us
  44   = case (splitUniqSupply us)                of { (s1, s2) ->
  45     case (initSmpl s1 (simpl_pgm 0 1 binds)) of { ((pgm2, it_count, simpl_stats2), _) ->
  46     (pgm2, it_count, combineSimplCounts simpl_stats simpl_stats2) }}
  47   where
  48     simpl_switch_is_on  = switchIsOn s_sw_chkr
  49
  50     occur_anal = occurAnalyseBinds
  51
  52     max_simpl_iterations = getSimplIntSwitch s_sw_chkr MaxSimplifierIterations
  53
  54     simpl_pgm :: Int -> Int -> [CoreBinding] -> SmplM ([CoreBinding], Int, SimplCount)
  55
  56     simpl_pgm n iterations pgm
  57       = -- find out what top-level binders are used,
  58         -- and prepare to unfold all the "simple" bindings
  59         let
  60             tagged_pgm = occur_anal pgm simpl_switch_is_on
  61         in
  62               -- do the business
  63         simplTopBinds (nullSimplEnv s_sw_chkr) tagged_pgm `thenSmpl` \ new_pgm ->
  64
  65               -- Quit if we didn't actually do anything; otherwise,
  66               -- try again (if suitable flags)
  67
  68         simplCount                              `thenSmpl` \ r ->
  69         detailedSimplCount                      `thenSmpl` \ dr ->
  70         let
  71             show_status = pprTrace "NewSimpl: " (ppAboves [
  72                 ppBesides [ppInt iterations, ppChar '/', ppInt max_simpl_iterations],
  73                 ppStr (showSimplCount dr)
  74 --DEBUG:        , ppAboves (map (pprCoreBinding PprDebug) new_pgm)
  75                 ])
  76         in
  77
  78         (if opt_D_verbose_core2core
  79          || simpl_switch_is_on  ShowSimplifierProgress
  80          then show_status
  81          else id)
  82
  83         (let stop_now = r == n {-nothing happened-}
  84                      || (if iterations > max_simpl_iterations then
  85                             (if max_simpl_iterations > 1 {-otherwise too boring-} then
  86                                 trace
  87                                 ("NOTE: Simplifier still going after "++show max_simpl_iterations++" iterations; bailing out.")
  88                              else id)
  89                             True
  90                          else
  91                             False)
  92         in
  93         if stop_now then
  94             returnSmpl (new_pgm, iterations, dr)
  95         else
  96             simpl_pgm r (iterations + 1) new_pgm
  97         )
  98 \end{code}
  99