[project @ 1998-03-08 22:44:44 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / SimplPgm.lhs

diff --git a/ghc/compiler/simplCore/SimplPgm.lhs b/ghc/compiler/simplCore/SimplPgm.lhs
index fc95fff..f3f2f7e 100644 (file)
--- a/ghc/compiler/simplCore/SimplPgm.lhs
+++ b/ghc/compiler/simplCore/SimplPgm.lhs
@@ -4,30 +4,32 @@
 \section[SimplPgm]{Interface to the simplifier}
 
 \begin{code}
-#include "HsVersions.h"
-
 module SimplPgm ( simplifyPgm ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
-import CmdLineOpts     ( opt_D_verbose_core2core,
-                         switchIsOn, SimplifierSwitch(..)
+import CmdLineOpts     ( opt_D_verbose_core2core, opt_D_dump_simpl_iterations,
+                         switchIsOn, SimplifierSwitch(..), SwitchResult
                        )
 import CoreSyn
 import CoreUnfold      ( SimpleUnfolding )
-import CoreUtils       ( substCoreExpr )
-import Id              ( mkIdEnv, lookupIdEnv, SYN_IE(IdEnv),
-                         GenId{-instance Ord3-}
+import Id              ( mkIdEnv, lookupIdEnv, IdEnv
                        )
 import Maybes          ( catMaybes )
 import OccurAnal       ( occurAnalyseBinds )
-import Pretty          ( ppAboves, ppBesides, ppInt, ppChar, ppStr )
+import PprCore          ( pprCoreBinding ) -- added SOF
 import SimplEnv
 import SimplMonad
 import Simplify                ( simplTopBinds )
-import TyVar           ( nullTyVarEnv, SYN_IE(TyVarEnv) )
-import UniqSupply      ( thenUs, returnUs, mapUs, splitUniqSupply, SYN_IE(UniqSM) )
-import Util            ( isIn, isn'tIn, removeDups, pprTrace )
+import TyVar           ( TyVarEnv )
+import UniqSupply      ( thenUs, returnUs, mapUs, 
+                         splitUniqSupply, UniqSM,
+                         UniqSupply
+                        )
+import Util            ( isIn, isn'tIn, removeDups )
+import Outputable 
+
+import GlaExts         ( trace )
 \end{code}
 
 \begin{code}
@@ -41,14 +43,12 @@ simplifyPgm :: [CoreBinding]        -- input
                 SimplCount)    -- accumulated simpl stats
 
 simplifyPgm binds s_sw_chkr simpl_stats us
-  = case (splitUniqSupply us)               of { (s1, s2) ->
-    case (initSmpl s1 (simpl_pgm 0 1 binds)) of { ((pgm2, it_count, simpl_stats2), _) ->
-    (pgm2, it_count, combineSimplCounts simpl_stats simpl_stats2) }}
+  = --case (splitUniqSupply us)                     of { (s1, s2) ->
+    case (initSmpl us (simpl_pgm 0 1 binds)) of { ((pgm2, it_count, simpl_stats2), _) ->
+    (pgm2, it_count, combineSimplCounts simpl_stats simpl_stats2) }
   where
     simpl_switch_is_on  = switchIsOn s_sw_chkr
 
-    occur_anal = occurAnalyseBinds
-
     max_simpl_iterations = getSimplIntSwitch s_sw_chkr MaxSimplifierIterations
 
     simpl_pgm :: Int -> Int -> [CoreBinding] -> SmplM ([CoreBinding], Int, SimplCount)
@@ -57,7 +57,7 @@ simplifyPgm binds s_sw_chkr simpl_stats us
       =        -- find out what top-level binders are used,
        -- and prepare to unfold all the "simple" bindings
        let
-           tagged_pgm = occur_anal pgm simpl_switch_is_on
+           tagged_pgm = _scc_ "OccAnal" occurAnalyseBinds pgm simpl_switch_is_on
        in
              -- do the business
        simplTopBinds (nullSimplEnv s_sw_chkr) tagged_pgm `thenSmpl` \ new_pgm ->
@@ -68,10 +68,16 @@ simplifyPgm binds s_sw_chkr simpl_stats us
        simplCount                              `thenSmpl` \ r ->
        detailedSimplCount                      `thenSmpl` \ dr ->
        let
-           show_status = pprTrace "NewSimpl: " (ppAboves [
-               ppBesides [ppInt iterations, ppChar '/', ppInt max_simpl_iterations],
-               ppStr (showSimplCount dr)
--- DEBUG               , ppAboves (map (pprCoreBinding PprDebug) new_pgm)
+           show_status = pprTrace "Simplifer run: " (vcat [
+               hcat [ptext SLIT("iteration "), 
+                          int iterations, 
+                          ptext SLIT(" out of "), 
+                          int max_simpl_iterations],
+               text (showSimplCount dr),
+               if opt_D_dump_simpl_iterations then
+                       vcat (map (pprCoreBinding) new_pgm)
+               else
+                       empty
                ])
        in
 
@@ -81,10 +87,12 @@ simplifyPgm binds s_sw_chkr simpl_stats us
         else id)
 
        (let stop_now = r == n {-nothing happened-}
-                    || (if iterations > max_simpl_iterations then
+                    || (if iterations >= max_simpl_iterations then
                            (if max_simpl_iterations > 1 {-otherwise too boring-} then
                                trace
-                               ("NOTE: Simplifier still going after "++show max_simpl_iterations++" iterations; bailing out.")
+                               ("NOTE: Simplifier still going after " ++ 
+                                 show max_simpl_iterations ++ 
+                                 " iterations; bailing out.")
                             else id)
                            True
                         else