[project @ 2001-06-28 08:36:30 by simonpj]

[ghc-hetmet.git] / ghc / compiler / stranal / StrictAnal.lhs

diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs
index 8e87ba7..bac6b14 100644 (file)
--- a/ghc/compiler/stranal/StrictAnal.lhs
+++ b/ghc/compiler/stranal/StrictAnal.lhs
@@ -11,20 +11,21 @@ module StrictAnal ( saBinds ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts     ( opt_D_dump_stranal, opt_D_dump_simpl_stats,  opt_D_verbose_core2core )
+import CmdLineOpts     ( DynFlags, DynFlag(..) )
 import CoreSyn
 import Id              ( setIdStrictness, setInlinePragma, 
                          idDemandInfo, setIdDemandInfo, isBottomingId,
                          Id
                        )
 import IdInfo          ( neverInlinePrag )
-import CoreLint                ( beginPass, endPass )
-import ErrUtils                ( dumpIfSet )
+import CoreLint                ( showPass, endPass )
+import ErrUtils                ( dumpIfSet_dyn )
 import SaAbsInt
 import SaLib
 import Demand          ( Demand, wwStrict, isStrict, isLazy )
 import Util            ( zipWith3Equal, stretchZipWith )
 import Outputable
+import FastTypes
 \end{code}
 
 %************************************************************************
@@ -78,23 +79,23 @@ worker-wrapper pass can use this info to create wrappers and
 strict workers.
 
 \begin{code}
-saBinds ::[CoreBind]
-          -> IO [CoreBind]
+saBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
 
-saBinds binds
+saBinds dflags binds
   = do {
-       beginPass "Strictness analysis";
+       showPass dflags "Strictness analysis";
 
        -- Mark each binder with its strictness
 #ifndef OMIT_STRANAL_STATS
        let { (binds_w_strictness, sa_stats) = saTopBinds binds nullSaStats };
-       dumpIfSet opt_D_dump_simpl_stats "Strictness analysis statistics"
+       dumpIfSet_dyn dflags Opt_D_dump_simpl_stats "Strictness analysis statistics"
                  (pp_stats sa_stats);
 #else
        let { binds_w_strictness = saTopBindsBinds binds };
 #endif
 
-       endPass "Strictness analysis" (opt_D_dump_stranal || opt_D_verbose_core2core) binds_w_strictness
+       endPass dflags "Strictness analysis" Opt_D_dump_stranal
+               binds_w_strictness
     }
 \end{code}
 
@@ -395,7 +396,7 @@ data SaStats
            FastInt FastInt     -- total/marked-demanded let-bound
                                -- (excl. top-level; excl. letrecs)
 
-nullSaStats = SaStats ILIT(0) ILIT(0) ILIT(0) ILIT(0) ILIT(0) ILIT(0)
+nullSaStats = SaStats (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0)
 
 thenSa       :: SaM a -> (a -> SaM b) -> SaM b
 thenSa_              :: SaM a -> SaM b -> SaM b
@@ -423,15 +424,21 @@ thenSa_ expr cont stats
 returnSa x stats = (x, stats)
 
 tickLambda var (SaStats tlam dlam tc dc tlet dlet)
-  = case (tick_demanded var (0,0)) of { (IBOX(tot), IBOX(demanded)) ->
+  = case (tick_demanded var (0,0)) of { (totB, demandedB) ->
+    let tot = iUnbox totB ; demanded = iUnbox demandedB 
+    in
     ((), SaStats (tlam +# tot) (dlam +# demanded) tc dc tlet dlet) }
 
 tickCases vars (SaStats tlam dlam tc dc tlet dlet)
-  = case (foldr tick_demanded (0,0) vars) of { (IBOX(tot), IBOX(demanded)) ->
+  = case (foldr tick_demanded (0,0) vars) of { (totB, demandedB) ->
+    let tot = iUnbox totB ; demanded = iUnbox demandedB 
+    in
     ((), SaStats tlam dlam (tc +# tot) (dc +# demanded) tlet dlet) }
 
 tickLet var (SaStats tlam dlam tc dc tlet dlet)
-  = case (tick_demanded var (0,0))        of { (IBOX(tot),IBOX(demanded)) ->
+  = case (tick_demanded var (0,0))        of { (totB, demandedB) ->
+    let tot = iUnbox totB ; demanded = iUnbox demandedB 
+    in
     ((), SaStats tlam dlam tc dc (tlet +# tot) (dlet +# demanded)) }
 
 tick_demanded var (tot, demanded)
@@ -443,9 +450,9 @@ tick_demanded var (tot, demanded)
      else demanded)
 
 pp_stats (SaStats tlam dlam tc dc tlet dlet)
-      = hcat [ptext SLIT("Lambda vars: "), int IBOX(dlam), char '/', int IBOX(tlam),
-                   ptext SLIT("; Case vars: "), int IBOX(dc),   char '/', int IBOX(tc),
-                   ptext SLIT("; Let vars: "),  int IBOX(dlet), char '/', int IBOX(tlet)
+      = hcat [ptext SLIT("Lambda vars: "), int (iBox dlam), char '/', int (iBox tlam),
+             ptext SLIT("; Case vars: "), int (iBox dc),   char '/', int (iBox tc),
+             ptext SLIT("; Let vars: "),  int (iBox dlet), char '/', int (iBox tlet)
        ]
 
 #else {-OMIT_STRANAL_STATS-}