Skip to content

Optimize toByteString and toASCIIBytes #80

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 6 commits into
base: master
Choose a base branch
from
Open

Optimize toByteString and toASCIIBytes #80

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
fc74f8f
Use fixed length bytestring builder for hyphenated string
lykahb Dec 2, 2023
6b3022a
Use fixed length bytestring builder for network order
lykahb Dec 2, 2023
d6de856
Reuse conversion to ByteString for the list of bytes
lykahb Dec 2, 2023
f3dc68f
New release
lykahb Dec 2, 2023
bcab925
Update uuid-types version and changelog
lykahb Dec 2, 2023
c89e48b
Use Data.ByteString.Builder.Prim.Internal instead of Builder
lykahb Mar 19, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CONTRIBUTORS
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,3 +13,4 @@ Michael Snoyman
Bardur Arantsson
Timo von Holtz
Oleg Grenrus
Borys Lykah
13 changes: 0 additions & 13 deletions uuid-bench/bench/uuid-types-benchmark.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,11 +1,5 @@
{-# LANGUAGE CPP #-}

#if !(MIN_VERSION_bytestring(0,10,0))
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- Needed for NFData instance
import Control.DeepSeq
import qualified Data.ByteString.Lazy.Internal as BL
#endif
import Criterion.Main
import qualified Data.ByteString.Lazy as BL
import qualified Data.HashSet as HashSet
Expand All @@ -15,13 +9,6 @@ import qualified Data.UUID.Types as U
import Foreign (alloca, peek, poke)
import System.Random

#if !(MIN_VERSION_bytestring(0,10,0))
-- orphan
instance NFData BL.ByteString where
rnf BL.Empty = ()
rnf (BL.Chunk _ ts) = rnf ts
#endif

main :: IO ()
main = do
u1 <- randomIO
Expand Down
26 changes: 13 additions & 13 deletions uuid-bench/uuid-bench.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,19 +40,19 @@ source-repository head

library
build-depends:
base >=4.9 && <5
, binary >=0.5.1.0 && <0.9
, bytestring >=0.9.2.1 && <0.12
, cryptohash-md5 >=0.11.100 && <0.12
, cryptohash-sha1 >=0.11.100 && <0.12
, deepseq >=1.3.0.0 && <1.5
, entropy >=0.3.7 && <0.5
, hashable >=1.2.7.0 && <1.5
, network-info >=0.2 && <0.3
, random >=1.1 && <1.3
, template-haskell >=2.7.0.0 && <2.20
, text >=1.2.3.0 && <1.3 || >=2.0 && <2.1
, time >=1.4 && <1.13
base >=4.9 && <5
, binary >=0.5.1.0 && <0.9
, bytestring >=0.10.2.0 && <0.12
, cryptohash-md5 >=0.11.100 && <0.12
, cryptohash-sha1 >=0.11.100 && <0.12
, deepseq >=1.3.0.0 && <1.5
, entropy >=0.3.7 && <0.5
, hashable >=1.2.7.0 && <1.5
, network-info >=0.2 && <0.3
, random >=1.1 && <1.3
, template-haskell >=2.7.0.0 && <2.21
, text >=1.2.3.0 && <1.3 || >=2.0 && <2.1
, time >=1.4 && <1.13

-- uuid modules
exposed-modules:
Expand Down
5 changes: 5 additions & 0 deletions uuid-types/ChangeLog.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,8 @@
## 1.0.5.1

- Optimize and refactor functions `toByteString` (3.7x speed increase) and
`toASCIIBytes` (20% speed increase).

## 1.0.5 (2021-05-03)

- Add (Template Haskell) `Lift UUID` instance
Expand Down
132 changes: 49 additions & 83 deletions uuid-types/src/Data/UUID/Types/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,30 +49,31 @@ module Data.UUID.Types.Internal
, unpack
) where

import Prelude hiding (null)
import Prelude hiding (null)

import Control.Applicative ((<*>))
import Control.DeepSeq (NFData (..))
import Control.Monad (guard, liftM2)
import Control.Applicative ((<*>))
import Control.DeepSeq (NFData (..))
import Control.Monad (guard, liftM2)
import Data.Bits
import Data.Char
import Data.Data
import Data.Functor ((<$>))
import Data.Functor ((<$>))
import Data.Hashable
import Data.List (elemIndices)
import Foreign.Ptr (Ptr)
import Data.List (elemIndices)

