diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,57 @@ +module Main where + +import Prelude +import Gauge.Main +import qualified PtrPoker.Write as Write +import qualified Data.Text.Encoding as Text + + +main = + defaultMain [ + bgroup "textUtf8" $ let + latinSampleBySize size = + enumFromTo 'a' 'z' & + replicate size & + concat & + fromString + greekSampleBySize size = + enumFromTo 'Α' 'Ω' & + replicate size & + concat & + fromString + !latinSample1 = latinSampleBySize 1 + !latinSample10 = latinSampleBySize 10 + !latinSample100 = latinSampleBySize 100 + !greekSample1 = greekSampleBySize 1 + !greekSample10 = greekSampleBySize 10 + !greekSample100 = greekSampleBySize 100 + in [ + bgroup "ptr-poker" [ + bgroup "latin" [ + bench "1" (nf (Write.writeToByteString . Write.textUtf8) latinSample1), + bench "10" (nf (Write.writeToByteString . Write.textUtf8) latinSample10), + bench "100" (nf (Write.writeToByteString . Write.textUtf8) latinSample100) + ] + , + bgroup "greek" [ + bench "1" (nf (Write.writeToByteString . Write.textUtf8) greekSample1), + bench "10" (nf (Write.writeToByteString . Write.textUtf8) greekSample10), + bench "100" (nf (Write.writeToByteString . Write.textUtf8) greekSample100) + ] + ] + , + bgroup "text" [ + bgroup "latin" [ + bench "1" (nf Text.encodeUtf8 latinSample1), + bench "10" (nf Text.encodeUtf8 latinSample10), + bench "100" (nf Text.encodeUtf8 latinSample100) + ] + , + bgroup "greek" [ + bench "1" (nf Text.encodeUtf8 greekSample1), + bench "10" (nf Text.encodeUtf8 greekSample10), + bench "100" (nf Text.encodeUtf8 greekSample100) + ] + ] + ] + ] diff --git a/cbits/text.c b/cbits/text.c new file mode 100644 --- /dev/null +++ b/cbits/text.c @@ -0,0 +1,232 @@ +/* + * Copyright (c) 2020 Nikita Volkov . + * + * Portions copyright (c) 2011 Bryan O'Sullivan . + * + * Portions copyright (c) 2008-2010 Björn Höhrmann . + * + * See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details. + */ + +#include +#include +#include +#include + + +uint8_t* encode_text +( + uint8_t *dest, + const uint16_t *src, + size_t src_offset, + size_t src_length +) +#if defined(__x86_64__) +{ + + src += src_offset; + + const uint16_t* src_end = src + src_length; + const uint16_t* full_word_src_end = src_end - 4; + + while (src < src_end) { + uint16_t x = *src++; + + if (x <= 0x7F) { + *dest++ = x; + + while (src < full_word_src_end) { + uint64_t x = *((uint64_t *) src); + + if (x & 0xFF80FF80FF80FF80ULL) { + if (!(x & 0x000000000000FF80ULL)) { + *dest++ = x & 0xFFFF; + src++; + if (!(x & 0x00000000FF800000ULL)) { + *dest++ = (x >> 16) & 0xFFFF; + src++; + if (!(x & 0x0000FF8000000000ULL)) { + *dest++ = (x >> 32) & 0xFFFF; + src++; + } + } + } + break; + } + + *dest++ = x & 0xFFFF; + *dest++ = (x >> 16) & 0xFFFF; + *dest++ = (x >> 32) & 0xFFFF; + *dest++ = x >> 48; + src += 4; + } + } + else if (x <= 0x7FF) { + *dest++ = (x >> 6) | 0xC0; + *dest++ = (x & 0x3f) | 0x80; + } + else if (x < 0xD800 || x > 0xDBFF) { + *dest++ = (x >> 12) | 0xE0; + *dest++ = ((x >> 6) & 0x3F) | 0x80; + *dest++ = (x & 0x3F) | 0x80; + } else { + uint32_t c = + ((((uint32_t) x) - 0xD800) << 10) + + (((uint32_t) *src++) - 0xDC00) + 0x10000; + *dest++ = (c >> 18) | 0xF0; + *dest++ = ((c >> 12) & 0x3F) | 0x80; + *dest++ = ((c >> 6) & 0x3F) | 0x80; + *dest++ = (c & 0x3F) | 0x80; + } + } + + return dest; +} +#elif defined(__i386__) +{ + + src += src_offset; + + const uint16_t* src_end = src + src_length; + const uint16_t* full_word_src_end = src_end - 2; + + while (src < src_end) { + uint16_t x = *src++; + + if (x <= 0x7F) { + *dest++ = x; + + while (src < full_word_src_end) { + uint32_t x = *((uint32_t *) src); + + if (x & 0xFF80FF80) + break; + *dest++ = x & 0xFFFF; + *dest++ = x >> 16; + src += 2; + } + + } + else if (x <= 0x7FF) { + *dest++ = (x >> 6) | 0xC0; + *dest++ = (x & 0x3f) | 0x80; + } + else if (x < 0xD800 || x > 0xDBFF) { + *dest++ = (x >> 12) | 0xE0; + *dest++ = ((x >> 6) & 0x3F) | 0x80; + *dest++ = (x & 0x3F) | 0x80; + } else { + uint32_t c = + ((((uint32_t) x) - 0xD800) << 10) + + (((uint32_t) *src++) - 0xDC00) + 0x10000; + *dest++ = (c >> 18) | 0xF0; + *dest++ = ((c >> 12) & 0x3F) | 0x80; + *dest++ = ((c >> 6) & 0x3F) | 0x80; + *dest++ = (c & 0x3F) | 0x80; + } + } + + return dest; +} +#endif + + +int count_text_allocation_size +( + const uint16_t *src_ptr, + size_t src_off, + size_t src_len +) +#if defined(__x86_64__) +{ + src_ptr += src_off; + + const uint16_t* after_src_ptr = src_ptr + src_len; + const uint16_t* full_word_after_src_ptr = after_src_ptr - 4; + + size_t size = 0; + + while (src_ptr < after_src_ptr) { + uint16_t w = *src_ptr++; + + if (w <= 0x7F) { + size += 1; + + /* Try to go in batches of 4 bytes. */ + while (src_ptr < full_word_after_src_ptr) { + uint64_t x = *((uint64_t*) src_ptr); + + if (x & 0xFF80FF80FF80FF80ULL) { + if (!(x & 0x000000000000FF80ULL)) { + size++; + src_ptr++; + if (!(x & 0x00000000FF800000ULL)) { + size++; + src_ptr++; + if (!(x & 0x0000FF8000000000ULL)) { + size++; + src_ptr++; + } + } + } + break; + } + + size += 4; + src_ptr += 4; + } + + } + else if (w <= 0x7FF) { + size += 2; + } + else if (w < 0xD800 || w > 0xDBFF) { + size += 3; + } else { + src_ptr++; + size += 4; + } + } + + return size; +} +#elif defined(__i386__) +{ + src_ptr += src_off; + + const uint16_t* after_src_ptr = src_ptr + src_len; + const uint16_t* full_word_after_src_ptr = after_src_ptr - 2; + + size_t size = 0; + + while (src_ptr < after_src_ptr) { + uint16_t w = *src_ptr++; + + if (w <= 0x7F) { + size += 1; + + /* Try to go in batches of 2 bytes. */ + while (src_ptr < full_word_after_src_ptr) { + uint32_t x = *((uint32_t *) src_ptr); + + if (x & 0xFF80FF80) break; + + size += 2; + src_ptr += 2; + } + + } + else if (w <= 0x7FF) { + size += 2; + } + else if (w < 0xD800 || w > 0xDBFF) { + size += 3; + } else { + src_ptr++; + size += 4; + } + } + + return size; +} +#endif diff --git a/library/PtrPoker/Ffi.hs b/library/PtrPoker/Ffi.hs --- a/library/PtrPoker/Ffi.hs +++ b/library/PtrPoker/Ffi.hs @@ -1,8 +1,10 @@ +{-# LANGUAGE UnliftedFFITypes #-} module PtrPoker.Ffi where import PtrPoker.Prelude import Foreign.C +import GHC.Base (ByteArray#, MutableByteArray#) foreign import ccall unsafe "static int_dec" @@ -31,3 +33,9 @@ foreign import ccall unsafe "static dtoa_grisu3" pokeDouble :: Double -> Ptr Word8 -> IO CInt + +foreign import ccall unsafe "static count_text_allocation_size" + countTextAllocationSize :: ByteArray# -> CSize -> CSize -> IO CInt + +foreign import ccall unsafe "static encode_text" + encodeText :: Ptr Word8 -> ByteArray# -> CSize -> CSize -> IO (Ptr Word8) diff --git a/library/PtrPoker/Poke.hs b/library/PtrPoker/Poke.hs --- a/library/PtrPoker/Poke.hs +++ b/library/PtrPoker/Poke.hs @@ -5,6 +5,8 @@ import qualified PtrPoker.IO.ByteString as ByteStringIO import qualified PtrPoker.IO.Prim as PrimIO import qualified PtrPoker.Ffi as Ffi +import qualified Data.Text.Internal as Text +import qualified Data.Text.Array as TextArray {-# RULES @@ -58,6 +60,11 @@ bWord64 :: Word64 -> Poke bWord64 a = Poke (\ p -> PrimIO.pokeBEWord64 p a $> plusPtr p 8) + +{-# INLINE textUtf8 #-} +textUtf8 :: Text -> Poke +textUtf8 (Text.Text arr off len) = + Poke (\ p -> Ffi.encodeText p (TextArray.aBA arr) (fromIntegral off) (fromIntegral len)) -- * ASCII integers diff --git a/library/PtrPoker/Size.hs b/library/PtrPoker/Size.hs --- a/library/PtrPoker/Size.hs +++ b/library/PtrPoker/Size.hs @@ -5,6 +5,9 @@ where import PtrPoker.Prelude +import qualified Data.Text.Internal as Text +import qualified Data.Text.Array as TextArray +import qualified PtrPoker.Ffi as Ffi {-# INLINE word64AsciiDec #-} @@ -128,3 +131,11 @@ else if x > 9 then 2 else 1 + +{-# INLINE textUtf8 #-} +textUtf8 :: Text -> Int +textUtf8 (Text.Text arr off len) = + Ffi.countTextAllocationSize + (TextArray.aBA arr) (fromIntegral off) (fromIntegral len) + & unsafeDupablePerformIO + & fromIntegral diff --git a/library/PtrPoker/Write.hs b/library/PtrPoker/Write.hs --- a/library/PtrPoker/Write.hs +++ b/library/PtrPoker/Write.hs @@ -12,6 +12,7 @@ import qualified Data.ByteString.Internal as ByteString +{-# INLINABLE writeToByteString #-} writeToByteString :: Write -> ByteString writeToByteString Write{..} = ByteString.unsafeCreate writeSize (void . Poke.pokePtr writePoke) @@ -120,3 +121,8 @@ byteString :: ByteString -> Write byteString a = Write (ByteString.length a) (Poke.byteString a) + +{-# INLINE textUtf8 #-} +textUtf8 :: Text -> Write +textUtf8 a = + Write (Size.textUtf8 a) (Poke.textUtf8 a) diff --git a/ptr-poker.cabal b/ptr-poker.cabal --- a/ptr-poker.cabal +++ b/ptr-poker.cabal @@ -1,5 +1,5 @@ name: ptr-poker -version: 0.1 +version: 0.1.1 synopsis: Pointer poking action construction and composition toolkit homepage: https://github.com/nikita-volkov/ptr-poker bug-reports: https://github.com/nikita-volkov/ptr-poker/issues @@ -34,6 +34,7 @@ cbits/dtoa.c cbits/int_encoding.c cbits/itoa.c + cbits/text.c build-depends: base >=4.11 && <5, bytestring >=0.10 && <0.12, @@ -49,5 +50,17 @@ build-depends: hedgehog >=1.0.3 && <2, numeric-limits >=0.1 && <0.2, + ptr-poker, + rerebase >=1.10.0.1 && <2 + +benchmark bench + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Main.hs + ghc-options: -O2 -threaded "-with-rtsopts=-N" + default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples, ViewPatterns + default-language: Haskell2010 + build-depends: + gauge >=0.2.5 && <0.3, ptr-poker, rerebase >=1.10.0.1 && <2 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -6,6 +6,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Data.ByteString.Char8 as Char8ByteString +import qualified Data.Text.Encoding as Text import qualified PtrPoker.Write as Write import qualified PtrPoker.Size as Size import qualified Numeric.Limits as NumericLimits @@ -79,6 +80,20 @@ Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a)) annotate string read string === 0 + +prop_sizeOfTextUtf8 = + withTests 999 $ + property $ do + a <- forAll (Gen.text (Range.exponential 0 9999) Gen.unicode) + Size.textUtf8 a + === Char8ByteString.length (Text.encodeUtf8 a) + +prop_textUtf8 = + withTests 999 $ + property $ do + a <- forAll (Gen.text (Range.exponential 0 9999) Gen.unicode) + Write.writeToByteString (Write.textUtf8 a) + === Text.encodeUtf8 a -- * Gens