git.iko.soy/text
on master help sign in
encodeUtf8_1: so long, it's been nice knowing you!
b5c0bedBryan O'Sullivan
Data/Text/Encoding.hs+1−85
compare with master
unifiedsplit
@@ -51,7 +51,6 @@ module Data.Text.Encoding
51 -- * Encoding Text to ByteStrings
51 -- * Encoding Text to ByteStrings
52 , encodeUtf8
52 , encodeUtf8
53 , encodeUtf8_0
53 , encodeUtf8_0
54− , encodeUtf8_1
55 , encodeUtf8_2
54 , encodeUtf8_2
56 , encodeUtf16LE
55 , encodeUtf16LE
57 , encodeUtf16BE
56 , encodeUtf16BE
@@ -89,12 +88,6 @@ import qualified Data.ByteString.Builder.Prim.Internal as BP
89import qualified Data.ByteString.Lazy as BL
88import qualified Data.ByteString.Lazy as BL
90#endif
89#endif
91
90
92−#if __GLASGOW_HASKELL__ >= 706
93−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
94−#else
95−import Foreign.ForeignPtr (unsafeForeignPtrToPtr)
96−#endif
97−
98import Data.Text ()
91import Data.Text ()
99import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
92import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
100import Data.Text.Internal (Text(..), safe, textP)
93import Data.Text.Internal (Text(..), safe, textP)
@@ -103,7 +96,7 @@ import Data.Text.Internal.Private (runText)
103import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
96import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
104import Data.Word (Word8, Word32)
97import Data.Word (Word8, Word32)
105import Foreign.C.Types (CSize(..))
98import Foreign.C.Types (CSize(..))
106−import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr)
99+import Foreign.ForeignPtr (withForeignPtr)
107import Foreign.Marshal.Utils (with)
100import Foreign.Marshal.Utils (with)
108import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
101import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
109import Foreign.Storable (Storable, peek, poke)
102import Foreign.Storable (Storable, peek, poke)
@@ -445,83 +438,6 @@ encodeUtf8_0 (Text arr off len) = unsafeDupablePerformIO $ do
445 poke8 (m+2) $ (w .&. 0x3F) + 0x80
438 poke8 (m+2) $ (w .&. 0x3F) + 0x80
446 go (n+1) (m+3)
439 go (n+1) (m+3)
447
440
448−encodeUtf8_1 :: Text -> ByteString
449−encodeUtf8_1 (Text arr off len)
450− | len == 0 = B.empty
451− | otherwise = unsafeDupablePerformIO $ do
452− fp0 <- mallocByteString len
453− withForeignPtr fp0 $ go1 off fp0
454− where
455− offLen = off + len
456− poke8 p v = poke p (fromIntegral v :: Word8)
457− resize k fp ptr = {-# SCC "encodeUtf8_1/resize" #-} do
458− fp' <- mallocByteString (len*k)
459− withForeignPtr fp $ \ptr0 -> do
460− let m = ptr `minusPtr` ptr0
461− memcpy (unsafeForeignPtrToPtr fp') ptr0 (fromIntegral m)
462− return fp'
463− {-# NOINLINE resize #-}
464− ensure k n fp ptr go = {-# SCC "encodeUtf8_1/ensure" #-} do
465− fp' <- resize k fp ptr
466− let !m = ptr `minusPtr` unsafeForeignPtrToPtr fp
467− go n fp' (unsafeForeignPtrToPtr fp' `plusPtr` m)
468− do1 ptr n w k = poke8 ptr w >> k (n+1) (ptr `plusPtr` 1)
469− loop act !n0 fp !ptr0 = hot n0 ptr0
470− where hot !n !ptr
471− | n == offLen = do
472− let !l = ptr `minusPtr` unsafeForeignPtrToPtr fp
473− touchForeignPtr fp
474− return (PS fp 0 l)
475− | otherwise = act (A.unsafeIndex arr n) n fp ptr hot
476− {-# INLINE loop #-}
477− go1 = loop $ \ w !n fp ptr cont ->
478− case w of
479− _| w <= 0x7F -> do1 ptr n w cont
480− | w <= 0x7FF -> ensure 2 n fp ptr go2
481− | w < 0xD800 || w > 0xDBFF -> ensure 3 n fp ptr go3
482− | otherwise -> ensure 4 n fp ptr go4
483− do2 ptr n w k = do
484− poke8 ptr $ (w `shiftR` 6) + 0xC0
485− poke8 (ptr `plusPtr` 1) $ (w .&. 0x3f) + 0x80
486− k (n+1) (ptr `plusPtr` 2)
487− go2 = loop $ \ w !n fp !ptr cont ->
488− case w of
489− _| w <= 0x7F -> do1 ptr n w cont
490− | w <= 0x7FF -> do2 ptr n w cont
491− | w < 0xD800 || w > 0xDBFF -> ensure 3 n fp ptr go3
492− | otherwise -> ensure 4 n fp ptr go4
493− do3 ptr !n w k = do
494− poke8 ptr $ (w `shiftR` 12) + 0xE0
495− poke8 (ptr `plusPtr` 1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
496− poke8 (ptr `plusPtr` 2) $ (w .&. 0x3F) + 0x80
497− k (n+1) (ptr `plusPtr` 3)
498− go3 = loop body where body w !n fp !ptr cont =
499− case w of
500− _| w <= 0x7F -> do1 ptr n w cont
501− | w <= 0x7FF -> do2 ptr n w cont
502− | w < 0xD800 || w > 0xDBFF -> do3 ptr n w cont
503− | otherwise -> ensure 4 n fp ptr go4
504− {-# INLINE body #-}
505− go4 !n0 fp ptr0 = do
506− let hot !n !ptr
507− | n == offLen = do
508− let !l = ptr `minusPtr` unsafeForeignPtrToPtr fp
509− touchForeignPtr fp
510− return (PS fp 0 l)
511− | otherwise = do
512− case A.unsafeIndex arr n of
513− w| w <= 0x7F -> do1 ptr n w hot
514− | w <= 0x7FF -> do2 ptr n w hot
515− | w < 0xD800 || w > 0xDBFF -> do3 ptr n w hot
516− | otherwise -> do
517− let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
518− poke8 ptr $ (c `shiftR` 18) + 0xF0
519− poke8 (ptr `plusPtr` 1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
520− poke8 (ptr `plusPtr` 2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
521− poke8 (ptr `plusPtr` 3) $ (c .&. 0x3F) + 0x80
522− hot (n+2) (ptr `plusPtr` 4)
523− hot n0 ptr0
524−
525encodeUtf8_2 :: Text -> ByteString
441encodeUtf8_2 :: Text -> ByteString
526encodeUtf8_2 (Text arr off len)
442encodeUtf8_2 (Text arr off len)
527 | len == 0 = B.empty
443 | len == 0 = B.empty
benchmarks/haskell/Benchmarks/Pure.hs−2
@@ -112,7 +112,6 @@ 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
116 , benchT2 $ nf T.encodeUtf8_2 ta
115 , benchT2 $ nf T.encodeUtf8_2 ta
117 , benchTL $ nf TL.encodeUtf8 tla
116 , benchTL $ nf TL.encodeUtf8 tla
118 , benchBS $ nf BS.pack sa
117 , benchBS $ nf BS.pack sa
@@ -412,7 +411,6 @@ benchmark kind fp = do
412 where
411 where
413 benchS = bench ("String+" ++ kind)
412 benchS = bench ("String+" ++ kind)
414 benchT = bench ("Text+" ++ kind)
413 benchT = bench ("Text+" ++ kind)
415− benchT1 = bench ("Text1+" ++ kind)
416 benchT2 = bench ("Text2+" ++ kind)
414 benchT2 = bench ("Text2+" ++ kind)
417 benchTL = bench ("LazyText+" ++ kind)
415 benchTL = bench ("LazyText+" ++ kind)
418 benchBS = bench ("ByteString+" ++ kind)
416 benchBS = bench ("ByteString+" ++ kind)