X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FFastString.lhs;h=c6dac8ff428d083c2a38a73ec28bd0dd30862993;hp=ac79b5b75fa87f48dd316fca072119e05938e379;hb=edc0bafd3fcd01b85a2e8894e5dfe149eb0e0857;hpb=e761a777f2440ca1b8d8b40848cc5aa30d889ff6

diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index ac79b5b..c6dac8f 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -2,26 +2,39 @@
 % (c) The University of Glasgow, 1997-2006
 %
 \begin{code}
-{-
-FastString:     A compact, hash-consed, representation of character strings.
-                Comparison is O(1), and you can get a Unique from them.
-                Generated by fsLit
-                Turn into SDoc with Outputable.ftext
-
-LitString:      Just a wrapper for the Addr# of a C string (Ptr CChar).
-                Practically no operations
-                Outputing them is fast
-                Generated by sLit
-                Turn into SDoc with Outputable.ptext
-
-Use LitString unless you want the facilities of FastString
--}
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS -fno-warn-unused-imports #-}
+-- XXX GHC 6.9 seems to be confused by unpackCString# being used only in
+--     a RULE
+
+{-# OPTIONS_GHC -O -funbox-strict-fields #-}
+-- We always optimise this, otherwise performance of a non-optimised
+-- compiler is severely affected
+
+-- |
+-- There are two principal string types used internally by GHC:
+--
+-- 'FastString':
+--               * A compact, hash-consed, representation of character strings.
+--               * Comparison is O(1), and you can get a 'Unique.Unique' from them.
+--               * Generated by 'fsLit'.
+--               * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.
+--
+-- 'LitString':
+--               * Just a wrapper for the @Addr#@ of a C string (@Ptr CChar@).
+--               * Practically no operations.
+--               * Outputing them is fast.
+--               * Generated by 'sLit'.
+--               * Turn into 'Outputable.SDoc' with 'Outputable.ptext'
+--
+-- Use 'LitString' unless you want the facilities of 'FastString'.
 module FastString
        (
         -- * FastStrings
         FastString(..),     -- not abstract, for now.
 
         -- ** Construction
+        fsLit,
         mkFastString,
         mkFastStringBytes,
         mkFastStringByteList,
@@ -60,17 +73,19 @@ module FastString
 
         -- * LitStrings
         LitString,
+        
+        -- ** Construction
+        sLit,
 #if defined(__GLASGOW_HASKELL__)
         mkLitString#,
 #endif
         mkLitString,
+        
+        -- ** Deconstruction
         unpackLitString,
-        strLength,
-
-        ptrStrLength,
-
-        sLit,
-        fsLit,
+        
+        -- ** Operations
+        lengthLS
        ) where
 
 #include "HsVersions.h"
@@ -79,17 +94,20 @@ import Encoding
 import FastTypes
 import FastFunctions
 import Panic
+import Util
 
-import Foreign
+import Foreign hiding   ( unsafePerformIO )
 import Foreign.C
 import GHC.Exts
 import System.IO
 import System.IO.Unsafe ( unsafePerformIO )
+import Data.Data
 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
 import Data.Maybe       ( isJust )
 import Data.Char        ( ord )
 
-import GHC.IOBase       ( IO(..) )
+import GHC.IO ( IO(..) )
+
 import GHC.Ptr          ( Ptr(..) )
 #if defined(__GLASGOW_HASKELL__)
 import GHC.Base         ( unpackCString# )
@@ -114,7 +132,7 @@ data FastString = FastString {
       n_chars :: {-# UNPACK #-} !Int, -- number of chars
       buf     :: {-# UNPACK #-} !(ForeignPtr Word8),
       enc     :: FSEncoding
-  }
+  } deriving Typeable
 
 data FSEncoding
     -- including strings that don't need any encoding
@@ -140,6 +158,12 @@ instance Ord FastString where
 instance Show FastString where
    show fs = show (unpackFS fs)
 
+instance Data FastString where
+  -- don't traverse?
+  toConstr _   = abstractConstr "FastString"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "FastString"
+
 cmpFS :: FastString -> FastString -> Ordering
 cmpFS (FastString u1 l1 _ buf1 _) (FastString u2 l2 _ buf2 _) =
   if u1 == u2 then EQ else
@@ -366,9 +390,9 @@ hashStr (Ptr a#) (I# len#) = loop 0# 0#
    where
     loop h n | n GHC.Exts.==# len# = I# h
              | otherwise  = loop h2 (n GHC.Exts.+# 1#)
-          where c = ord# (indexCharOffAddr# a# n)
-                h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#`
-                     hASH_TBL_SIZE#
+          where !c = ord# (indexCharOffAddr# a# n)
+                !h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#`
+                      hASH_TBL_SIZE#
 
 -- -----------------------------------------------------------------------------
 -- Operations
@@ -377,12 +401,12 @@ hashStr (Ptr a#) (I# len#) = loop 0# 0#
 lengthFS :: FastString -> Int
 lengthFS f = n_chars f
 
--- | Returns 'True' if the 'FastString' is Z-encoded
+-- | Returns @True@ if the 'FastString' is Z-encoded
 isZEncoded :: FastString -> Bool
 isZEncoded fs | ZEncoded <- enc fs = True
               | otherwise          = False
 
--- | Returns 'True' if this 'FastString' is not Z-encoded but already has
+-- | Returns @True@ if this 'FastString' is not Z-encoded but already has
 -- a Z-encoding cached (used in producing stats).
 hasZEncoding :: FastString -> Bool
 hasZEncoding (FastString _ _ _ _ enc) =
@@ -393,11 +417,11 @@ hasZEncoding (FastString _ _ _ _ enc) =
         m <- readIORef ref
         return (isJust m)
 
--- | Returns 'True' if the 'FastString' is empty
+-- | Returns @True@ if the 'FastString' is empty
 nullFS :: FastString -> Bool
 nullFS f  =  n_bytes f == 0
 
--- | unpacks and decodes the FastString
+-- | Unpacks and decodes the FastString
 unpackFS :: FastString -> String
 unpackFS (FastString _ n_bytes _ buf enc) =
   inlinePerformIO $ withForeignPtr buf $ \ptr ->
@@ -410,7 +434,7 @@ bytesFS (FastString _ n_bytes _ buf _) =
   inlinePerformIO $ withForeignPtr buf $ \ptr ->
     peekArray n_bytes ptr
 
--- | returns a Z-encoded version of a 'FastString'.  This might be the
+-- | Returns a Z-encoded version of a 'FastString'.  This might be the
 -- original, if it was already Z-encoded.  The first time this
 -- function is applied to a particular 'FastString', the results are
 -- memoized.
@@ -430,7 +454,18 @@ zEncodeFS fs@(FastString _ _ _ _ enc) =
             return efs
 
 appendFS :: FastString -> FastString -> FastString
-appendFS fs1 fs2 = mkFastString (unpackFS fs1 ++ unpackFS fs2)
+appendFS fs1 fs2 =
+  inlinePerformIO $ do
+    r <- mallocForeignPtrBytes len
+    withForeignPtr r $ \ r' -> do
+    withForeignPtr (buf fs1) $ \ fs1Ptr -> do
+    withForeignPtr (buf fs2) $ \ fs2Ptr -> do
+        copyBytes r' fs1Ptr len1
+        copyBytes (advancePtr r' len1) fs2Ptr len2
+        mkFastStringForeignPtr r' r len
+  where len  = len1 + len2
+        len1 = lengthFS fs1
+        len2 = lengthFS fs2
 
 concatFS :: [FastString] -> FastString
 concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better
@@ -537,8 +572,8 @@ unpackLitString p_ = case pUnbox p_ of
       ch -> if ch `eqFastChar` _CLIT('\0')
             then [] else cBox ch : unpack (n +# _ILIT(1))
 
-strLength :: LitString -> Int
-strLength = ptrStrLength
+lengthLS :: LitString -> Int
+lengthLS = ptrStrLength
 
 -- for now, use a simple String representation
 --no, let's not do that right now - it's work in other places
@@ -551,8 +586,8 @@ mkLitString = id
 unpackLitString :: LitString -> String
 unpackLitString = id
 
-strLength :: LitString -> Int
-strLength = length
+lengthLS :: LitString -> Int
+lengthLS = length
 
 #endif