[commit: packages/binary] master: Use putCharUtf8 from Builder in 'instance Binary Char'. (17decb0)

git at git.haskell.org git at git.haskell.org
Mon Apr 4 11:05:31 UTC 2016


Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/17decb02dd242888fa506598572aef828de3cc42

>---------------------------------------------------------------

commit 17decb02dd242888fa506598572aef828de3cc42
Author: Lennart Kolmodin <kolmodin at gmail.com>
Date:   Sat Apr 2 09:24:23 2016 +0200

    Use putCharUtf8 from Builder in 'instance Binary Char'.
    
    Using `Data.ByteString.Builder` made GenericsBench.encode 10% slower. This
    brings it back to the same numbers as before.


>---------------------------------------------------------------

17decb02dd242888fa506598572aef828de3cc42
 src/Data/Binary/Class.hs | 21 +--------------------
 src/Data/Binary/Put.hs   | 13 +++++++++++++
 2 files changed, 14 insertions(+), 20 deletions(-)

diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs
index 2e8c239..d0cf71a 100644
--- a/src/Data/Binary/Class.hs
+++ b/src/Data/Binary/Class.hs
@@ -68,7 +68,6 @@ import Control.Monad
 import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as L
 
-import Data.Char    (ord)
 import Data.List    (unfoldr, foldl')
 
 -- And needed for the instances:
@@ -414,25 +413,7 @@ instance (Binary a,Integral a) => Binary (R.Ratio a) where
 
 -- Char is serialised as UTF-8
 instance Binary Char where
-    put a | c <= 0x7f     = put (fromIntegral c :: Word8)
-          | c <= 0x7ff    = do put (0xc0 .|. y)
-                               put (0x80 .|. z)
-          | c <= 0xffff   = do put (0xe0 .|. x)
-                               put (0x80 .|. y)
-                               put (0x80 .|. z)
-          | c <= 0x10ffff = do put (0xf0 .|. w)
-                               put (0x80 .|. x)
-                               put (0x80 .|. y)
-                               put (0x80 .|. z)
-          | otherwise     = error "Not a valid Unicode code point"
-     where
-        c = ord a
-        z, y, x, w :: Word8
-        z = fromIntegral (c           .&. 0x3f)
-        y = fromIntegral (shiftR c 6  .&. 0x3f)
-        x = fromIntegral (shiftR c 12 .&. 0x3f)
-        w = fromIntegral (shiftR c 18 .&. 0x7)
-
+    put = putCharUtf8
     get = do
         let getByte = liftM (fromIntegral :: Word8 -> Int) get
             shiftL6 = flip shiftL 6 :: Int -> Int
diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs
index 83ec710..70501d1 100644
--- a/src/Data/Binary/Put.hs
+++ b/src/Data/Binary/Put.hs
@@ -65,6 +65,9 @@ module Data.Binary.Put (
     , putInt32host          -- :: Int32  -> Put
     , putInt64host          -- :: Int64  -> Put
 
+    -- * Unicode
+    , putCharUtf8
+
   ) where
 
 import Data.Monoid
@@ -310,3 +313,13 @@ putInt32host       = tell . B.putInt32host
 putInt64host       :: Int64 -> Put
 putInt64host       = tell . B.putInt64host
 {-# INLINE putInt64host #-}
+
+
+------------------------------------------------------------------------
+-- Unicode
+
+-- | Write a character using UTF-8 encoding.
+putCharUtf8 :: Char -> Put
+putCharUtf8 = tell . B.putCharUtf8
+{-# INLINE putCharUtf8 #-}
+



More information about the ghc-commits mailing list