From c54f21debd86972824443fbc874597540fff70d0 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Mon, 18 Feb 2008 11:02:41 +0000 Subject: [PATCH] Whitespace only --- compiler/utils/FastString.lhs | 251 +++++++++++++++++++++-------------------- 1 file changed, 126 insertions(+), 125 deletions(-) diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index a22cae0..c095d6f 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -10,72 +10,72 @@ -- for details {- -FastString: A compact, hash-consed, representation of character strings. - Comparison is O(1), and you can get a Unique from them. - Generated by the FSLIT macro - Turn into SDoc with Outputable.ftext +FastString: A compact, hash-consed, representation of character strings. + Comparison is O(1), and you can get a Unique from them. + Generated by the FSLIT macro + 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 the SLIT macro - Turn into SDoc with Outputable.ptext +LitString: Just a wrapper for the Addr# of a C string (Ptr CChar). + Practically no operations + Outputing them is fast + Generated by the SLIT macro + Turn into SDoc with Outputable.ptext Use LitString unless you want the facilities of FastString -} module FastString ( - -- * FastStrings - FastString(..), -- not abstract, for now. + -- * FastStrings + FastString(..), -- not abstract, for now. - -- ** Construction + -- ** Construction mkFastString, - mkFastStringBytes, + mkFastStringBytes, mkFastStringByteList, - mkFastStringForeignPtr, + mkFastStringForeignPtr, #if defined(__GLASGOW_HASKELL__) - mkFastString#, + mkFastString#, #endif - mkZFastString, - mkZFastStringBytes, + mkZFastString, + mkZFastStringBytes, - -- ** Deconstruction - unpackFS, -- :: FastString -> String - bytesFS, -- :: FastString -> [Word8] + -- ** Deconstruction + unpackFS, -- :: FastString -> String + bytesFS, -- :: FastString -> [Word8] - -- ** Encoding - isZEncoded, - zEncodeFS, + -- ** Encoding + isZEncoded, + zEncodeFS, - -- ** Operations + -- ** Operations uniqueOfFS, - lengthFS, - nullFS, - appendFS, + lengthFS, + nullFS, + appendFS, headFS, tailFS, - concatFS, + concatFS, consFS, - nilFS, + nilFS, - -- ** Outputing + -- ** Outputing hPutFS, - -- ** Internal - getFastStringTable, - hasZEncoding, + -- ** Internal + getFastStringTable, + hasZEncoding, - -- * LitStrings - LitString, + -- * LitStrings + LitString, #if defined(__GLASGOW_HASKELL__) - mkLitString#, + mkLitString#, #else - mkLitString, + mkLitString, #endif - unpackLitString, - strLength, + unpackLitString, + strLength, - ptrStrLength + ptrStrLength ) where -- This #define suppresses the "import FastString" that @@ -91,15 +91,15 @@ import Foreign import Foreign.C import GHC.Exts 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 Data.Char ( ord ) +import Control.Monad.ST ( stToIO ) +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) +import System.IO ( hPutBuf ) +import Data.Maybe ( isJust ) +import Data.Char ( ord ) import GHC.ST -import GHC.IOBase ( IO(..) ) -import GHC.Ptr ( Ptr(..) ) +import GHC.IOBase ( IO(..) ) +import GHC.Ptr ( Ptr(..) ) #define hASH_TBL_SIZE 4091 #define hASH_TBL_SIZE_UNBOXED 4091# @@ -115,32 +115,32 @@ Z-encoding used by the compiler internally. -} data FastString = FastString { - uniq :: {-# UNPACK #-} !Int, -- unique id - n_bytes :: {-# UNPACK #-} !Int, -- number of bytes - n_chars :: {-# UNPACK #-} !Int, -- number of chars + uniq :: {-# UNPACK #-} !Int, -- unique id + n_bytes :: {-# UNPACK #-} !Int, -- number of bytes + n_chars :: {-# UNPACK #-} !Int, -- number of chars buf :: {-# UNPACK #-} !(ForeignPtr Word8), enc :: FSEncoding } data FSEncoding + -- including strings that don't need any encoding = ZEncoded - -- including strings that don't need any encoding + -- A UTF-8 string with a memoized Z-encoding | UTF8Encoded {-# UNPACK #-} !(IORef (Maybe FastString)) - -- A UTF-8 string with a memoized Z-encoding instance Eq FastString where f1 == f2 = uniq f1 == uniq f2 instance Ord FastString where - -- Compares lexicographically, not by unique + -- Compares lexicographically, not by unique a <= b = case cmpFS a b of { LT -> True; EQ -> True; GT -> False } - a < b = case cmpFS a b of { LT -> True; EQ -> False; GT -> False } + a < b = case cmpFS a b of { LT -> True; EQ -> False; GT -> False } a >= b = case cmpFS a b of { LT -> False; EQ -> True; GT -> True } - a > b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True } - max x y | x >= y = x - | otherwise = y - min x y | x <= y = x - | otherwise = y + a > b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True } + max x y | x >= y = x + | otherwise = y + min x y | x <= y = x + | otherwise = y compare a b = cmpFS a b instance Show FastString where @@ -162,7 +162,7 @@ unsafeMemcmp buf1 buf2 l = memcmp p1 p2 l #ifndef __HADDOCK__ -foreign import ccall unsafe "ghc_memcmp" +foreign import ccall unsafe "ghc_memcmp" memcmp :: Ptr a -> Ptr b -> Int -> IO Int #endif @@ -176,14 +176,14 @@ new @FastString@s then covertly does a lookup, re-using the @FastString@ if there was a hit. -} -data FastStringTable = +data FastStringTable = FastStringTable {-# UNPACK #-} !Int (MutableArray# RealWorld [FastString]) {-# NOINLINE string_table #-} string_table :: IORef FastStringTable -string_table = +string_table = unsafePerformIO $ do tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED [] s1# of (# s2#, arr# #) -> @@ -209,10 +209,10 @@ mkFastStringBytes ptr len = unsafePerformIO $ do let h = hashStr ptr len add_it ls = do - fs <- copyNewFastString uid ptr len - updTbl string_table ft h (fs:ls) - {- _trace ("new: " ++ show f_str) $ -} - return fs + fs <- copyNewFastString uid ptr len + updTbl string_table ft h (fs:ls) + {- _trace ("new: " ++ show f_str) $ -} + return fs -- lookup_result <- lookupTbl ft h case lookup_result of @@ -220,8 +220,8 @@ mkFastStringBytes ptr len = unsafePerformIO $ do ls -> do b <- bucket_match ls len ptr case b of - Nothing -> add_it ls - Just v -> {- _trace ("re-use: "++show v) $ -} return v + Nothing -> add_it ls + Just v -> {- _trace ("re-use: "++show v) $ -} return v mkZFastStringBytes :: Ptr Word8 -> Int -> FastString mkZFastStringBytes ptr len = unsafePerformIO $ do @@ -229,10 +229,10 @@ mkZFastStringBytes ptr len = unsafePerformIO $ do let h = hashStr ptr len add_it ls = do - fs <- copyNewZFastString uid ptr len - updTbl string_table ft h (fs:ls) - {- _trace ("new: " ++ show f_str) $ -} - return fs + fs <- copyNewZFastString uid ptr len + updTbl string_table ft h (fs:ls) + {- _trace ("new: " ++ show f_str) $ -} + return fs -- lookup_result <- lookupTbl ft h case lookup_result of @@ -240,8 +240,8 @@ mkZFastStringBytes ptr len = unsafePerformIO $ do ls -> do b <- bucket_match ls len ptr case b of - Nothing -> add_it ls - Just v -> {- _trace ("re-use: "++show v) $ -} return v + Nothing -> add_it ls + Just v -> {- _trace ("re-use: "++show v) $ -} return v -- | Create a 'FastString' from an existing 'ForeignPtr'; the difference -- between this and 'mkFastStringBytes' is that we don't have to copy @@ -253,10 +253,10 @@ mkFastStringForeignPtr ptr fp len = do let h = hashStr ptr len add_it ls = do - fs <- mkNewFastString uid ptr fp len - updTbl string_table ft h (fs:ls) - {- _trace ("new: " ++ show f_str) $ -} - return fs + fs <- mkNewFastString uid ptr fp len + updTbl string_table ft h (fs:ls) + {- _trace ("new: " ++ show f_str) $ -} + return fs -- lookup_result <- lookupTbl ft h case lookup_result of @@ -264,8 +264,8 @@ mkFastStringForeignPtr ptr fp len = do ls -> do b <- bucket_match ls len ptr case b of - Nothing -> add_it ls - Just v -> {- _trace ("re-use: "++show v) $ -} return v + Nothing -> add_it ls + Just v -> {- _trace ("re-use: "++show v) $ -} return v mkZFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString mkZFastStringForeignPtr ptr fp len = do @@ -274,10 +274,10 @@ mkZFastStringForeignPtr ptr fp len = do let h = hashStr ptr len add_it ls = do - fs <- mkNewZFastString uid ptr fp len - updTbl string_table ft h (fs:ls) - {- _trace ("new: " ++ show f_str) $ -} - return fs + fs <- mkNewZFastString uid ptr fp len + updTbl string_table ft h (fs:ls) + {- _trace ("new: " ++ show f_str) $ -} + return fs -- lookup_result <- lookupTbl ft h case lookup_result of @@ -285,48 +285,48 @@ mkZFastStringForeignPtr ptr fp len = do ls -> do b <- bucket_match ls len ptr case b of - Nothing -> add_it ls - Just v -> {- _trace ("re-use: "++show v) $ -} return v + Nothing -> add_it ls + Just v -> {- _trace ("re-use: "++show v) $ -} return v -- | Creates a UTF-8 encoded 'FastString' from a 'String' mkFastString :: String -> FastString -mkFastString str = +mkFastString str = inlinePerformIO $ do let l = utf8EncodedLength str buf <- mallocForeignPtrBytes l withForeignPtr buf $ \ptr -> do utf8EncodeString ptr str - mkFastStringForeignPtr ptr buf l + mkFastStringForeignPtr ptr buf l -- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@ mkFastStringByteList :: [Word8] -> FastString -mkFastStringByteList str = +mkFastStringByteList str = inlinePerformIO $ do let l = Prelude.length str buf <- mallocForeignPtrBytes l withForeignPtr buf $ \ptr -> do pokeArray (castPtr ptr) str - mkFastStringForeignPtr ptr buf l + mkFastStringForeignPtr ptr buf l -- | Creates a Z-encoded 'FastString' from a 'String' mkZFastString :: String -> FastString -mkZFastString str = +mkZFastString str = inlinePerformIO $ do let l = Prelude.length str buf <- mallocForeignPtrBytes l withForeignPtr buf $ \ptr -> do pokeCAString (castPtr ptr) str - mkZFastStringForeignPtr ptr buf l + mkZFastStringForeignPtr ptr buf l bucket_match [] _ _ = return Nothing bucket_match (v@(FastString _ l _ buf _):ls) len ptr | len == l = do - b <- cmpStringPrefix ptr buf len - if b then return (Just v) - else bucket_match ls len ptr - | otherwise = - bucket_match ls len ptr + b <- cmpStringPrefix ptr buf len + if b then return (Just v) + else bucket_match ls len ptr + | otherwise = + bucket_match ls len ptr mkNewFastString uid ptr fp len = do ref <- newIORef Nothing @@ -363,11 +363,12 @@ cmpStringPrefix ptr fp len = hashStr :: Ptr Word8 -> Int -> Int -- use the Addr to produce a hash value between 0 & m (inclusive) hashStr (Ptr a#) (I# len#) = loop 0# 0# - where + 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# + | 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# -- ----------------------------------------------------------------------------- -- Operations @@ -379,7 +380,7 @@ lengthFS f = n_chars f -- | Returns 'True' if the 'FastString' is Z-encoded isZEncoded :: FastString -> Bool isZEncoded fs | ZEncoded <- enc fs = True - | otherwise = False + | otherwise = False -- | Returns 'True' if this 'FastString' is not Z-encoded but already has -- a Z-encoding cached (used in producing stats). @@ -390,7 +391,7 @@ hasZEncoding fs@(FastString uid n_bytes _ fp enc) = UTF8Encoded ref -> inlinePerformIO $ do m <- readIORef ref - return (isJust m) + return (isJust m) -- | Returns 'True' if the 'FastString' is empty nullFS :: FastString -> Bool @@ -398,14 +399,14 @@ nullFS f = n_bytes f == 0 -- | unpacks and decodes the FastString unpackFS :: FastString -> String -unpackFS (FastString _ n_bytes _ buf enc) = +unpackFS (FastString _ n_bytes _ buf enc) = inlinePerformIO $ withForeignPtr buf $ \ptr -> case enc of - ZEncoded -> peekCAStringLen (castPtr ptr,n_bytes) - UTF8Encoded _ -> utf8DecodeString ptr n_bytes + ZEncoded -> peekCAStringLen (castPtr ptr,n_bytes) + UTF8Encoded _ -> utf8DecodeString ptr n_bytes bytesFS :: FastString -> [Word8] -bytesFS (FastString _ n_bytes _ buf enc) = +bytesFS (FastString _ n_bytes _ buf enc) = inlinePerformIO $ withForeignPtr buf $ \ptr -> peekArray n_bytes ptr @@ -422,11 +423,11 @@ zEncodeFS fs@(FastString uid n_bytes _ fp enc) = inlinePerformIO $ do m <- readIORef ref case m of - Just fs -> return fs - Nothing -> do + Just fs -> return fs + Nothing -> do let efs = mkZFastString (zEncodeString (unpackFS fs)) - writeIORef ref (Just efs) - return efs + writeIORef ref (Just efs) + return efs appendFS :: FastString -> FastString -> FastString appendFS fs1 fs2 = mkFastString (unpackFS fs1 ++ unpackFS fs2) @@ -435,25 +436,25 @@ concatFS :: [FastString] -> FastString concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better headFS :: FastString -> Char -headFS (FastString _ n_bytes _ buf enc) = +headFS (FastString _ n_bytes _ buf enc) = inlinePerformIO $ withForeignPtr buf $ \ptr -> do case enc of - ZEncoded -> do - w <- peek (castPtr ptr) - return (castCCharToChar w) - UTF8Encoded _ -> - return (fst (utf8DecodeChar ptr)) + ZEncoded -> do + w <- peek (castPtr ptr) + return (castCCharToChar w) + UTF8Encoded _ -> + return (fst (utf8DecodeChar ptr)) tailFS :: FastString -> FastString -tailFS (FastString _ n_bytes _ buf enc) = +tailFS (FastString _ n_bytes _ buf enc) = inlinePerformIO $ withForeignPtr buf $ \ptr -> do case enc of ZEncoded -> do - return $! mkZFastStringBytes (ptr `plusPtr` 1) (n_bytes - 1) + return $! mkZFastStringBytes (ptr `plusPtr` 1) (n_bytes - 1) UTF8Encoded _ -> do - let (_,ptr') = utf8DecodeChar ptr - let off = ptr' `minusPtr` ptr - return $! mkFastStringBytes (ptr `plusPtr` off) (n_bytes - off) + let (_,ptr') = utf8DecodeChar ptr + let off = ptr' `minusPtr` ptr + return $! mkFastStringBytes (ptr `plusPtr` off) (n_bytes - off) consFS :: Char -> FastString -> FastString consFS c fs = mkFastString (c : unpackFS fs) @@ -552,7 +553,7 @@ strLength = length -- ----------------------------------------------------------------------------- -- under the carpet -foreign import ccall unsafe "ghc_strlen" +foreign import ccall unsafe "ghc_strlen" ptrStrLength :: Ptr Word8 -> Int -- NB. does *not* add a '\0'-terminator. @@ -561,8 +562,8 @@ foreign import ccall unsafe "ghc_strlen" pokeCAString :: Ptr CChar -> String -> IO () pokeCAString ptr str = let - go [] n = return () - go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) + go [] n = return () + go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) in go str 0 -- 1.7.10.4