Merge branch 'master' into feature-new-bytestring-builder
authorSimon Meier <simon.meier@erudify.com>
Thu, 21 Nov 2013 23:25:02 +0000 (00:25 +0100)
committerSimon Meier <simon.meier@erudify.com>
Thu, 21 Nov 2013 23:26:11 +0000 (00:26 +0100)
- newest benchmark results:

    8.2  ->  7.2 ms  for EncodeUtf8/Text benchamrk
    18.2 -> 10.0 ms  for EncodeUtf8/TextLazy benchmark

  ==> 13% and 81% speed improvement :-)

Conflicts:
Data/Text/Encoding.hs
text.cabal

1  2 
Data/Text/Encoding.hs
Data/Text/Lazy/Encoding.hs
benchmarks/text-benchmarks.cabal
text.cabal

@@@ -45,12 -55,6 +55,12 @@@ module Data.Text.Encodin
      , encodeUtf16BE
      , encodeUtf32LE
      , encodeUtf32BE
-     
++
 +    -- * Generic encoding of Text
-     , encodeStreamWithB
-     , encodeTextWithB
-     , encodeUtf8Builder
++    -- , encodeStreamWithB
++    -- , encodeTextWithB
++    -- , encodeUtf8Builder
 +    , encodeUtf8Escaped
      ) where
  
  import Control.Exception (evaluate, try)
