X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FMain.hs;h=ec5a116894830d0149712c225b5e5ef6cf394bcf;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=a9c4122fe49c1c8931aa96afe0ed38b13e56909a;hpb=78b72ed1e0ffab668e0d4bb31657942970515e4f;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index a9c4122..ec5a116 100644
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -14,7 +14,7 @@ module Main (main) where
 -- The official GHC API
 import qualified GHC
 import GHC		( Session, DynFlags(..), GhcMode(..), HscTarget(..),
-			  LoadHowMuch(..) )
+			  LoadHowMuch(..), dopt, DynFlag(..) )
 import CmdLineParser
 
 -- Implementations of the various modes (--show-iface, mkdependHS. etc.)
@@ -31,9 +31,12 @@ import Config		( cProjectVersion, cBooterVersion, cProjectName )
 import Packages		( dumpPackages, initPackages )
 import DriverPhases	( Phase(..), isSourceFilename, anyHsc,
 			  startPhase, isHaskellSrcFilename )
-import StaticFlags	( staticFlags, v_Ld_inputs )
+import StaticFlags	( staticFlags, v_Ld_inputs, parseStaticFlags )
 import DynFlags         ( defaultDynFlags )
 import BasicTypes	( failed )
+import ErrUtils		( Message, debugTraceMsg, putMsg )
+import FastString	( getFastStringTable, isZEncoded, hasZEncoding )
+import Outputable
 import Util
 import Panic
 
@@ -62,7 +65,7 @@ main =
   GHC.defaultErrorHandler defaultDynFlags $ do
   
   argv0 <- getArgs
-  argv1 <- GHC.init argv0
+  argv1 <- parseStaticFlags =<< GHC.initFromArgs argv0
 
   -- 2. Parse the "mode" flags (--make, --interactive etc.)
   (cli_mode, argv2) <- parseModeFlags argv1
@@ -148,6 +151,7 @@ main =
 	DoInteractive   -> interactiveUI session srcs Nothing
 	DoEval expr     -> interactiveUI session srcs (Just expr)
 
+  dumpFinalStats dflags
   exitWith ExitSuccess
 
 #ifndef GHCI
@@ -240,7 +244,7 @@ checkOptions cli_mode dflags srcs objs = do
 -- 
 verifyOutputFiles :: DynFlags -> IO ()
 verifyOutputFiles dflags = do
-  let odir = outputDir dflags
+  let odir = objectDir dflags
   when (isJust odir) $ do
      let dir = fromJust odir
      flg <- doesDirectoryExist dir
@@ -405,7 +409,12 @@ showBanner cli_mode dflags = do
 	do hPutStr stderr "Glasgow Haskell Compiler, Version "
  	   hPutStr stderr cProjectVersion
 	   hPutStr stderr ", for Haskell 98, compiled by GHC version "
+#ifdef GHCI
+	   -- GHCI is only set when we are bootstrapping...
+ 	   hPutStrLn stderr cProjectVersion
+#else
 	   hPutStrLn stderr cBooterVersion
+#endif
 
 showVersion :: IO ()
 showVersion = do
@@ -422,8 +431,43 @@ showGhcUsage cli_mode = do
   exitWith ExitSuccess
   where
      dump ""	      = return ()
-     dump ('$':'$':s) = hPutStr stderr progName >> dump s
-     dump (c:s)	      = hPutChar stderr c >> dump s
+     dump ('$':'$':s) = putStr progName >> dump s
+     dump (c:s)	      = putChar c >> dump s
+
+dumpFinalStats :: DynFlags -> IO ()
+dumpFinalStats dflags = 
+  when (dopt Opt_D_faststring_stats dflags) $ dumpFastStringStats dflags
+
+dumpFastStringStats :: DynFlags -> IO ()
+dumpFastStringStats dflags = do
+  buckets <- getFastStringTable
+  let (entries, longest, is_z, has_z) = countFS 0 0 0 0 buckets
+      msg = text "FastString stats:" $$
+	    nest 4 (vcat [text "size:           " <+> int (length buckets),
+			  text "entries:        " <+> int entries,
+			  text "longest chain:  " <+> int longest,
+			  text "z-encoded:      " <+> (is_z `pcntOf` entries),
+			  text "has z-encoding: " <+> (has_z `pcntOf` entries)
+			 ])
+	-- we usually get more "has z-encoding" than "z-encoded", because
+	-- when we z-encode a string it might hash to the exact same string,
+	-- which will is not counted as "z-encoded".  Only strings whose
+	-- Z-encoding is different from the original string are counted in
+	-- the "z-encoded" total.
+  putMsg dflags msg
+  where
+   x `pcntOf` y = int ((x * 100) `quot` y) <> char '%'
+  
+countFS entries longest is_z has_z [] = (entries, longest, is_z, has_z)
+countFS entries longest is_z has_z (b:bs) = 
+  let
+	len = length b
+	longest' = max len longest
+	entries' = entries + len
+	is_zs = length (filter isZEncoded b)
+	has_zs = length (filter hasZEncoding b)
+  in
+	countFS entries' longest' (is_z + is_zs) (has_z + has_zs) bs
 
 -- -----------------------------------------------------------------------------
 -- Util