on master help sign in
encodeUtf8_1: so long, it's been nice knowing you!

Since encodeUtf8_2 wins under all circumstances, there's no reason to keep the intermediate version around.

commitb5c0bed25fab5edc1cac83319244ab2cd6974011 authorBryan O'Sullivan <bos@serpentine.com> dateTue 7 Jan 2014, 11:57 (13 years ago) parentd45c26d
2 files changed+1−87
Data/Text/Encoding.hs+1−85 benchmarks/haskell/Benchmarks/Pure.hs−2
Data/Text/Encoding.hs+1−85
@@ -51,7 +51,6 @@ module Data.Text.Encoding
5151 -- * Encoding Text to ByteStrings
5252 , encodeUtf8
5353 , encodeUtf8_0
54− , encodeUtf8_1
5554 , encodeUtf8_2
5655 , encodeUtf16LE
5756 , encodeUtf16BE
@@ -89,12 +88,6 @@ import qualified Data.ByteString.Builder.Prim.Internal as BP
8988import qualified Data.ByteString.Lazy as BL
9089#endif
9190
92−#if __GLASGOW_HASKELL__ >= 706
93−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
94−#else
95−import Foreign.ForeignPtr (unsafeForeignPtrToPtr)
96−#endif
97−
9891import Data.Text ()
9992import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
10093import Data.Text.Internal (Text(..), safe, textP)
@@ -103,7 +96,7 @@ import Data.Text.Internal.Private (runText)
10396import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
10497import Data.Word (Word8, Word32)
10598import Foreign.C.Types (CSize(..))
106−import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr)
99+import Foreign.ForeignPtr (withForeignPtr)
107100import Foreign.Marshal.Utils (with)
108101import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
109102import Foreign.Storable (Storable, peek, poke)
@@ -445,83 +438,6 @@ encodeUtf8_0 (Text arr off len) = unsafeDupablePerformIO $ do
445438 poke8 (m+2) $ (w .&. 0x3F) + 0x80
446439 go (n+1) (m+3)
447440
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−
525441encodeUtf8_2 :: Text -> ByteString
526442encodeUtf8_2 (Text arr off len)
527443 | len == 0 = B.empty
benchmarks/haskell/Benchmarks/Pure.hs−2
@@ -112,7 +112,6 @@ benchmark kind fp = do
112112 ]
113113 , bgroup "encode"
114114 [ benchT $ nf T.encodeUtf8 ta
115− , benchT1 $ nf T.encodeUtf8_1 ta
116115 , benchT2 $ nf T.encodeUtf8_2 ta
117116 , benchTL $ nf TL.encodeUtf8 tla
118117 , benchBS $ nf BS.pack sa
@@ -412,7 +411,6 @@ benchmark kind fp = do
412411 where
413412 benchS = bench ("String+" ++ kind)
414413 benchT = bench ("Text+" ++ kind)
415− benchT1 = bench ("Text1+" ++ kind)
416414 benchT2 = bench ("Text2+" ++ kind)
417415 benchTL = bench ("LazyText+" ++ kind)
418416 benchBS = bench ("ByteString+" ++ kind)