utf8-string 1 → 1.0.1

raw patch · 3 files changed

+71/−3 lines, 3 filesdep ~base

Dependency ranges changed: base

Files

• CHANGELOG.markdown +4/−0
• Data/ByteString/Lazy/UTF8.hs +66/−2
• utf8-string.cabal +1/−1

@@ -1,3 +1,7 @@+1.0.1+-----+* Improve the performance of Data.ByteString.Lazy.UTF8.fromString. (Thanks, ndmitchell)+ 1 ----- * Remove out all the old utf8 IO support. GHC supports utf8 now.

@@ -38,16 +38,63 @@ import Data.Bits import Data.Word import Data.Int+import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr+import Data.Char        (ord)+import Control.Exception        (assert) import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Internal as B+import qualified Data.ByteString.Internal as S+import System.IO.Unsafe import Prelude hiding (take,drop,splitAt,span,break,foldr,foldl,length,lines) -import Codec.Binary.UTF8.String(encode) import Codec.Binary.UTF8.Generic (buncons) +---------------------------------------------------------------------+-- ENCODING+ -- | Converts a Haskell string into a UTF8 encoded bytestring. fromString :: String -> B.ByteString-fromString xs = B.pack (encode xs)+fromString []  = B.empty+fromString xs0 = packChunks 32 xs0+  where+    packChunks n xs = case packUptoLenBytes n xs of+        (bs, [] ) -> B.chunk bs B.Empty+        (bs, xs') -> B.Chunk bs (packChunks (min (n * 2) B.smallChunkSize) xs') +    packUptoLenBytes :: Int -> String -> (S.ByteString, String)+    packUptoLenBytes len xs = unsafeCreateUptoN' len $ \ptr -> do+        (end, xs') <- go ptr (ptr `plusPtr` (len-4)) xs+        return (end `minusPtr` ptr, xs')++    -- end is the last position at which you can write a whole 4 byte sequence safely+    go :: Ptr Word8 -> Ptr Word8 -> String -> IO (Ptr Word8, String)+    go !ptr !end xs | ptr > end = return (ptr, xs)+    go !ptr !_   [] = return (ptr, [])+    go !ptr !end (x:xs)+        | x <= '\x7f' = poke ptr (S.c2w x) >> go (plusPtr ptr 1) end xs+        | otherwise = case ord x of+            oc | oc <= 0x7ff -> do+                    poke ptr $ fromIntegral $ 0xc0 + (oc `shiftR` 6)+                    pokeElemOff ptr 1 $ fromIntegral $ 0x80 + oc .&. 0x3f+                    go (plusPtr ptr 2) end xs+               | oc <= 0xffff -> do+                    poke ptr $ fromIntegral $ 0xe0 + (oc `shiftR` 12)+                    pokeElemOff ptr 1 $ fromIntegral $ 0x80 + ((oc `shiftR` 6) .&. 0x3f)+                    pokeElemOff ptr 2 $ fromIntegral $ 0x80 + oc .&. 0x3f+                    go (plusPtr ptr 3) end xs+               | otherwise -> do+                    poke ptr $ fromIntegral $ 0xf0 + (oc `shiftR` 18)+                    pokeElemOff ptr 1 $ fromIntegral $ 0x80 + ((oc `shiftR` 12) .&. 0x3f)+                    pokeElemOff ptr 2 $ fromIntegral $ 0x80 + ((oc `shiftR` 6) .&. 0x3f)+                    pokeElemOff ptr 3 $ fromIntegral $ 0x80 + oc .&. 0x3f+                    go (plusPtr ptr 4) end xs+++---------------------------------------------------------------------+-- DECODING+ -- | Convert a UTF8 encoded bytestring into a Haskell string. -- Invalid characters are replaced with '\xFFFD'. toString :: B.ByteString -> String@@ -221,3 +268,20 @@                         in xs : lines' ys               Nothing -> [bs] ++---------------------------------------------------------------------+-- COPIED FROM BYTESTRING+-- These functions are copied verbatum from Data.ByteString.Internal+-- I suspect their lack of export is an oversight++unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (S.ByteString, a)+unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f)+{-# INLINE unsafeCreateUptoN' #-}++-- | Create ByteString of up to size @l@ and use action @f@ to fill it's contents which returns its true size.+createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (S.ByteString, a)+createUptoN' l f = do+    fp <- S.mallocByteString l+    (l', res) <- withForeignPtr fp $ \p -> f p+    assert (l' <= l) $ return (S.PS fp 0 l', res)+{-# INLINE createUptoN' #-}

@@ -1,5 +1,5 @@ Name:               utf8-string-Version:            1+Version:            1.0.1 Author:             Eric Mertens Maintainer:         emertens@galois.com License:            BSD3