import Foreign.Storable

import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Unsafe as BU
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BBI
import qualified Data.ByteString.Builder.Prim as BBP
import qualified Data.ByteString.Builder.Prim.Internal as BBPI (runF)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Unsafe as BU
import Data.Text (Text)
import qualified Data.Text.Encoding as T

import Data.UUID.Types.Internal.Builder

Expand All @@ -90,6 +91,7 @@ import Language.Haskell.TH (appE, varE)
import Language.Haskell.TH.Syntax (Lift (..), mkNameG_v, Lit (IntegerL), Exp (LitE))
#endif


-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.
data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
Expand Down Expand Up @@ -216,10 +218,6 @@ word a b c d = (fromIntegral a `unsafeShiftL` 24)
.|. (fromIntegral c `unsafeShiftL` 8)
.|. (fromIntegral d )

-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
byte :: Int -> Word64 -> Word8
byte i w = fromIntegral (w `shiftR` (i * 8))

-- |Build a Word16 from two Word8 values, presented in big-endian order.
w8to16 :: Word8 -> Word8 -> Word16
w8to16 w0s w1s =
Expand Down Expand Up @@ -266,11 +264,7 @@ buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3

-- |Return the bytes that make up the UUID
toList :: UUID -> [Word8]
toList (UUID w0 w1) =
[byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0,
byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1,
byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1]
toList = B.unpack . toStrictByteString

-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
-- exactly sixteen bytes long
Expand Down Expand Up @@ -301,11 +295,21 @@ nil = UUID 0 0
fromByteString :: BL.ByteString -> Maybe UUID
fromByteString = fromList . BL.unpack

networkOrderUUIDFixedPrim :: BBP.FixedPrim UUID
networkOrderUUIDFixedPrim = toWords64 BBP.>$< wordFixedPrim
where
wordFixedPrim :: BBP.FixedPrim (Word64, Word64)
wordFixedPrim = BBP.word64BE BBP.>*< BBP.word64BE

-- |Encode a UUID into a 'ByteString' in network order.
--
-- This uses the same encoding as the 'Binary' instance.
toByteString :: UUID -> BL.ByteString
toByteString = BL.pack . toList
toByteString = BL.fromStrict . toStrictByteString

toStrictByteString :: UUID -> B.ByteString
toStrictByteString uuid = BBI.unsafeCreate 16 $ BBPI.runF networkOrderUUIDFixedPrim uuid


-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
-- The hyphens may not be omitted.
Expand Down Expand Up @@ -341,7 +345,7 @@ fromString' s0 = do
octet = fromIntegral (16 * digitToInt hi + digitToInt lo)
hexByte _ = Nothing

-- | Convert a UUID into a hypenated string using lower-case letters.
-- | Convert a UUID into a hyphenated string using lower-case letters.
-- Example:
--
-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"
Expand Down Expand Up @@ -374,60 +378,34 @@ toString uuid = hexw0 w0 $ hexw1 w1 ""
fromText :: Text -> Maybe UUID
fromText = fromASCIIBytes . T.encodeUtf8

-- | Convert a UUID into a hyphentated string using lower-case letters.
-- | Convert a UUID into a hyphenated string using lower-case letters.
toText :: UUID -> Text
toText = T.decodeLatin1 . toASCIIBytes

-- | Convert a UUID into a hyphentated string using lower-case letters, packed
-- | Convert a UUID into a hyphenated string using lower-case letters, packed
-- as ASCII bytes into `B.ByteString`.
--
-- This should be equivalent to `toString` with `Data.ByteString.Char8.pack`.
toASCIIBytes :: UUID -> B.ByteString
toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid)

-- | Helper function for `toASCIIBytes`
pokeASCII :: UUID -> Ptr Word8 -> IO ()
pokeASCII uuid ptr = do
pokeDash 8
pokeDash 13
pokeDash 18
pokeDash 23
pokeSingle 0 w0
pokeDouble 9 w1
pokeDouble 19 w2
pokeSingle 28 w3
toASCIIBytes uuid = BBI.unsafeCreate 36 (BBPI.runF hyphenatedUUIDFixedPrim uuid)

