2 % (c) The AQUA Project, Glasgow University, 1993-1996
4 \section[SimplPgm]{Interface to the simplifier}
7 #include "HsVersions.h"
9 module SimplPgm ( simplifyPgm ) where
13 import CmdLineOpts ( opt_D_verbose_core2core,
14 switchIsOn, SimplifierSwitch(..)
17 import CoreUnfold ( SimpleUnfolding )
18 import CoreUtils ( substCoreExpr )
19 import Id ( mkIdEnv, lookupIdEnv, SYN_IE(IdEnv),
20 GenId{-instance Ord3-}
22 import Maybes ( catMaybes )
23 import OccurAnal ( occurAnalyseBinds )
24 import Pretty ( ppAboves, ppBesides, ppInt, ppChar, ppStr )
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 )
34 simplifyPgm :: [CoreBinding] -- input
35 -> (SimplifierSwitch->SwitchResult)
36 -> SimplCount -- info about how many times
37 -- each transformation has occurred
39 -> ([CoreBinding], -- output
40 Int, -- info about how much happened
41 SimplCount) -- accumulated simpl stats
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) }}
48 simpl_switch_is_on = switchIsOn s_sw_chkr
50 occur_anal = occurAnalyseBinds
52 max_simpl_iterations = getSimplIntSwitch s_sw_chkr MaxSimplifierIterations
54 simpl_pgm :: Int -> Int -> [CoreBinding] -> SmplM ([CoreBinding], Int, SimplCount)
56 simpl_pgm n iterations pgm
57 = -- find out what top-level binders are used,
58 -- and prepare to unfold all the "simple" bindings
60 tagged_pgm = occur_anal pgm simpl_switch_is_on
63 simplTopBinds (nullSimplEnv s_sw_chkr) tagged_pgm `thenSmpl` \ new_pgm ->
65 -- Quit if we didn't actually do anything; otherwise,
66 -- try again (if suitable flags)
68 simplCount `thenSmpl` \ r ->
69 detailedSimplCount `thenSmpl` \ dr ->
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)
78 (if opt_D_verbose_core2core
79 || simpl_switch_is_on ShowSimplifierProgress
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
87 ("NOTE: Simplifier still going after "++show max_simpl_iterations++" iterations; bailing out.")
94 returnSmpl (new_pgm, iterations, dr)
96 simpl_pgm r (iterations + 1) new_pgm