@@@ -62,14 -67,13 +73,18 @@@ import Control.Monad.ST (runST
  import Data.Bits ((.&.))
  import Data.ByteString as B
  import Data.ByteString.Internal as B
- import Data.ByteString.Lazy.Builder.Internal as B
- import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as B
- import qualified Data.ByteString.Lazy.Builder.BasicEncoding          as B
++import qualified Data.ByteString.Lazy                  as BL
++import qualified Data.ByteString.Builder               as B
++import qualified Data.ByteString.Builder.Internal      as B
++import qualified Data.ByteString.Builder.Prim.Internal as BP
++import qualified Data.ByteString.Builder.Prim          as BP
+ import Data.Text ()
  import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
- import Data.Text.Internal (Text(..), textP)
+ import Data.Text.Internal (Text(..), safe, textP)
+ import Data.Text.Private (runText)
  import Data.Text.UnsafeChar (ord, unsafeWrite)
  import Data.Text.UnsafeShift (shiftL, shiftR)
- import Data.Word (Word8)
+ import Data.Word (Word8, Word32)
  import Foreign.C.Types (CSize)
  import Foreign.ForeignPtr (withForeignPtr)
  import Foreign.Marshal.Utils (with)
@@@ -154,7 -292,7 +303,12 @@@ decodeUtf8' = unsafeDupablePerformIO . 
  
  -- | Encode text using UTF-8 encoding.
  encodeUtf8 :: Text -> ByteString
- encodeUtf8 (Text arr off len) = unsafePerformIO $ do
++encodeUtf8 =
++    BL.toStrict . B.toLazyByteString
++  . encodeUtf8Escaped (BP.liftFixedToBounded BP.word8)
++
++{-
+ encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
    let size0 = max len 4
    mallocByteString size0 >>= start size0 off 0
   where
                    poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
                    poke8 (m+2) $ (w .&. 0x3F) + 0x80
                    go (n+1) (m+3)
++-}
++
++-- | Encode text using UTF-8 encoding and escape the ASCII characters using
++-- a 'BP.PrimBounded'.
++encodeUtf8Escaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
++encodeUtf8Escaped be (Text arr off len) =
++    B.builder step
++  where
++    bound   = max 4 $ BP.sizeBound be
++    iend    = off + len
++    step !k =
++        outerLoop off
++      where
++        outerLoop !i0 !br@(B.BufferRange op0 ope)
++          | i0 >= iend                = k br
++          | op0 `plusPtr` bound < ope =
++              goPartial (i0 + min outRemaining inpRemaining)
++          | otherwise  = return $ B.bufferFull bound op0 (outerLoop i0)
++          where
++            outRemaining = (ope `minusPtr` op0) `div` bound
++            inpRemaining = iend - i0
++
++            goPartial !iendTmp = go i0 op0
++              where
++                go !i !op
++                  | i < iendTmp = case A.unsafeIndex arr i of
++                      w | w <= 0x7F -> do
++                            BP.runB be (fromIntegral w) op >>= go (i + 1)
++                        | w <= 0x7FF -> do
++                            poke8 0 $ (w `shiftR` 6) + 0xC0
++                            poke8 1 $ (w .&. 0x3f) + 0x80
++                            go (i + 1) (op `plusPtr` 2)
++                        | 0xD800 <= w && w <= 0xDBFF -> do
++                            let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
++                            poke8 0 $ (c `shiftR` 18) + 0xF0
++                            poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
++                            poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
++                            poke8 3 $ (c .&. 0x3F) + 0x80
++                            go (i + 2) (op `plusPtr` 4)
++                        | otherwise -> do
++                            poke8 0 $ (w `shiftR` 12) + 0xE0
++                            poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
++                            poke8 2 $ (w .&. 0x3F) + 0x80
++                            go (i + 1) (op `plusPtr` 3)
++                  | otherwise =
++                      outerLoop i (B.BufferRange op ope)
++                  where
++                    poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
++
  
  -- | Decode text from little endian UTF-16 encoding.
  decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@@ -288,80 -426,10 +491,45 @@@ foreign import ccall unsafe "_hs_text_d
      :: MutableByteArray# s -> Ptr CSize
      -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
  
- encodeStreamWithB be = 
+ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
+     :: MutableByteArray# s -> Ptr CSize
+     -> Ptr (Ptr Word8) -> Ptr Word8
+     -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
+ foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
+     :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
++
++
++{-
 +-- | Encode all elements of a 'F.Stream' using a 'B.BoundedEncoding'.
 +{-# INLINE encodeStreamWithB #-}
 +encodeStreamWithB :: B.BoundedEncoding a -> F.Stream a -> B.Builder
-     step next s0 k (B.BufferRange op0 ope0) = 
++encodeStreamWithB be =
 +    \(F.Stream next s0 _) -> B.builder $ step next s0
 +  where
 +    bound = B.sizeBound be
-             | otherwise                  -> 
++    step next s0 k (B.BufferRange op0 ope0) =
 +        go s0 op0
 +      where
 +        go s !op = case next s of
 +          F.Done       -> k (B.BufferRange op ope0)
 +          F.Skip s'    -> go s' op
 +          F.Yield x s'
 +            | op `plusPtr` bound <= ope0 -> B.runB be x op >>= go s'
- -- | 
++            | otherwise                  ->
 +                return $ B.bufferFull bound op (step next s k)
 +
 +
- -- | Encode text using UTF-8 encoding and escape the ASCII characters using
- -- a 'BoundedEncoding'.
- encodeUtf8Escaped :: B.BoundedEncoding Word8 -> Text -> B.Builder
- encodeUtf8Escaped be (Text arr off len) =
-     B.builder step
-   where
-     bound   = max 4 $ B.sizeBound be
-     iend    = off + len
-     step !k =
-         outerLoop off
-       where
-         outerLoop !i0 !br@(BufferRange op0 ope)
-           | i0 >= iend                = k br
-           | op0 `plusPtr` bound < ope =
-               goPartial (i0 + min outRemaining inpRemaining)
-           | otherwise  = return $ bufferFull bound op0 (outerLoop i0)
-           where
-             outRemaining = (ope `minusPtr` op0) `div` bound
-             inpRemaining = iend - i0
-             goPartial !iendTmp = go i0 op0
-               where
-                 go !i !op
-                   | i < iendTmp = case A.unsafeIndex arr i of
-                       w | w <= 0x7F -> do
-                             B.runB be (fromIntegral w) op >>= go (i + 1)
-                         | w <= 0x7FF -> do
-                             poke8 0 $ (w `shiftR` 6) + 0xC0
-                             poke8 1 $ (w .&. 0x3f) + 0x80
-                             go (i + 1) (op `plusPtr` 2)
-                         | 0xD800 <= w && w <= 0xDBFF -> do
-                             let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
-                             poke8 0 $ (c `shiftR` 18) + 0xF0
-                             poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
-                             poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
-                             poke8 3 $ (c .&. 0x3F) + 0x80
-                             go (i + 2) (op `plusPtr` 4)
-                         | otherwise -> do
-                             poke8 0 $ (w `shiftR` 12) + 0xE0
-                             poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
-                             poke8 2 $ (w .&. 0x3F) + 0x80
-                             go (i + 1) (op `plusPtr` 3)
-                   | otherwise =
-                       outerLoop i (BufferRange op ope)
-                   where
-                     poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
++-- |
 +-- | /Subject to fusion./
 +-- Encode all 'Char's of a 'T.Text' using a 'B.BoundedEncoding'.
 +{-# INLINE encodeTextWithB #-}
 +encodeTextWithB :: B.BoundedEncoding Char -> Text -> B.Builder
 +encodeTextWithB be = encodeStreamWithB be . F.stream
 +
 +-- | Encode text using UTF-8 encoding.
 +encodeUtf8Builder :: Text -> B.Builder
 +encodeUtf8Builder = encodeUtf8Escaped (B.fromF B.word8)
++-}
 +
 +
@@@ -46,13 -50,12 +50,15 @@@ module Data.Text.Lazy.Encodin
  
  import Control.Exception (evaluate, try)
  import Data.Bits ((.&.))
++import Data.Monoid (mempty, (<>))
  import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
  import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)
- import System.IO.Unsafe (unsafePerformIO)
  import qualified Data.ByteString as S
  import qualified Data.ByteString.Lazy as B
  import qualified Data.ByteString.Lazy.Internal as B
  import qualified Data.ByteString.Unsafe as S
++import qualified Data.ByteString.Builder               as B
++import qualified Data.ByteString.Builder.Prim          as BP
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as TE
  import qualified Data.Text.Lazy.Encoding.Fusion as E
@@@ -150,8 -158,8 +161,13 @@@ decodeUtf8' bs = unsafeDupablePerformI
  {-# INLINE decodeUtf8' #-}
  
  encodeUtf8 :: Text -> B.ByteString
--encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)
--encodeUtf8 Empty        = B.Empty
++encodeUtf8 =
++    B.toLazyByteString . go
++  where
++    go Empty        = mempty
++    go (Chunk c cs) =
++        TE.encodeUtf8Escaped (BP.liftFixedToBounded BP.word8) c <> go cs
++
  
  -- | Decode text from little endian UTF-16 encoding.
  decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
index 0000000,1bd22f8..ce36dd5
mode 000000,100644..100644
--- /dev/null
@@@ -1,0 -1,54 +1,54 @@@
 -                  bytestring,
+ name:                text-benchmarks
+ version:             0.0.0.0
+ synopsis:            Benchmarks for the text package
+ description:         Benchmarks for the text package
+ homepage:            https://bitbucket.org/bos/text
+ license:             BSD3
+ license-file:        ../LICENSE
+ author:              Jasper Van der Jeugt <jaspervdj@gmail.com>,
+                      Bryan O'Sullivan <bos@serpentine.com>,
+                      Tom Harper <rtomharper@googlemail.com>,
+                      Duncan Coutts <duncan@haskell.org>
+ maintainer:          jaspervdj@gmail.com
+ category:            Text
+ build-type:          Simple
+ cabal-version:       >=1.2
+ flag llvm
+   description: use LLVM
+   default: False
+ executable text-benchmarks
+   hs-source-dirs: haskell ..
+   c-sources:      ../cbits/cbits.c
+                   cbits/time_iconv.c
+   include-dirs:   ../include
+   main-is:        Benchmarks.hs
+   ghc-options:    -Wall -O2
+   if flag(llvm)
+     ghc-options:  -fllvm
+   cpp-options:    -DHAVE_DEEPSEQ -DINTEGER_GMP
+   build-depends:  base == 4.*,
+                   binary,
+                   blaze-builder,
++                  bytestring >= 0.10.4.0,
+                   bytestring-lexing,
+                   containers,
+                   criterion >= 0.6.0.1,
+                   deepseq,
+                   directory,
+                   filepath,
+                   ghc-prim,
+                   integer-gmp,
+                   stringsearch,
+                   utf8-string
+ executable text-multilang
+   hs-source-dirs: haskell
+   main-is:        Multilang.hs
+   ghc-options:    -Wall -O2
+   build-depends:  base == 4.*,
+                   bytestring,
+                   text,
+                   time
diff --cc text.cabal
@@@ -1,5 -1,5 +1,5 @@@
  name:           text
- version:        0.11.2.0
 -version:        0.11.4.0
++version:        0.11.5.0
  homepage:       https://github.com/bos/text
  bug-reports:    https://github.com/bos/text/issues
  synopsis:       An efficient packed Unicode text type.
@@@ -109,20 -125,14 +125,14 @@@ librar
      Data.Text.Util
  
    build-depends:
-     array,
-     base       < 5,
-     bytestring >= 0.10 && < 1.0
-   if impl(ghc >= 6.10)
-     build-depends:
-       ghc-prim, base >= 4, deepseq >= 1.1.0.0
-     cpp-options: -DHAVE_DEEPSEQ
-   else
-     build-depends: extensible-exceptions
-     extensions: PatternSignatures
+     array      >= 0.3,
+     base       >= 4.2 && < 5,
 -    bytestring >= 0.9,
++    bytestring >= 0.10.4.0,
+     deepseq    >= 1.1.0.0,
+     ghc-prim   >= 0.2
  
-   ghc-options: -Wall -funbox-strict-fields -O2
-   if impl(ghc >= 6.8)
-     ghc-options: -fwarn-tabs
+   cpp-options: -DHAVE_DEEPSEQ
+   ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
    if flag(developer)
      ghc-prof-options: -auto-all
      ghc-options: -Werror