ptr-poker 0.1 → 0.1.1
raw patch · 8 files changed
+350/−1 lines, 8 filesdep +gauge
Dependencies added: gauge
Files
- bench/Main.hs +57/−0
- cbits/text.c +232/−0
- library/PtrPoker/Ffi.hs +8/−0
- library/PtrPoker/Poke.hs +7/−0
- library/PtrPoker/Size.hs +11/−0
- library/PtrPoker/Write.hs +6/−0
- ptr-poker.cabal +14/−1
- test/Main.hs +15/−0
+ bench/Main.hs view
@@ -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)+ ]+ ]+ ]+ ]
+ cbits/text.c view
@@ -0,0 +1,232 @@+/*+ * Copyright (c) 2020 Nikita Volkov <nikita.y.volkov@mail.ru>.+ *+ * Portions copyright (c) 2011 Bryan O'Sullivan <bos@serpentine.com>.+ *+ * Portions copyright (c) 2008-2010 Björn Höhrmann <bjoern@hoehrmann.de>.+ *+ * See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.+ */++#include <string.h>+#include <stdbool.h>+#include <stdint.h>+#include <stdio.h>+++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
library/PtrPoker/Ffi.hs view
@@ -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)
library/PtrPoker/Poke.hs view
@@ -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
library/PtrPoker/Size.hs view
@@ -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
library/PtrPoker/Write.hs view
@@ -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)
ptr-poker.cabal view
@@ -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
test/Main.hs view
@@ -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