59d6232 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Drop the old pure-Haskell implementation of encodeUtf8

59d6232Bryan O'Sullivan13 years ago

Data/Text/Encoding.hs+7−55

compare with master

unifiedsplit

@@ -50,8 +50,6 @@ module Data.Text.Encoding

51 -- * Encoding Text to ByteStrings

52 , encodeUtf8

53− , encodeUtf8_0

54− , encodeUtf8_2

55 , encodeUtf16LE

53 , encodeUtf16LE

56 , encodeUtf16BE

54 , encodeUtf16BE

57 , encodeUtf32LE

55 , encodeUtf32LE

@@ -75,25 +73,27 @@ import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)

75#endif

73#endif

77import Control.Monad.ST (runST)

75import Control.Monad.ST (runST)

78−import Data.Bits ((.&.))

79import Data.ByteString as B

76import Data.ByteString as B

80import Data.ByteString.Internal as B hiding (c2w)

77import Data.ByteString.Internal as B hiding (c2w)

82#if MIN_VERSION_bytestring(0,10,4)

79#if MIN_VERSION_bytestring(0,10,4)

80+import Data.Bits ((.&.))

81+import Data.Text.Internal.Unsafe.Char (ord)

83import qualified Data.ByteString.Builder as B

82import qualified Data.ByteString.Builder as B

84−import qualified Data.ByteString.Builder.Extra as B

83+import qualified Data.ByteString.Builder.Extra as B

85import qualified Data.ByteString.Builder.Internal as B hiding (empty)

84import qualified Data.ByteString.Builder.Internal as B hiding (empty)

86import qualified Data.ByteString.Builder.Prim as BP

85import qualified Data.ByteString.Builder.Prim as BP

87import qualified Data.ByteString.Builder.Prim.Internal as BP

86import qualified Data.ByteString.Builder.Prim.Internal as BP

88import qualified Data.ByteString.Lazy as BL

87import qualified Data.ByteString.Lazy as BL

88+import qualified Data.Text.Internal.Encoding.Utf16 as U16

89#endif

91import Data.Text ()

92import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

93import Data.Text.Internal (Text(..), safe, textP)

94−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

94+import Data.Text.Internal.Unsafe.Shift (shiftR)

95import Data.Text.Internal.Private (runText)

96−import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

96+import Data.Text.Internal.Unsafe.Char (unsafeWrite)

97import Data.Word (Word8, Word32)

98import Foreign.C.Types (CSize(..))

99import Foreign.ForeignPtr (withForeignPtr)

@@ -103,7 +103,6 @@ import Foreign.Storable (Storable, peek, poke)

103import GHC.Base (ByteArray#, MutableByteArray#)

104import qualified Data.Text.Array as A

105import qualified Data.Text.Internal.Encoding.Fusion as E

106−import qualified Data.Text.Internal.Encoding.Utf16 as U16

107import qualified Data.Text.Internal.Fusion as F

106import qualified Data.Text.Internal.Fusion as F

108import Data.Text.Unsafe (unsafeDupablePerformIO)

107import Data.Text.Unsafe (unsafeDupablePerformIO)

109

108

@@ -377,54 +376,7 @@ encodeUtf8BuilderEscaped be =

377

376

378-- | Encode text using UTF-8 encoding.

377-- | Encode text using UTF-8 encoding.

379encodeUtf8 :: Text -> ByteString

378encodeUtf8 :: Text -> ByteString

380−encodeUtf8 = encodeUtf8_0

381−

382−encodeUtf8_0 :: Text -> ByteString

383−encodeUtf8_0 (Text arr off len) = unsafeDupablePerformIO $ do

384− let size0 = max len 4

385− mallocByteString size0 >>= start size0 off 0

386− where

387− start size n0 m0 fp = withForeignPtr fp $ loop n0 m0

388− where

389− loop n1 m1 ptr = go n1 m1

390− where

391− offLen = off + len

392− go !n !m

393− | n == offLen = return (PS fp 0 m)

394− | otherwise = do

395− let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)

396− ensure k act

397− | size-m >= k = act

398− | otherwise = {-# SCC "resizeUtf8/ensure" #-} do

399− let newSize = size `shiftL` 1

400− fp' <- mallocByteString newSize

401− withForeignPtr fp' $ \ptr' ->

402− memcpy ptr' ptr (fromIntegral m)

403− start newSize n m fp'

404− {-# INLINE ensure #-}

405− case A.unsafeIndex arr n of

406− w| w <= 0x7F -> ensure 1 $ do

407− poke (ptr `plusPtr` m) (fromIntegral w :: Word8)

408− go (n+1) (m+1)

409− | w <= 0x7FF -> ensure 2 $ do

410− poke8 m $ (w `shiftR` 6) + 0xC0

411− poke8 (m+1) $ (w .&. 0x3f) + 0x80

412− go (n+1) (m+2)

413− | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do

414− let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))

415− poke8 m $ (c `shiftR` 18) + 0xF0

416− poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80

417− poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80

418− poke8 (m+3) $ (c .&. 0x3F) + 0x80

419− go (n+2) (m+4)

420− | otherwise -> ensure 3 $ do

421− poke8 m $ (w `shiftR` 12) + 0xE0

422− poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80

423− poke8 (m+2) $ (w .&. 0x3F) + 0x80

424− go (n+1) (m+3)

425−

426−encodeUtf8_2 :: Text -> ByteString

427−encodeUtf8_2 (Text arr off len)

379+encodeUtf8 (Text arr off len)

428 | len == 0 = B.empty

380 | len == 0 = B.empty

429 | otherwise = unsafeDupablePerformIO $ do

381 | otherwise = unsafeDupablePerformIO $ do

430 fp <- mallocByteString (len*4)

382 fp <- mallocByteString (len*4)

benchmarks/haskell/Benchmarks/Pure.hs−2

@@ -112,7 +112,6 @@ benchmark kind fp = do

112 ]

113 , bgroup "encode"

114 [ benchT $ nf T.encodeUtf8 ta

115− , benchT2 $ nf T.encodeUtf8_2 ta

116 , benchTL $ nf TL.encodeUtf8 tla

115 , benchTL $ nf TL.encodeUtf8 tla

117 , benchBS $ nf BS.pack sa

116 , benchBS $ nf BS.pack sa

118 , benchBSL $ nf BL.pack sa

117 , benchBSL $ nf BL.pack sa

@@ -411,7 +410,6 @@ benchmark kind fp = do

411 where

410 where

412 benchS = bench ("String+" ++ kind)

411 benchS = bench ("String+" ++ kind)

413 benchT = bench ("Text+" ++ kind)

412 benchT = bench ("Text+" ++ kind)

414− benchT2 = bench ("Text2+" ++ kind)

415 benchTL = bench ("LazyText+" ++ kind)

413 benchTL = bench ("LazyText+" ++ kind)

416 benchBS = bench ("ByteString+" ++ kind)

414 benchBS = bench ("ByteString+" ++ kind)

417 benchBSL = bench ("LazyByteString+" ++ kind)

415 benchBSL = bench ("LazyByteString+" ++ kind)