hyphenatedUUIDFixedPrim :: BBP.FixedPrim UUID
hyphenatedUUIDFixedPrim = uuidToByteTuples BBP.>$< wordFixedPrim
where
(w0, w1, w2, w3) = toWords uuid
wordFixedPrim :: BBP.FixedPrim (Word32, (Word16, (Word16, (Word16, (Word16, Word32)))))
wordFixedPrim = BBP.word32HexFixed BBP.>*<
Copy link
Collaborator

@phadej phadej Mar 20, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note to self, the word<N>HexFixed calls into C function in bytestring:

char* _hs_bytestring_uint_hex (unsigned int x, char* buf) {
    // write hex representation in reverse order
    char c, *ptr = buf, *next_free;
    do {
        *ptr++ = digits[x & 0xf];
        x >>= 4;
    } while ( x );
    // invert written digits
    next_free = ptr--;
    while(buf < ptr) {
        c      = *ptr;
        *ptr-- = *buf;
        *buf++ = c;
    }
    return next_free;
};

Fascinating that loop is faster (?) than unrolled version. Maybe GCC does magic. For "random" UUIDs, ther e shouldn't be win in short circuiting the loop.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No, that's wrong, the Fixed variants just split the number into halves:

https://hackage.haskell.org/package/bytestring-0.12.1.0/docs/src/Data.ByteString.Builder.Prim.ASCII.html#word32HexFixed

