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

[ghc-hetmet.git] / ghc / compiler / utils / FastString.lhs

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index 134bb95..4d432e6 100644 (file)
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -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
@@ -415,6 +431,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
 
 -- |Outputs a 'FastString' with /no decoding at all/, that is, you
@@ -455,6 +480,7 @@ pokeCAString ptr str =
   go str 0
 
 #if __GLASGOW_HASKELL__ < 600
+
 mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
 mallocForeignPtrBytes n = do
   r <- mallocBytes n
@@ -464,5 +490,10 @@ foreign import ccall unsafe "stdlib.h free"
   finalizerFree :: Ptr a -> IO ()
 
 peekCAStringLen = peekCStringLen
+
+#elif __GLASGOW_HASKELL__ <= 602
+
+peekCAStringLen = peekCStringLen
+
 #endif
 \end{code}