X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fstranal%2FStrictAnal.lhs;h=bac6b14ac8941785a7d15c57f2901c1edf9ffcd7;hb=17fdd8ad14910060688239d99fa12968276d4095;hp=032176a6e1dd116a7f865383e7dcff3684c8e709;hpb=95929be07d802527e15124d8d93c2b7ae5de4dd6;p=ghc-hetmet.git

diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs
index 032176a..bac6b14 100644
--- a/ghc/compiler/stranal/StrictAnal.lhs
+++ b/ghc/compiler/stranal/StrictAnal.lhs
@@ -11,21 +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		( idType, setIdStrictness, setInlinePragma, 
+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 UniqSupply       ( UniqSupply )
 import Util		( zipWith3Equal, stretchZipWith )
 import Outputable
+import FastTypes
 \end{code}
 
 %************************************************************************
@@ -79,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}
 
@@ -391,12 +391,12 @@ addDemandInfoToCaseBndr dmd str_env abs_env alts binder
 
 \begin{code}
 data SaStats
-  = SaStats FAST_INT FAST_INT	-- total/marked-demanded lambda-bound
-	    FAST_INT FAST_INT	-- total/marked-demanded case-bound
-	    FAST_INT FAST_INT	-- total/marked-demanded let-bound
+  = SaStats FastInt FastInt	-- total/marked-demanded lambda-bound
+	    FastInt FastInt	-- total/marked-demanded case-bound
+	    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
@@ -424,16 +424,22 @@ 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)) ->
-    ((), SaStats (tlam _ADD_ tot) (dlam _ADD_ demanded) tc dc tlet dlet) }
+  = 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)) ->
-    ((), SaStats tlam dlam (tc _ADD_ tot) (dc _ADD_ demanded) tlet dlet) }
+  = 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)) ->
-    ((), SaStats tlam dlam tc dc (tlet _ADD_ tot) (dlet _ADD_ 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)
   | isTyVar var = (tot, demanded)
@@ -444,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-}