X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fstranal%2FStrictAnal.lhs;h=2218a6a41a4c3a7df3c8161505e578a0d4ff0795;hb=f6cd95ff9a2bddbd78682dcd9287aec7d152cc13;hp=15520cbec9d5534a2321888c5f552e5898cee062;hpb=ff755dd9a0a0ad2f106c323852553ea247f16141;p=ghc-hetmet.git

diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs
index 15520cb..2218a6a 100644
--- 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,28 @@ worker-wrapper pass can use this info to create wrappers and
 strict workers.
 
 \begin{code}
-saBinds ::[CoreBind]
-	   -> IO [CoreBind]
+saBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
+#ifndef DEBUG
+-- Omit strictness analyser if DEBUG is off
 
-saBinds binds
+saBinds dflags binds = return binds
+
+#else
+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}
 
@@ -390,12 +396,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
@@ -423,16 +429,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)
@@ -443,9 +455,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-}
@@ -476,4 +488,5 @@ sequenceSa []     = returnSa []
 sequenceSa (m:ms) = m		  `thenSa` \ r ->
 		    sequenceSa ms `thenSa` \ rs ->
 		    returnSa (r:rs)
+#endif /* DEBUG */
 \end{code}