X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscStats.lhs;h=dcd85f85d996cbf6fc98b86d82401bfeea8d92fc;hb=8c1b6bd7ffb9ce97da7a72f9e102998df19b23a2;hp=4f53d0adc195d7342ebd361cc80e58bc3be65cbe;hpb=9e93335020e64a811dbbb223e1727c76933a93ae;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/HscStats.lhs b/ghc/compiler/main/HscStats.lhs
index 4f53d0a..dcd85f8 100644
--- a/ghc/compiler/main/HscStats.lhs
+++ b/ghc/compiler/main/HscStats.lhs
@@ -9,6 +9,7 @@ module HscStats ( ppSourceStats ) where
 #include "HsVersions.h"
 
 import HsSyn
+import TyCon		( DataConDetails(..) )
 import Outputable
 import Char		( isSpace )
 import Util             ( count )
@@ -33,7 +34,7 @@ ppSourceStats short (HsModule name version exports imports decls _ src_loc)
 		("  ImpAll         ", import_all),
 		("  ImpPartial     ", import_partial),
 		("  ImpHiding      ", import_hiding),
-		("FixityDecls      ", fixity_ds),
+		("FixityDecls      ", fixity_sigs),
 		("DefaultDecls     ", default_ds),
 	      	("TypeDecls        ", type_ds),
 	      	("DataDecls        ", data_ds),
@@ -63,7 +64,8 @@ ppSourceStats short (HsModule name version exports imports decls _ src_loc)
     
     trim ls     = takeWhile (not.isSpace) (dropWhile isSpace ls)
 
-    fixity_ds   = count (\ x -> case x of { FixD{} -> True; _ -> False}) decls
+    (fixity_sigs, bind_tys, _, bind_specs, bind_inlines) 
+	= count_sigs [d | SigD d <- decls]
 		-- NB: this omits fixity decls on local bindings and
 		-- in class decls.  ToDo
 
@@ -82,8 +84,8 @@ ppSourceStats short (HsModule name version exports imports decls _ src_loc)
     export_ds  	 = n_exports - export_ms
     export_all 	 = case exports of { Nothing -> 1; other -> 0 }
 
-    (val_bind_ds, fn_bind_ds, bind_tys, bind_specs, bind_inlines)
-	= count_binds (foldr ThenBinds EmptyBinds val_decls)
+    (val_bind_ds, fn_bind_ds)
+	= foldr add2 (0,0) (map count_monobinds val_decls)
 
     (import_no, import_qual, import_as, import_all, import_partial, import_hiding)
 	= foldr add6 (0,0,0,0,0,0) (map import_info imports)
@@ -94,28 +96,23 @@ ppSourceStats short (HsModule name version exports imports decls _ src_loc)
     (inst_method_ds, method_specs, method_inlines)
 	= foldr add3 (0,0,0) (map inst_info inst_decls)
 
-
-    count_binds EmptyBinds        = (0,0,0,0,0)
-    count_binds (ThenBinds b1 b2) = count_binds b1 `add5` count_binds b2
-    count_binds (MonoBind b sigs _) = case (count_monobinds b, count_sigs sigs) of
-				        ((vs,fs),(ts,_,ss,is)) -> (vs,fs,ts,ss,is)
-
-    count_monobinds EmptyMonoBinds	  	   = (0,0)
-    count_monobinds (AndMonoBinds b1 b2)  	   = count_monobinds b1 `add2` count_monobinds b2
-    count_monobinds (PatMonoBind (VarPatIn n) r _) = (1,0)
-    count_monobinds (PatMonoBind p r _)            = (0,1)
-    count_monobinds (FunMonoBind f _ m _)          = (0,1)
+    count_monobinds EmptyMonoBinds	  	 = (0,0)
+    count_monobinds (AndMonoBinds b1 b2)  	 = count_monobinds b1 `add2` count_monobinds b2
+    count_monobinds (PatMonoBind (VarPat n) r _) = (1,0)
+    count_monobinds (PatMonoBind p r _)          = (0,1)
+    count_monobinds (FunMonoBind f _ m _)        = (0,1)
 
     count_mb_monobinds (Just mbs) = count_monobinds mbs
     count_mb_monobinds Nothing	  = (0,0)
 
-    count_sigs sigs = foldr add4 (0,0,0,0) (map sig_info sigs)
+    count_sigs sigs = foldr add5 (0,0,0,0,0) (map sig_info sigs)
 
-    sig_info (Sig _ _ _)            = (1,0,0,0)
-    sig_info (ClassOpSig _ _ _ _)   = (0,1,0,0)
-    sig_info (SpecSig _ _ _)        = (0,0,1,0)
-    sig_info (InlineSig _ _ _ _)    = (0,0,0,1)
-    sig_info _                      = (0,0,0,0)
+    sig_info (FixSig _)		    = (1,0,0,0,0)
+    sig_info (Sig _ _ _)            = (0,1,0,0,0)
+    sig_info (ClassOpSig _ _ _ _)   = (0,0,1,0,0)
+    sig_info (SpecSig _ _ _)        = (0,0,0,1,0)
+    sig_info (InlineSig _ _ _ _)    = (0,0,0,0,1)
+    sig_info _                      = (0,0,0,0,0)
 
     import_info (ImportDecl _ _ qual as spec _)
 	= add6 (1, qual_info qual, as_info as, 0,0,0) (spec_info spec)
@@ -127,19 +124,19 @@ ppSourceStats short (HsModule name version exports imports decls _ src_loc)
     spec_info (Just (False, _)) = (0,0,0,0,1,0)
     spec_info (Just (True, _))  = (0,0,0,0,0,1)
 
-    data_info (TyData {tcdNCons = nconstrs, tcdDerivs = derivs})
-	= (nconstrs, case derivs of {Nothing -> 0; Just ds -> length ds})
+    data_info (TyData {tcdCons = DataCons cs, tcdDerivs = derivs})
+	= (length cs, case derivs of {Nothing -> 0; Just ds -> length ds})
     data_info other = (0,0)
 
     class_info decl@(ClassDecl {})
 	= case count_sigs (tcdSigs decl) of
-	    (_,classops,_,_) ->
+	    (_,_,classops,_,_) ->
 	       (classops, addpr (count_mb_monobinds (tcdMeths decl)))
     class_info other = (0,0)
 
     inst_info (InstDecl _ inst_meths inst_sigs _ _)
 	= case count_sigs inst_sigs of
-	    (_,_,ss,is) ->
+	    (_,_,_,ss,is) ->
 	       (addpr (count_monobinds inst_meths), ss, is)
 
     addpr :: (Int,Int) -> Int