X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Futils%2FFastString.lhs;h=ea307799c424f6f164fbf1074f49a6c819e14750;hb=0f800dc9f3dc695cd06d0fdd7799a52c37241752;hp=28aa6b0f312bb71edf7b9bccdddc621318ac1497;hpb=1607c878b9e27ac836c178b2c441996127e5d3e9;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index 28aa6b0..ea30779 100644
--- 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