Commit 76e37427 authored by Simon Marlow's avatar Simon Marlow

add -dfaststring-stats to dump some stats about the FastString hash table

parent 3a4f9158
......@@ -115,6 +115,7 @@ data DynFlag
| Opt_D_dump_hi
| Opt_D_dump_hi_diffs
| Opt_D_dump_minimal_imports
| Opt_D_faststring_stats
| Opt_DoCoreLinting
| Opt_DoStgLinting
| Opt_DoCmmLinting
......@@ -899,6 +900,7 @@ dynamic_flags = [
, ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting))
, ( "dshow-passes", NoArg (do unSetDynFlag Opt_RecompChecking
setVerbosity "2") )
, ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats))
------ Machine dependant (-m<blah>) stuff ---------------------------
......
......@@ -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.)
......@@ -34,6 +34,9 @@ import DriverPhases ( Phase(..), isSourceFilename, anyHsc,
import StaticFlags ( staticFlags, v_Ld_inputs )
import DynFlags ( defaultDynFlags )
import BasicTypes ( failed )
import ErrUtils ( Message, debugTraceMsg, putMsg )
import FastString ( getFastStringTable, isZEncoded, hasZEncoding )
import Outputable
import Util
import Panic
......@@ -148,6 +151,7 @@ main =
DoInteractive -> interactiveUI session srcs Nothing
DoEval expr -> interactiveUI session srcs (Just expr)
dumpFinalStats dflags
exitWith ExitSuccess
#ifndef GHCI
......@@ -430,6 +434,41 @@ showGhcUsage cli_mode = do
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
......
......@@ -51,6 +51,10 @@ module FastString
-- ** Outputing
hPutFS,
-- ** Internal
getFastStringTable,
hasZEncoding,
-- * LitStrings
LitString,
mkLitString#,
......@@ -71,6 +75,7 @@ import System.IO.Unsafe ( unsafePerformIO )
import Control.Monad.ST ( stToIO )
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
import System.IO ( hPutBuf )
import Data.Maybe ( isJust )
import GHC.Arr ( STArray(..), newSTArray )
import GHC.IOBase ( IO(..) )
......@@ -343,6 +348,17 @@ isZEncoded :: FastString -> Bool
isZEncoded fs | ZEncoded <- enc fs = True
| otherwise = False
-- | Returns 'True' if this 'FastString' is not Z-encoded but already has
-- a Z-encoding cached (used in producing stats).
hasZEncoding :: FastString -> Bool
hasZEncoding fs@(FastString uid n_bytes _ fp enc) =
case enc of
ZEncoded -> False
UTF8Encoded ref ->
inlinePerformIO $ do
m <- readIORef ref
return (isJust m)
-- | Returns 'True' if the 'FastString' is empty
nullFS :: FastString -> Bool
nullFS f = n_bytes f == 0
......@@ -414,6 +430,15 @@ uniqueOfFS (FastString (I# u#) _ _ _ _) = u#
nilFS = mkFastString ""
-- -----------------------------------------------------------------------------
-- Stats
getFastStringTable :: IO [[FastString]]
getFastStringTable = do
tbl <- readIORef string_table
buckets <- mapM (lookupTbl tbl) [0..hASH_TBL_SIZE]
return buckets
-- -----------------------------------------------------------------------------
-- Outputting 'FastString's
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment