diff options
Diffstat (limited to 'compiler/utils/FastString.hs')
| -rw-r--r-- | compiler/utils/FastString.hs | 35 |
1 files changed, 17 insertions, 18 deletions
diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs index f16b32779f..6ca3043668 100644 --- a/compiler/utils/FastString.hs +++ b/compiler/utils/FastString.hs @@ -18,7 +18,7 @@ -- -- ['LitString'] -- --- * Just a wrapper for the @Addr#@ of a C string (@Ptr CChar@). +-- * Pointer and size of a Latin-1 encoded string. -- * Practically no operations. -- * Outputing them is fast. -- * Generated by 'sLit'. @@ -81,7 +81,7 @@ module FastString hasZEncoding, -- * LitStrings - LitString, + LitString (..), -- ** Construction sLit, @@ -130,7 +130,7 @@ import Foreign import GHC.Conc.Sync (sharedCAF) #endif -import GHC.Base ( unpackCString# ) +import GHC.Base ( unpackCString#, unpackNBytes# ) #define hASH_TBL_SIZE 4091 #define hASH_TBL_SIZE_UNBOXED 4091# @@ -227,7 +227,7 @@ cmpFS f1@(FastString u1 _ _ _) f2@(FastString u2 _ _ _) = if u1 == u2 then EQ else compare (fastStringToByteString f1) (fastStringToByteString f2) -foreign import ccall unsafe "ghc_memcmp" +foreign import ccall unsafe "memcmp" memcmp :: Ptr a -> Ptr b -> Int -> IO Int -- ----------------------------------------------------------------------------- @@ -568,15 +568,12 @@ hPutFS handle fs = BS.hPut handle $ fastStringToByteString fs -- ----------------------------------------------------------------------------- -- LitStrings, here for convenience only. --- | A 'LitString' is a pointer to some null-terminated array of bytes. -type LitString = Ptr Word8 ---Why do we recalculate length every time it's requested? ---If it's commonly needed, we should perhaps have ---data LitString = LitString {-#UNPACK#-}!Addr# {-#UNPACK#-}!Int# +-- | A 'LitString' is a pointer to some array of Latin-1 encoded chars. +data LitString = LitString !(Ptr Word8) !Int -- | Wrap an unboxed address into a 'LitString'. mkLitString# :: Addr# -> LitString -mkLitString# a# = Ptr a# +mkLitString# a# = LitString (Ptr a#) (ptrStrLength (Ptr a#)) -- | Encode a 'String' into a newly allocated 'LitString' using Latin-1 -- encoding. The original string must not contain non-Latin-1 characters @@ -584,32 +581,34 @@ mkLitString# a# = Ptr a# {-# INLINE mkLitString #-} mkLitString :: String -> LitString mkLitString s = + -- we don't use `unsafeDupablePerformIO` here to avoid potential memory leaks + -- and because someone might be using `eqAddr#` to check for string equality. unsafePerformIO (do - p <- mallocBytes (length s + 1) + let len = length s + p <- mallocBytes len let loop :: Int -> String -> IO () - loop !n [] = pokeByteOff p n (0 :: Word8) + loop !_ [] = return () loop n (c:cs) = do pokeByteOff p n (fromIntegral (ord c) :: Word8) loop (1+n) cs loop 0 s - return p + return (LitString p len) ) -- | Decode a 'LitString' back into a 'String' using Latin-1 encoding. -- This does not free the memory associated with 'LitString'. unpackLitString :: LitString -> String -unpackLitString (Ptr p) = unpackCString# p +unpackLitString (LitString (Ptr p#) (I# n#)) = unpackNBytes# p# n# --- | Compute the length of a 'LitString', which must necessarily be --- null-terminated. +-- | Return the length of a 'LitString' lengthLS :: LitString -> Int -lengthLS = ptrStrLength +lengthLS (LitString _ n) = n -- ----------------------------------------------------------------------------- -- under the carpet -foreign import ccall unsafe "ghc_strlen" +foreign import ccall unsafe "strlen" ptrStrLength :: Ptr Word8 -> Int {-# NOINLINE sLit #-} |