-- ** Construction
mkFastString,
mkFastStringBytes,
+ mkFastStringByteList,
mkFastStringForeignPtr,
mkFastString#,
mkZFastString,
cmpFS :: FastString -> FastString -> Ordering
cmpFS (FastString u1 l1 _ buf1 _) (FastString u2 l2 _ buf2 _) =
if u1 == u2 then EQ else
- let l = if l1 <= l2 then l1 else l2 in
- inlinePerformIO $
- withForeignPtr buf1 $ \p1 ->
- withForeignPtr buf2 $ \p2 -> do
- res <- memcmp p1 p2 l
- case () of
- _ | res < 0 -> return LT
- | res == 0 -> if l1 == l2 then return EQ
- else if l1 < l2 then return LT
- else return GT
- | otherwise -> return GT
+ case unsafeMemcmp buf1 buf2 (min l1 l2) `compare` 0 of
+ LT -> LT
+ EQ -> compare l1 l2
+ GT -> GT
+
+unsafeMemcmp :: ForeignPtr a -> ForeignPtr b -> Int -> Int
+unsafeMemcmp buf1 buf2 l =
+ inlinePerformIO $
+ withForeignPtr buf1 $ \p1 ->
+ withForeignPtr buf2 $ \p2 ->
+ memcmp p1 p2 l
#ifndef __HADDOCK__
foreign import ccall unsafe "ghc_memcmp"
{-# UNPACK #-} !Int
(MutableArray# RealWorld [FastString])
+{-# NOINLINE string_table #-}
string_table :: IORef FastStringTable
string_table =
unsafePerformIO $ do
utf8EncodeString ptr str
mkFastStringForeignPtr ptr buf l
+-- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
+mkFastStringByteList :: [Word8] -> FastString
+mkFastStringByteList str =
+ inlinePerformIO $ do
+ let l = Prelude.length str
+ buf <- mallocForeignPtrBytes l
+ withForeignPtr buf $ \ptr -> do
+ pokeArray (castPtr ptr) str
+ mkFastStringForeignPtr ptr buf l
-- | Creates a Z-encoded 'FastString' from a 'String'
mkZFastString :: String -> FastString
in
go str 0
-#if __GLASGOW_HASKELL__ < 600
-
-mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
-mallocForeignPtrBytes n = do
- r <- mallocBytes n
- newForeignPtr r (finalizerFree r)
-
-foreign import ccall unsafe "stdlib.h free"
- finalizerFree :: Ptr a -> IO ()
-
-peekCAStringLen = peekCStringLen
-
-#elif __GLASGOW_HASKELL__ <= 602
-
+#if __GLASGOW_HASKELL__ <= 602
peekCAStringLen = peekCStringLen
-
#endif
\end{code}