@@ -50,6 +50,7 @@ module Data.Text.Encoding
5050
5151 -- * Encoding Text to ByteStrings
5252 , encodeUtf8
53+ , encodeUtf8_1
5354 , encodeUtf16LE
5455 , encodeUtf16BE
5556 , encodeUtf32LE
@@ -378,7 +379,55 @@ encodeUtf8BuilderEscaped be =
378379
379380#else
380381
381−encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
382+encodeUtf8 = encodeUtf8_0
383+
384+encodeUtf8_0, encodeUtf8_1 :: Text -> ByteString
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
382431 let size0 = max len 4
383432 mallocByteString size0 >>= start size0 off 0
384433 where
@@ -420,6 +469,7 @@ encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
420469 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
421470 poke8 (m+2) $ (w .&. 0x3F) + 0x80
422471 go (n+1) (m+3)
472+
423473#endif
424474
425475-- | Decode text from little endian UTF-16 encoding.