git.iko.soy/text
on master help sign in
Duplicate encodeUtf8 as encodeUtf8_1 temporarily
3090eb4Bryan O'Sullivan
Data/Text/Encoding.hs+51−1
compare with master
unifiedsplit
@@ -50,6 +50,7 @@ module Data.Text.Encoding
50
50
51 -- * Encoding Text to ByteStrings
51 -- * Encoding Text to ByteStrings
52 , encodeUtf8
52 , encodeUtf8
53+ , encodeUtf8_1
53 , encodeUtf16LE
54 , encodeUtf16LE
54 , encodeUtf16BE
55 , encodeUtf16BE
55 , encodeUtf32LE
56 , encodeUtf32LE
@@ -378,7 +379,55 @@ encodeUtf8BuilderEscaped be =
378
379
379#else
380#else
380
381
382+encodeUtf8 = encodeUtf8_0
383+
384+encodeUtf8_0, encodeUtf8_1 :: Text -> ByteString
381−encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
385+encodeUtf8_0 (Text arr off len) = unsafeDupablePerformIO $ do
386+ let size0 = max len 4
387+ mallocByteString size0 >>= start size0 off 0
388+ where
389+ start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
390+ where
391+ loop n1 m1 ptr = go n1 m1
392+ where
393+ offLen = off + len
394+ go !n !m
395+ | n == offLen = return (PS fp 0 m)
396+ | otherwise = do
397+ let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
398+ ensure k act
399+ | size-m >= k = act
400+ | otherwise = {-# SCC "resizeUtf8/ensure" #-} do
401+ let newSize = size `shiftL` 1
402+ fp' <- mallocByteString newSize
403+ withForeignPtr fp' $ \ptr' ->
404+ memcpy ptr' ptr (fromIntegral m)
405+ start newSize n m fp'
406+ {-# INLINE ensure #-}
407+ case A.unsafeIndex arr n of
408+ w| w <= 0x7F -> ensure 1 $ do
409+ poke (ptr `plusPtr` m) (fromIntegral w :: Word8)
410+ go (n+1) (m+1)
411+ | w <= 0x7FF -> ensure 2 $ do
412+ poke8 m $ (w `shiftR` 6) + 0xC0
413+ poke8 (m+1) $ (w .&. 0x3f) + 0x80
414+ go (n+1) (m+2)
415+ | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do
416+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
417+ poke8 m $ (c `shiftR` 18) + 0xF0
418+ poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
419+ poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
420+ poke8 (m+3) $ (c .&. 0x3F) + 0x80
421+ go (n+2) (m+4)
422+ | otherwise -> ensure 3 $ do
423+ poke8 m $ (w `shiftR` 12) + 0xE0
424+ poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
425+ poke8 (m+2) $ (w .&. 0x3F) + 0x80
426+ go (n+1) (m+3)
427+
428+encodeUtf8_1 (Text arr off len)
429+ | len == 0 = B.empty
430+ | otherwise = unsafeDupablePerformIO $ do
382 let size0 = max len 4
431 let size0 = max len 4
383 mallocByteString size0 >>= start size0 off 0
432 mallocByteString size0 >>= start size0 off 0
384 where
433 where
@@ -420,6 +469,7 @@ encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
420 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
469 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
421 poke8 (m+2) $ (w .&. 0x3F) + 0x80
470 poke8 (m+2) $ (w .&. 0x3F) + 0x80
422 go (n+1) (m+3)
471 go (n+1) (m+3)
472+
423#endif
473#endif
424
474
425-- | Decode text from little endian UTF-16 encoding.
475-- | Decode text from little endian UTF-16 encoding.
benchmarks/haskell/Benchmarks/Pure.hs+2
@@ -112,6 +112,7 @@ benchmark kind fp = do
112 ]
112 ]
113 , bgroup "encode"
113 , bgroup "encode"
114 [ benchT $ nf T.encodeUtf8 ta
114 [ benchT $ nf T.encodeUtf8 ta
115+ , benchT1 $ nf T.encodeUtf8_1 ta
115 , benchTL $ nf TL.encodeUtf8 tla
116 , benchTL $ nf TL.encodeUtf8 tla
116 , benchBS $ nf BS.pack sa
117 , benchBS $ nf BS.pack sa
117 , benchBSL $ nf BL.pack sa
118 , benchBSL $ nf BL.pack sa
@@ -410,6 +411,7 @@ benchmark kind fp = do
410 where
411 where
411 benchS = bench ("String+" ++ kind)
412 benchS = bench ("String+" ++ kind)
412 benchT = bench ("Text+" ++ kind)
413 benchT = bench ("Text+" ++ kind)
414+ benchT1 = bench ("Text1+" ++ kind)
413 benchTL = bench ("LazyText+" ++ kind)
415 benchTL = bench ("LazyText+" ++ kind)
414 benchBS = bench ("ByteString+" ++ kind)
416 benchBS = bench ("ByteString+" ++ kind)
415 benchBSL = bench ("LazyByteString+" ++ kind)
417 benchBSL = bench ("LazyByteString+" ++ kind)