-- | Encode a 'Word8' using 2 nibbles (hexadecimal digits).
{-# INLINE word8HexFixed #-}
word8HexFixed :: FixedPrim Word8
word8HexFixed = fixedPrim 2 $ \x op -> do
  enc <- encode8_as_16h lowerTable x
  unalignedWriteU16 enc op

-- | Encode a 'Word16' using 4 nibbles.
{-# INLINE word16HexFixed #-}
word16HexFixed :: FixedPrim Word16
word16HexFixed =
    (\x -> (fromIntegral $ x `shiftR` 8, fromIntegral x))
      >$< pairF word8HexFixed word8HexFixed

-- | Encode a 'Word32' using 8 nibbles.
{-# INLINE word32HexFixed #-}
word32HexFixed :: FixedPrim Word32
word32HexFixed =
    (\x -> (fromIntegral $ x `shiftR` 16, fromIntegral x))
      >$< pairF word16HexFixed word16HexFixed

-- | Encode a 'Word64' using 16 nibbles.
{-# INLINE word64HexFixed #-}
word64HexFixed :: FixedPrim Word64
word64HexFixed =
    (\x -> (fromIntegral $ x `shiftR` 32, fromIntegral x))
      >$< pairF word32HexFixed word32HexFixed

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So that's what #80 (comment) was saying

prependDash BBP.word16HexFixed BBP.>*<
prependDash BBP.word16HexFixed BBP.>*<
prependDash BBP.word16HexFixed BBP.>*<
prependDash (BBP.word16HexFixed BBP.>*< BBP.word32HexFixed)

-- ord '-' ==> 45
pokeDash ix = pokeElemOff ptr ix 45

pokeSingle ix w = do
pokeWord ix w 28
pokeWord (ix + 1) w 24
pokeWord (ix + 2) w 20
pokeWord (ix + 3) w 16
pokeWord (ix + 4) w 12
pokeWord (ix + 5) w 8
pokeWord (ix + 6) w 4
pokeWord (ix + 7) w 0

-- We skip the dash in the middle
pokeDouble ix w = do
pokeWord ix w 28
pokeWord (ix + 1) w 24
pokeWord (ix + 2) w 20
pokeWord (ix + 3) w 16
pokeWord (ix + 5) w 12
pokeWord (ix + 6) w 8
pokeWord (ix + 7) w 4
pokeWord (ix + 8) w 0

pokeWord ix w r =
pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf)))

toDigit :: Word32 -> Word32
toDigit w = if w < 10 then 48 + w else 97 + w - 10
uuidToByteTuples :: UUID -> (Word32, (Word16, (Word16, (Word16, (Word16, Word32)))))
uuidToByteTuples uuid =
let (w0, w1, w2, w3) = toWords uuid
in (w0, (fromIntegral $ w1 `shiftR` 16, (fromIntegral w1, (fromIntegral $ w2 `shiftR` 16, (fromIntegral w2, w3)))))

prependDash :: BBP.FixedPrim a -> BBP.FixedPrim a
prependDash fixedPrim = (\x -> ('-', x)) BBP.>$< (BBP.char7 BBP.>*< fixedPrim)

-- | If the passed in `B.ByteString` can be parsed as an ASCII representation of
-- a `UUID`, it will be. The hyphens may not be omitted.
Expand Down Expand Up @@ -470,24 +448,12 @@ fromASCIIBytes bs = do

-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
toLazyASCIIBytes :: UUID -> BL.ByteString
toLazyASCIIBytes =
#if MIN_VERSION_bytestring(0,10,0)
BL.fromStrict
#else
BL.fromChunks . return
#endif
. toASCIIBytes
toLazyASCIIBytes = BL.fromStrict . toASCIIBytes

-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
fromLazyASCIIBytes bs =
if BL.length bs == 36 then fromASCIIBytes (
#if MIN_VERSION_bytestring(0,10,0)
BL.toStrict bs
#else
B.concat $ BL.toChunks bs
#endif
) else Nothing
if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing

--
-- Class Instances
Expand Down
18 changes: 9 additions & 9 deletions uuid-types/uuid-types.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 1.12
name: uuid-types
version: 1.0.5.1
version: 1.0.5.2
copyright:
(c) 2017-2018 Herbert Valerio Riedel
(c) 2008-2014 Antoine Latter
Expand Down Expand Up @@ -50,14 +50,14 @@ source-repository head

library
build-depends:
base >=4.5 && <5
, binary >=0.5.1.0 && <0.9
, bytestring >=0.9.2.1 && <0.13
, deepseq >=1.3.0.0 && <1.6
, hashable >=1.2.7.0 && <1.5
, random >=1.1 && <1.3
, template-haskell >=2.7.0.0 && <2.22
, text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
base >=4.5 && <5
, binary >=0.5.1.0 && <0.9
, bytestring >=0.10.2.0 && <0.13
, deepseq >=1.3.0.0 && <1.6
, hashable >=1.2.7.0 && <1.5
, random >=1.1 && <1.3
, template-haskell >=2.7.0.0 && <2.22
, text >=1.2.3.0 && <1.3 || >=2.0 && <2.2

exposed-modules: Data.UUID.Types

Expand Down
5 changes: 5 additions & 0 deletions uuid/CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,8 @@
1.3.16

- Optimize and refactor functions `toByteString` (3.7x speed increase) and
`toASCIIBytes` (20% speed increase).

1.3.15

- Add (Template Haskell) `Lift UUID` instance
Expand Down
22 changes: 11 additions & 11 deletions uuid/uuid.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 1.12
name: uuid
version: 1.3.15
version: 1.3.16
x-revision: 3
copyright: (c) 2008-2014 Antoine Latter
author: Antoine Latter
Expand Down Expand Up @@ -46,16 +46,16 @@ source-repository head

library
build-depends:
base >=4.5 && <5
, binary >=0.5.1.0 && <0.9
, bytestring >=0.9.2.1 && <0.13
, cryptohash-md5 >=0.11.100 && <0.12
, cryptohash-sha1 >=0.11.100 && <0.12
, entropy >=0.3.7 && <0.5
, network-info >=0.2 && <0.3
, random >=1.1 && <1.3
, text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
, time >=1.4 && <1.13
base >=4.5 && <5
, binary >=0.5.1.0 && <0.9
, bytestring >=0.10.2.0 && <0.13
, cryptohash-md5 >=0.11.100 && <0.12
, cryptohash-sha1 >=0.11.100 && <0.12
, entropy >=0.3.7 && <0.5
, network-info >=0.2 && <0.3
, random >=1.1 && <1.3
, text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
, time >=1.4 && <1.13

-- strict dependency on uuid-types,
-- as we re-rexport datatype, thus leak instances etc.
Expand Down