ptr-poker 0.1.2.16 → 0.1.3
raw patch · 35 files changed
+2306/−2280 lines, 35 filesdep +QuickCheckdep +hspecdep −hedgehog
Dependencies added: QuickCheck, hspec
Dependencies removed: hedgehog
Files
- bench/Main.hs +0/−72
- cbits/dtoa.c +0/−383
- cbits/int_encoding.c +0/−65
- cbits/itoa.c +0/−216
- cbits/text.c +0/−232
- library/PtrPoker/ByteString.hs +0/−43
- library/PtrPoker/Compat/ByteString.hs +0/−29
- library/PtrPoker/Compat/ForeignPtr.hs +0/−33
- library/PtrPoker/Compat/Text.hs +0/−62
- library/PtrPoker/Ffi.hs +0/−39
- library/PtrPoker/IO/Prim.hs +0/−95
- library/PtrPoker/Poke.hs +0/−246
- library/PtrPoker/Prelude.hs +0/−78
- library/PtrPoker/Size.hs +0/−203
- library/PtrPoker/Write.hs +0/−270
- ptr-poker.cabal +18/−10
- src/bench/Main.hs +72/−0
- src/cbits/dtoa.c +383/−0
- src/cbits/int_encoding.c +65/−0
- src/cbits/itoa.c +216/−0
- src/cbits/text.c +232/−0
- src/library/PtrPoker/ByteString.hs +43/−0
- src/library/PtrPoker/Compat/ByteString.hs +29/−0
- src/library/PtrPoker/Compat/ForeignPtr.hs +33/−0
- src/library/PtrPoker/Compat/Text.hs +62/−0
- src/library/PtrPoker/Ffi.hs +39/−0
- src/library/PtrPoker/IO/Prim.hs +95/−0
- src/library/PtrPoker/Poke.hs +246/−0
- src/library/PtrPoker/Prelude.hs +78/−0
- src/library/PtrPoker/Size.hs +203/−0
- src/library/PtrPoker/Write.hs +284/−0
- src/test/Main.hs +1/−0
- src/test/SizeSpec.hs +40/−0
- src/test/WriteSpec.hs +167/−0
- test/Main.hs +0/−204
− bench/Main.hs
@@ -1,72 +0,0 @@-module Main where--import Criterion.Main-import qualified Data.Text.Encoding as Text-import qualified PtrPoker.Write as Write-import Prelude--main :: IO ()-main =- defaultMain- [ bgroup- "bWord32"- [ bench "4"- $ nf- ( \(a, b, c, d) ->- Write.writeToByteString- $ Write.bWord32 a- <> Write.bWord32 b- <> Write.bWord32 c- <> Write.bWord32 d- )- (1, 2, 3, 4)- ],- 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/dtoa.c
@@ -1,383 +0,0 @@-/*-Copyright https://github.com/juj--Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at-- http://www.apache.org/licenses/LICENSE-2.0--Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.--*/-// modified version of https://github.com/juj/MathGeoLib/blob/master/src/Math/grisu3.c-/* This file is part of an implementation of the "grisu3" double to string- conversion algorithm described in the research paper- "Printing Floating-Point Numbers Quickly And Accurately with Integers"- by Florian Loitsch, available at- http://www.cs.tufts.edu/~nr/cs257/archive/florian-loitsch/printf.pdf */--#include <stdint.h> // uint64_t etc.-#include <assert.h> // assert-#include <math.h> // ceil-#include <stdio.h> // sprintf--#ifdef _MSC_VER-#pragma warning(disable : 4204) // nonstandard extension used : non-constant aggregate initializer-#endif--#define D64_SIGN 0x8000000000000000ULL-#define D64_EXP_MASK 0x7FF0000000000000ULL-#define D64_FRACT_MASK 0x000FFFFFFFFFFFFFULL-#define D64_IMPLICIT_ONE 0x0010000000000000ULL-#define D64_EXP_POS 52-#define D64_EXP_BIAS 1075-#define DIYFP_FRACT_SIZE 64-#define D_1_LOG2_10 0.30102999566398114 // 1 / lg(10)-#define MIN_TARGET_EXP -60-#define MASK32 0xFFFFFFFFULL--#define CAST_U64(d) (*(uint64_t*)&d)-#define MIN(x,y) ((x) <= (y) ? (x) : (y))-#define MAX(x,y) ((x) >= (y) ? (x) : (y))--#define MIN_CACHED_EXP -348-#define CACHED_EXP_STEP 8--typedef struct diy_fp-{- uint64_t f;- int e;-} diy_fp;--typedef struct power-{- uint64_t fract;- int16_t b_exp, d_exp;-} power;--static const power pow_cache[] =-{- { 0xfa8fd5a0081c0288ULL, -1220, -348 },- { 0xbaaee17fa23ebf76ULL, -1193, -340 },- { 0x8b16fb203055ac76ULL, -1166, -332 },- { 0xcf42894a5dce35eaULL, -1140, -324 },- { 0x9a6bb0aa55653b2dULL, -1113, -316 },- { 0xe61acf033d1a45dfULL, -1087, -308 },- { 0xab70fe17c79ac6caULL, -1060, -300 },- { 0xff77b1fcbebcdc4fULL, -1034, -292 },- { 0xbe5691ef416bd60cULL, -1007, -284 },- { 0x8dd01fad907ffc3cULL, -980, -276 },- { 0xd3515c2831559a83ULL, -954, -268 },- { 0x9d71ac8fada6c9b5ULL, -927, -260 },- { 0xea9c227723ee8bcbULL, -901, -252 },- { 0xaecc49914078536dULL, -874, -244 },- { 0x823c12795db6ce57ULL, -847, -236 },- { 0xc21094364dfb5637ULL, -821, -228 },- { 0x9096ea6f3848984fULL, -794, -220 },- { 0xd77485cb25823ac7ULL, -768, -212 },- { 0xa086cfcd97bf97f4ULL, -741, -204 },- { 0xef340a98172aace5ULL, -715, -196 },- { 0xb23867fb2a35b28eULL, -688, -188 },- { 0x84c8d4dfd2c63f3bULL, -661, -180 },- { 0xc5dd44271ad3cdbaULL, -635, -172 },- { 0x936b9fcebb25c996ULL, -608, -164 },- { 0xdbac6c247d62a584ULL, -582, -156 },- { 0xa3ab66580d5fdaf6ULL, -555, -148 },- { 0xf3e2f893dec3f126ULL, -529, -140 },- { 0xb5b5ada8aaff80b8ULL, -502, -132 },- { 0x87625f056c7c4a8bULL, -475, -124 },- { 0xc9bcff6034c13053ULL, -449, -116 },- { 0x964e858c91ba2655ULL, -422, -108 },- { 0xdff9772470297ebdULL, -396, -100 },- { 0xa6dfbd9fb8e5b88fULL, -369, -92 },- { 0xf8a95fcf88747d94ULL, -343, -84 },- { 0xb94470938fa89bcfULL, -316, -76 },- { 0x8a08f0f8bf0f156bULL, -289, -68 },- { 0xcdb02555653131b6ULL, -263, -60 },- { 0x993fe2c6d07b7facULL, -236, -52 },- { 0xe45c10c42a2b3b06ULL, -210, -44 },- { 0xaa242499697392d3ULL, -183, -36 },- { 0xfd87b5f28300ca0eULL, -157, -28 },- { 0xbce5086492111aebULL, -130, -20 },- { 0x8cbccc096f5088ccULL, -103, -12 },- { 0xd1b71758e219652cULL, -77, -4 },- { 0x9c40000000000000ULL, -50, 4 },- { 0xe8d4a51000000000ULL, -24, 12 },- { 0xad78ebc5ac620000ULL, 3, 20 },- { 0x813f3978f8940984ULL, 30, 28 },- { 0xc097ce7bc90715b3ULL, 56, 36 },- { 0x8f7e32ce7bea5c70ULL, 83, 44 },- { 0xd5d238a4abe98068ULL, 109, 52 },- { 0x9f4f2726179a2245ULL, 136, 60 },- { 0xed63a231d4c4fb27ULL, 162, 68 },- { 0xb0de65388cc8ada8ULL, 189, 76 },- { 0x83c7088e1aab65dbULL, 216, 84 },- { 0xc45d1df942711d9aULL, 242, 92 },- { 0x924d692ca61be758ULL, 269, 100 },- { 0xda01ee641a708deaULL, 295, 108 },- { 0xa26da3999aef774aULL, 322, 116 },- { 0xf209787bb47d6b85ULL, 348, 124 },- { 0xb454e4a179dd1877ULL, 375, 132 },- { 0x865b86925b9bc5c2ULL, 402, 140 },- { 0xc83553c5c8965d3dULL, 428, 148 },- { 0x952ab45cfa97a0b3ULL, 455, 156 },- { 0xde469fbd99a05fe3ULL, 481, 164 },- { 0xa59bc234db398c25ULL, 508, 172 },- { 0xf6c69a72a3989f5cULL, 534, 180 },- { 0xb7dcbf5354e9beceULL, 561, 188 },- { 0x88fcf317f22241e2ULL, 588, 196 },- { 0xcc20ce9bd35c78a5ULL, 614, 204 },- { 0x98165af37b2153dfULL, 641, 212 },- { 0xe2a0b5dc971f303aULL, 667, 220 },- { 0xa8d9d1535ce3b396ULL, 694, 228 },- { 0xfb9b7cd9a4a7443cULL, 720, 236 },- { 0xbb764c4ca7a44410ULL, 747, 244 },- { 0x8bab8eefb6409c1aULL, 774, 252 },- { 0xd01fef10a657842cULL, 800, 260 },- { 0x9b10a4e5e9913129ULL, 827, 268 },- { 0xe7109bfba19c0c9dULL, 853, 276 },- { 0xac2820d9623bf429ULL, 880, 284 },- { 0x80444b5e7aa7cf85ULL, 907, 292 },- { 0xbf21e44003acdd2dULL, 933, 300 },- { 0x8e679c2f5e44ff8fULL, 960, 308 },- { 0xd433179d9c8cb841ULL, 986, 316 },- { 0x9e19db92b4e31ba9ULL, 1013, 324 },- { 0xeb96bf6ebadf77d9ULL, 1039, 332 },- { 0xaf87023b9bf0ee6bULL, 1066, 340 }-};--static int cached_pow(int exp, diy_fp *p)-{- int k = (int)ceil((exp+DIYFP_FRACT_SIZE-1) * D_1_LOG2_10);- int i = (k-MIN_CACHED_EXP-1) / CACHED_EXP_STEP + 1;- p->f = pow_cache[i].fract;- p->e = pow_cache[i].b_exp;- return pow_cache[i].d_exp;-}--static diy_fp minus(diy_fp x, diy_fp y)-{- diy_fp d; d.f = x.f - y.f; d.e = x.e;- assert(x.e == y.e && x.f >= y.f);- return d;-}--static diy_fp multiply(diy_fp x, diy_fp y)-{- uint64_t a, b, c, d, ac, bc, ad, bd, tmp;- diy_fp r;- a = x.f >> 32; b = x.f & MASK32;- c = y.f >> 32; d = y.f & MASK32;- ac = a*c; bc = b*c;- ad = a*d; bd = b*d;- tmp = (bd >> 32) + (ad & MASK32) + (bc & MASK32);- tmp += 1U << 31; // round- r.f = ac + (ad >> 32) + (bc >> 32) + (tmp >> 32);- r.e = x.e + y.e + 64;- return r;-}--static diy_fp normalize_diy_fp(diy_fp n)-{- assert(n.f != 0);- while(!(n.f & 0xFFC0000000000000ULL)) { n.f <<= 10; n.e -= 10; }- while(!(n.f & D64_SIGN)) { n.f <<= 1; --n.e; }- return n;-}--static diy_fp double2diy_fp(double d)-{- diy_fp fp;- uint64_t u64 = CAST_U64(d);- if (!(u64 & D64_EXP_MASK)) { fp.f = u64 & D64_FRACT_MASK; fp.e = 1 - D64_EXP_BIAS; }- else { fp.f = (u64 & D64_FRACT_MASK) + D64_IMPLICIT_ONE; fp.e = (int)((u64 & D64_EXP_MASK) >> D64_EXP_POS) - D64_EXP_BIAS; }- return fp;-}--// pow10_cache[i] = 10^(i-1)-static const unsigned int pow10_cache[] = { 0, 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000 };--static int largest_pow10(uint32_t n, int n_bits, uint32_t *power)-{- int guess = ((n_bits + 1) * 1233 >> 12) + 1/*skip first entry*/;- if (n < pow10_cache[guess]) --guess; // We don't have any guarantees that 2^n_bits <= n.- *power = pow10_cache[guess];- return guess;-}--static int round_weed(char *buffer, int len, uint64_t wp_W, uint64_t delta, uint64_t rest, uint64_t ten_kappa, uint64_t ulp)-{- uint64_t wp_Wup = wp_W - ulp;- uint64_t wp_Wdown = wp_W + ulp;- while(rest < wp_Wup && delta - rest >= ten_kappa- && (rest + ten_kappa < wp_Wup || wp_Wup - rest >= rest + ten_kappa - wp_Wup))- {- --buffer[len-1];- rest += ten_kappa;- }- if (rest < wp_Wdown && delta - rest >= ten_kappa- && (rest + ten_kappa < wp_Wdown || wp_Wdown - rest > rest + ten_kappa - wp_Wdown))- return 0;-- return 2*ulp <= rest && rest <= delta - 4*ulp;-}--static int digit_gen(diy_fp low, diy_fp w, diy_fp high, char *buffer, int *length, int *kappa)-{- uint64_t unit = 1;- diy_fp too_low = { low.f - unit, low.e };- diy_fp too_high = { high.f + unit, high.e };- diy_fp unsafe_interval = minus(too_high, too_low);- diy_fp one = { 1ULL << -w.e, w.e };- uint32_t p1 = (uint32_t)(too_high.f >> -one.e);- uint64_t p2 = too_high.f & (one.f - 1);- uint32_t div;- *kappa = largest_pow10(p1, DIYFP_FRACT_SIZE + one.e, &div);- *length = 0;-- while(*kappa > 0)- {- uint64_t rest;- int digit = p1 / div;- buffer[*length] = (char)('0' + digit);- ++*length;- p1 %= div;- --*kappa;- rest = ((uint64_t)p1 << -one.e) + p2;- if (rest < unsafe_interval.f) return round_weed(buffer, *length, minus(too_high, w).f, unsafe_interval.f, rest, (uint64_t)div << -one.e, unit);- div /= 10;- }-- for(;;)- {- int digit;- p2 *= 10;- unit *= 10;- unsafe_interval.f *= 10;- // Integer division by one.- digit = (int)(p2 >> -one.e);- buffer[*length] = (char)('0' + digit);- ++*length;- p2 &= one.f - 1; // Modulo by one.- --*kappa;- if (p2 < unsafe_interval.f) return round_weed(buffer, *length, minus(too_high, w).f * unit, unsafe_interval.f, p2, one.f, unit);- }-}--int grisu3(double v, char *buffer, int *length, int *d_exp)-{- int mk, kappa, success;- diy_fp dfp = double2diy_fp(v);- diy_fp w = normalize_diy_fp(dfp);-- // normalize boundaries- diy_fp t = { (dfp.f << 1) + 1, dfp.e - 1 };- diy_fp b_plus = normalize_diy_fp(t);- diy_fp b_minus;- diy_fp c_mk; // Cached power of ten: 10^-k- uint64_t u64 = CAST_U64(v);- assert(v > 0 && v <= 1.7976931348623157e308); // Grisu only handles strictly positive finite numbers.- if (!(u64 & D64_FRACT_MASK) && (u64 & D64_EXP_MASK) != 0) { b_minus.f = (dfp.f << 2) - 1; b_minus.e = dfp.e - 2;} // lower boundary is closer?- else { b_minus.f = (dfp.f << 1) - 1; b_minus.e = dfp.e - 1; }- b_minus.f = b_minus.f << (b_minus.e - b_plus.e);- b_minus.e = b_plus.e;-- mk = cached_pow(MIN_TARGET_EXP - DIYFP_FRACT_SIZE - w.e, &c_mk);-- w = multiply(w, c_mk);- b_minus = multiply(b_minus, c_mk);- b_plus = multiply(b_plus, c_mk);-- success = digit_gen(b_minus, w, b_plus, buffer, length, &kappa);- *d_exp = kappa - mk;- return success;-}--static int i_to_str(int val, char *str)-{- int len, i;- char *s;- char *begin = str;- if (val < 0) { *str++ = '-'; val = -val; }- s = str;-- for(;;)- {- int ni = val / 10;- int digit = val - ni*10;- *s++ = (char)('0' + digit);- if (ni == 0)- break;- val = ni;- }- *s = '\0';- len = (int)(s - str);- for(i = 0; i < len/2; ++i)- {- char ch = str[i];- str[i] = str[len-1-i];- str[len-1-i] = ch;- }-- return (int)(s - begin);-}--int dtoa_grisu3(double v, char *dst)-{- int d_exp, len, decimals, i;-- int success = grisu3(v, dst, &len, &d_exp);- // If grisu3 was not able to convert the number to a string, then use old sprintf (suboptimal).- if (!success) return sprintf(dst, "%.17g", v) + (int)(dst - dst);-- // We now have an integer string of form "151324135" and a base-10 exponent for that number.- // Next, decide the best presentation for that string by whether to use a decimal point, or the scientific exponent notation 'e'.- // We don't pick the absolute shortest representation, but pick a balance between readability and shortness, e.g.- // 1.545056189557677e-308 could be represented in a shorter form- // 1545056189557677e-323 but that would be somewhat unreadable.- decimals = MIN(-d_exp, MAX(1, len-1));- if (d_exp < 0 && len > 1) // Add decimal point?- {- int dot_pos = len-decimals;- if (dot_pos == 0) {- for(i = 0; i < decimals; ++i) {- dst[len-i+1] = dst[len-i-1];- }- // put a 0 in front of the decimal point to make it a valid Haskell floating point number.- dst[0] = '0';- dst[1] = '.';- len+= 2;- } else {- for(i = 0; i < decimals; ++i) {- dst[len-i] = dst[len-i-1];- }- dst[dot_pos] = '.';- len++;- }-- d_exp += decimals;- // Need scientific notation as well?- if (d_exp != 0) { dst[len++] = 'e'; len += i_to_str(d_exp, dst+len); }- }- else if (d_exp < 0 && d_exp >= -3) // Add decimal point for numbers of form 0.000x where it's shorter?- {- // len here is 1!- dst[1-d_exp] = dst[0];- // put a 0 in front of the decimal point to make it a valid Haskell floating point number.- dst[0] = '0';- dst[1] = '.';- for(i = 2; i < (1-d_exp); ++i) dst[i] = '0';- len += -d_exp+1;- }- // Add scientific notation?- else if (d_exp < 0 || d_exp > 2) { dst[len++] = 'e'; len += i_to_str(d_exp, dst+len); }- // Add zeroes instead of scientific notation?- else if (d_exp > 0) { while(d_exp-- > 0) dst[len++] = '0'; }- // dst[len] = '\0'; // grisu3 doesn't null terminate, so ensure termination.- return (int)(dst+len-dst);-}
− cbits/int_encoding.c
@@ -1,65 +0,0 @@-/*- * Copyright (c) 2020 Nikita Volkov <nikita.y.volkov@mail.ru>.- */--#include <string.h>-#include <stdbool.h>-#include <stdint.h>-#include <stdio.h>-#include <stdlib.h>---void rev_poke_int64-(- int64_t val,- uint8_t* dst-)-{- bool negate = false;-- if (val < 0)- {- int64_t b4 = val;- val /= 10;- if (val)- {- *--dst = val * 10 - b4 + 48;- val = -val;- negate = true;- }- else- {- *(dst - 1) = val * 10 - b4 + 48;- *(dst - 2) = '-';- return;- }- }-- do- {- int64_t b4 = val;- val /= 10;- *--dst = b4 - val * 10 + 48;- }- while (val);-- if (negate)- {- *--dst = '-';- }-}--void rev_poke_uint64-(- uint64_t val,- uint8_t* dst-)-{- do- {- uint64_t b4 = val;- val /= 10;- *--dst = b4 - val * 10 + 48;- }- while (val);-}
− cbits/itoa.c
@@ -1,216 +0,0 @@-///////////////////////////////////////////////////////////////-// Encoding numbers using ASCII characters //-// //-// inspired by: http://www.jb.man.ac.uk/~slowe/cpp/itoa.html //-// Borrowed from the "bytestring" library //-///////////////////////////////////////////////////////////////--#include <stdio.h>--// Decimal Encoding-///////////////////--static const char* digits = "0123456789abcdef";--// signed integers-char* int_dec (int x, char* buf)-{- char c, *ptr = buf, *next_free;- int x_tmp;-- // we cannot negate directly as 0 - (minBound :: Int) = minBound- if (x < 0) {- *ptr++ = '-';- buf++;- x_tmp = x;- x /= 10;- *ptr++ = digits[x * 10 - x_tmp];- if (x == 0)- return ptr;- else- x = -x;- }-- // encode positive number as little-endian decimal- do {- x_tmp = x;- x /= 10;- *ptr++ = digits[x_tmp - x * 10];- } while ( x );-- // reverse written digits- next_free = ptr--;- while (buf < ptr) {- c = *ptr;- *ptr-- = *buf;- *buf++ = c;- }- return next_free;-}--// signed long long ints (64 bit integers)-char* long_long_int_dec (long long int x, char* buf)-{- char c, *ptr = buf, *next_free;- long long int x_tmp;-- // we cannot negate directly as 0 - (minBound :: Int) = minBound- if (x < 0) {- *ptr++ = '-';- buf++;- x_tmp = x;- x /= 10;- *ptr++ = digits[x * 10 - x_tmp];- if (x == 0)- return ptr;- else- x = -x;- }-- // encode positive number as little-endian decimal- do {- x_tmp = x;- x /= 10;- *ptr++ = digits[x_tmp - x * 10];- } while ( x );-- // reverse written digits- next_free = ptr--;- while (buf < ptr) {- c = *ptr;- *ptr-- = *buf;- *buf++ = c;- }- return next_free;-}--// unsigned integers-char* uint_dec (unsigned int x, char* buf)-{- char c, *ptr = buf, *next_free;- unsigned int x_tmp;-- // encode positive number as little-endian decimal- do {- x_tmp = x;- x /= 10;- *ptr++ = digits[x_tmp - x * 10];- } while ( x );-- // reverse written digits- next_free = ptr--;- while (buf < ptr) {- c = *ptr;- *ptr-- = *buf;- *buf++ = c;- }- return next_free;-}--// unsigned long ints-char* long_long_uint_dec (long long unsigned int x, char* buf)-{- char c, *ptr = buf, *next_free;- long long unsigned int x_tmp;-- // encode positive number as little-endian decimal- do {- x_tmp = x;- x /= 10;- *ptr++ = digits[x_tmp - x * 10];- } while ( x );-- // reverse written digits- next_free = ptr--;- while (buf < ptr) {- c = *ptr;- *ptr-- = *buf;- *buf++ = c;- }- return next_free;-}---// Padded, decimal, positive integers for the decimal output of bignums-///////////////////////////////////////////////////////////////////////--// Padded (9 digits), decimal, positive int:-// We will use it with numbers that fit in 31 bits; i.e., numbers smaller than-// 10^9, as "31 * log 2 / log 10 = 9.33"-void int_dec_padded9 (int x, char* buf)-{- const int max_width_int32_dec = 9;- char* ptr = buf + max_width_int32_dec;- int x_tmp;-- // encode positive number as little-endian decimal- do {- x_tmp = x;- x /= 10;- *(--ptr) = digits[x_tmp - x * 10];- } while ( x );-- // pad beginning- while (buf < ptr) { *(--ptr) = '0'; }-}--// Padded (19 digits), decimal, positive long long int:-// We will use it with numbers that fit in 63 bits; i.e., numbers smaller than-// 10^18, as "63 * log 2 / log 10 = 18.96"-void long_long_int_dec_padded18 (long long int x, char* buf)-{- const int max_width_int64_dec = 18;- char* ptr = buf + max_width_int64_dec;- long long int x_tmp;-- // encode positive number as little-endian decimal- do {- x_tmp = x;- x /= 10;- *(--ptr) = digits[x_tmp - x * 10];- } while ( x );-- // pad beginning- while (buf < ptr) { *(--ptr) = '0'; }-}---///////////////////////-// Hexadecimal encoding-///////////////////////--// unsigned ints (32 bit words)-char* 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;-};--// unsigned long ints (64 bit words)-char* long_long_uint_hex (long long 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;-};
− cbits/text.c
@@ -1,232 +0,0 @@-/*- * 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;-}-#else-{-- 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;-}-#else-{- 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/ByteString.hs
@@ -1,43 +0,0 @@-module PtrPoker.ByteString where--import Data.ByteString-import qualified Data.ByteString.Builder as Builder-import qualified Data.ByteString.Builder.Extra as Builder-import qualified Data.ByteString.Builder.Scientific as ScientificBuilder-import Data.ByteString.Internal-import qualified Data.ByteString.Lazy as Lazy-import qualified PtrPoker.Compat.Text as TextCompat-import qualified PtrPoker.Ffi as Ffi-import PtrPoker.Prelude hiding (empty)--builderWithStrategy :: Builder.AllocationStrategy -> Builder.Builder -> ByteString-builderWithStrategy strategy builder =- builder- & Builder.toLazyByteStringWith strategy Lazy.empty- & Lazy.toStrict--scientific :: Scientific -> ByteString-scientific sci =- sci- & ScientificBuilder.scientificBuilder- & builderWithStrategy (Builder.untrimmedStrategy 128 128)--double :: Double -> ByteString-double dbl =- unsafeCreateUptoN- 25- ( \ptr ->- Ffi.pokeDouble dbl ptr- & fmap fromIntegral- )--unsafeCreateDownToN :: Int -> (Ptr Word8 -> IO Int) -> ByteString-unsafeCreateDownToN allocSize populate =- unsafeDupablePerformIO $ do- fp <- mallocByteString allocSize- actualSize <- withForeignPtr fp (\p -> populate (plusPtr p (pred allocSize)))- return $! PS fp (allocSize - actualSize) actualSize--{-# INLINE textUtf8 #-}-textUtf8 :: Text -> ByteString-textUtf8 = TextCompat.encodeInUtf8
− library/PtrPoker/Compat/ByteString.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE CPP #-}--module PtrPoker.Compat.ByteString (poke) where--import Data.ByteString.Internal-import Foreign.Marshal.Utils-import qualified PtrPoker.Compat.ForeignPtr as ForeignPtr-import PtrPoker.Prelude hiding (poke)--{-# INLINE poke #-}-poke :: ByteString -> Ptr Word8 -> IO (Ptr Word8)--#if MIN_VERSION_bytestring(0,11,0)--poke (BS fptr length) ptr =- {-# SCC "poke" #-}- ForeignPtr.unsafeWithForeignPtr fptr $ \ bytesPtr ->- copyBytes ptr bytesPtr length $>- plusPtr ptr length--#else--poke (PS fptr offset length) ptr =- {-# SCC "poke" #-}- ForeignPtr.unsafeWithForeignPtr fptr $ \ bytesPtr ->- copyBytes ptr (plusPtr bytesPtr offset) length $>- plusPtr ptr length--#endif
− library/PtrPoker/Compat/ForeignPtr.hs
@@ -1,33 +0,0 @@-{-# LANGUAGE CPP #-}--module PtrPoker.Compat.ForeignPtr where--import PtrPoker.Prelude--#if MIN_VERSION_base(4,15,0)-import qualified GHC.ForeignPtr-#else-import qualified Foreign.ForeignPtr-#endif---- | 'unsafeWithForeignPtr' compatibility wrapper.------ GHC 9.0 made 'withForeignPtr' sound at the cost of performance. If you want to--- use the faster unsafe implementation, it's now at 'unsafeWithForeignPtr', and--- GHC asks you to promise that your continuation does not diverge. All we do here--- is @memcpy@ bytestrings, so we gladly pinky swear. For more detail, see Ben--- Gamari's post:--- <https://www.haskell.org/ghc/blog/20210607-the-keepAlive-story.html>------ Note that fumieval's mason uses 'unsafeWithForeignPtr' in the same way also to--- copy bytestrings.-{-# INLINE unsafeWithForeignPtr #-}-unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b-#if MIN_VERSION_base(4,15,0)-unsafeWithForeignPtr =- GHC.ForeignPtr.unsafeWithForeignPtr-#else-unsafeWithForeignPtr =- -- same implementation as new @unsafeWithForeignPtr@ (it was always unsafe)- Foreign.ForeignPtr.withForeignPtr-#endif
− library/PtrPoker/Compat/Text.hs
@@ -1,62 +0,0 @@-{-# LANGUAGE CPP #-}--module PtrPoker.Compat.Text where--#if MIN_VERSION_text(2,0,0)-import qualified Data.Text.Array as TextArray-import qualified Data.Text.Encoding as TextEncoding-import qualified Data.Text.Internal as TextInternal-import PtrPoker.Prelude--{-# INLINE destruct #-}-destruct :: (ByteArray# -> Int -> Int -> x) -> Text -> x-destruct k (TextInternal.Text (TextArray.ByteArray arr) off len) = k arr off len--{-# INLINE utf8EncodingSize #-}-utf8EncodingSize :: Text -> Int-utf8EncodingSize = destruct $ \_arr _off len -> len--{-# INLINEABLE encodeInUtf8 #-}-encodeInUtf8 :: Text -> ByteString-encodeInUtf8 t = TextEncoding.encodeUtf8 t--{-# INLINE pokeInUtf8 #-}-pokeInUtf8 :: Text -> Ptr Word8 -> IO (Ptr Word8)-pokeInUtf8 (TextInternal.Text arr off len) p =- stToIO (TextArray.copyToPointer arr off p len) $> plusPtr p len-#else-import qualified Data.ByteString.Internal as ByteStringInternal-import qualified Data.Text.Array as TextArray-import qualified Data.Text.Internal as TextInternal-import qualified PtrPoker.Ffi as Ffi-import PtrPoker.Prelude--{-# INLINE destruct #-}-destruct :: (ByteArray# -> Int -> Int -> x) -> Text -> x-destruct k (TextInternal.Text (TextArray.Array arr) off len) =- k arr off len--{-# INLINEABLE utf8EncodingSize #-}-utf8EncodingSize :: Text -> Int-utf8EncodingSize (TextInternal.Text (TextArray.Array arr) off len) =- Ffi.countTextAllocationSize- arr- (fromIntegral off)- (fromIntegral len)- & unsafeDupablePerformIO- & fromIntegral--{-# INLINEABLE encodeInUtf8 #-}-encodeInUtf8 :: Text -> ByteString-encodeInUtf8 (TextInternal.Text (TextArray.Array arr) off len) =- if len == 0- then mempty- else ByteStringInternal.unsafeCreateUptoN (len * 3) $ \ptr -> do- postPtr <- inline Ffi.encodeText ptr arr (fromIntegral off) (fromIntegral len)- return (minusPtr postPtr ptr)--{-# INLINE pokeInUtf8 #-}-pokeInUtf8 :: Text -> Ptr Word8 -> IO (Ptr Word8)-pokeInUtf8 (TextInternal.Text (TextArray.Array arr) off len) p =- Ffi.encodeText p arr (fromIntegral off) (fromIntegral len)-#endif
− library/PtrPoker/Ffi.hs
@@ -1,39 +0,0 @@-{-# LANGUAGE UnliftedFFITypes #-}--module PtrPoker.Ffi where--import Foreign.C-import PtrPoker.Prelude--foreign import ccall unsafe "static int_dec"- pokeIntInDec :: CInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static long_long_int_dec"- pokeLongLongIntInDec :: CLLong -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static uint_dec"- pokeUIntInDec :: CUInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static long_long_uint_dec"- pokeLongLongUIntInDec :: CULLong -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static uint_hex"- pokeUIntInHex :: CUInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static long_long_uint_hex"- pokeLongLongUIntInHex :: CULLong -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static rev_poke_int64"- revPokeInt64 :: CLLong -> Ptr Word8 -> IO ()--foreign import ccall unsafe "static rev_poke_uint64"- revPokeUInt64 :: CULLong -> Ptr Word8 -> IO ()--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/IO/Prim.hs
@@ -1,95 +0,0 @@-{-# LANGUAGE CPP #-}--module PtrPoker.IO.Prim where--import PtrPoker.Prelude--{-# INLINE pokeStorable #-}-pokeStorable :: (Storable a) => Ptr Word8 -> a -> IO ()-pokeStorable ptr value =- {-# SCC "pokeStorable" #-}- poke (castPtr ptr) value--{-# INLINE pokeWord8 #-}-pokeWord8 :: Ptr Word8 -> Word8 -> IO ()-pokeWord8 ptr value =- {-# SCC "pokeWord8" #-}- poke ptr value--{-# INLINE pokeWord8Off #-}-pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO ()-pokeWord8Off ptr off value =- {-# SCC "pokeWord8Off" #-}- pokeByteOff ptr off value--{-# INLINE pokeBEWord16 #-}-pokeBEWord16 :: Ptr Word8 -> Word16 -> IO ()-#ifdef WORDS_BIGENDIAN-pokeBEWord16 =- {-# SCC "pokeBEWord16" #-}- pokeStorable-#else-pokeBEWord16 ptr =- {-# SCC "pokeBEWord16" #-}- pokeStorable ptr . byteSwap16-#endif--{-# INLINE pokeBEWord32 #-}-pokeBEWord32 :: Ptr Word8 -> Word32 -> IO ()-#ifdef WORDS_BIGENDIAN-pokeBEWord32 =- {-# SCC "pokeBEWord32" #-}- pokeStorable-#else-pokeBEWord32 ptr =- {-# SCC "pokeBEWord32" #-}- pokeStorable ptr . byteSwap32-#endif--{-# INLINE pokeBEWord64 #-}-pokeBEWord64 :: Ptr Word8 -> Word64 -> IO ()-#ifdef WORDS_BIGENDIAN-pokeBEWord64 =- {-# SCC "pokeBEWord64" #-}- pokeStorable-#else-pokeBEWord64 ptr =- {-# SCC "pokeBEWord64" #-}- pokeStorable ptr . byteSwap64-#endif--{-# INLINE pokeLEWord16 #-}-pokeLEWord16 :: Ptr Word8 -> Word16 -> IO ()-#ifdef WORDS_BIGENDIAN-pokeLEWord16 ptr =- {-# SCC "pokeLEWord16" #-}- pokeStorable ptr . byteSwap16-#else-pokeLEWord16 =- {-# SCC "pokeLEWord16" #-}- pokeStorable-#endif--{-# INLINE pokeLEWord32 #-}-pokeLEWord32 :: Ptr Word8 -> Word32 -> IO ()-#ifdef WORDS_BIGENDIAN-pokeLEWord32 ptr =- {-# SCC "pokeLEWord32" #-}- pokeStorable ptr . byteSwap32-#else-pokeLEWord32 =- {-# SCC "pokeLEWord32" #-}- pokeStorable-#endif--{-# INLINE pokeLEWord64 #-}-pokeLEWord64 :: Ptr Word8 -> Word64 -> IO ()-#ifdef WORDS_BIGENDIAN-pokeLEWord64 ptr =- {-# SCC "pokeLEWord64" #-}- pokeStorable ptr . byteSwap64-#else-pokeLEWord64 =- {-# SCC "pokeLEWord64" #-}- pokeStorable-#endif
− library/PtrPoker/Poke.hs
@@ -1,246 +0,0 @@-module PtrPoker.Poke where--import qualified PtrPoker.Compat.ByteString as ByteStringCompat-import qualified PtrPoker.Compat.Text as TextCompat-import qualified PtrPoker.Ffi as Ffi-import qualified PtrPoker.IO.Prim as PrimIO-import PtrPoker.Prelude hiding (concat)--{-# RULES-"foldMap" forall f foldable.- foldMap f foldable =- Poke $ \p -> foldM (\p (Poke poker) -> poker p) p foldable- #-}---- |--- Abstraction over an IO action,--- which takes a pointer, populates it and--- produces a pointer right after the populated data.-newtype Poke = Poke {pokePtr :: Ptr Word8 -> IO (Ptr Word8)}--instance Semigroup Poke where- {-# INLINE [1] (<>) #-}- Poke lIO <> Poke rIO =- Poke (\p -> lIO p >>= rIO)- sconcat =- concat--instance Monoid Poke where- {-# INLINE [1] mempty #-}- mempty =- Poke return- mconcat =- concat---- |--- Reuses the IsString instance of 'ByteString'.-instance IsString Poke where- fromString = byteString . fromString---- |--- Concatenate a foldable of pokes.-{-# INLINE [1] concat #-}-concat :: (Foldable f) => f Poke -> Poke-concat pokers =- Poke (\p -> foldM (\p (Poke io) -> io p) p pokers)---- |--- Efficiently copy the contents of ByteString using @memcpy@.-{-# INLINE byteString #-}-byteString :: ByteString -> Poke-byteString bs =- Poke $ inline ByteStringCompat.poke bs---- |--- Encode Word8 as byte, incrementing the pointer by 1.-{-# INLINE [1] word8 #-}-word8 :: Word8 -> Poke-word8 a =- Poke (\p -> PrimIO.pokeWord8 p a $> plusPtr p 1)---- |--- Encode Word16 in Little-endian.-{-# INLINE [1] lWord16 #-}-lWord16 :: Word16 -> Poke-lWord16 a =- Poke (\p -> PrimIO.pokeLEWord16 p a $> plusPtr p 2)---- |--- Encode Word16 in Big-endian.-{-# INLINE [1] bWord16 #-}-bWord16 :: Word16 -> Poke-bWord16 a =- Poke (\p -> PrimIO.pokeBEWord16 p a $> plusPtr p 2)---- |--- Encode Word32 in Little-endian.-{-# INLINE [1] lWord32 #-}-lWord32 :: Word32 -> Poke-lWord32 a =- Poke (\p -> PrimIO.pokeLEWord32 p a $> plusPtr p 4)---- |--- Encode Word32 in Big-endian.-{-# INLINE [1] bWord32 #-}-bWord32 :: Word32 -> Poke-bWord32 a =- Poke (\p -> PrimIO.pokeBEWord32 p a $> plusPtr p 4)---- |--- Encode Word64 in Little-endian.-{-# INLINE [1] lWord64 #-}-lWord64 :: Word64 -> Poke-lWord64 a =- Poke (\p -> PrimIO.pokeLEWord64 p a $> plusPtr p 8)---- |--- Encode Word64 in Big-endian.-{-# INLINE [1] bWord64 #-}-bWord64 :: Word64 -> Poke-bWord64 a =- Poke (\p -> PrimIO.pokeBEWord64 p a $> plusPtr p 8)---- |--- Encode Int16 in Little-endian.-{-# INLINE lInt16 #-}-lInt16 :: Int16 -> Poke-lInt16 = lWord16 . fromIntegral---- |--- Encode Int16 in Big-endian.-{-# INLINE bInt16 #-}-bInt16 :: Int16 -> Poke-bInt16 = bWord16 . fromIntegral---- |--- Encode Int32 in Little-endian.-{-# INLINE lInt32 #-}-lInt32 :: Int32 -> Poke-lInt32 = lWord32 . fromIntegral---- |--- Encode Int32 in Big-endian.-{-# INLINE bInt32 #-}-bInt32 :: Int32 -> Poke-bInt32 = bWord32 . fromIntegral---- |--- Encode Int64 in Little-endian.-{-# INLINE lInt64 #-}-lInt64 :: Int64 -> Poke-lInt64 = lWord64 . fromIntegral---- |--- Encode Int64 in Big-endian.-{-# INLINE bInt64 #-}-bInt64 :: Int64 -> Poke-bInt64 = bWord64 . fromIntegral---- |--- Encode Text in UTF8.-{-# INLINE textUtf8 #-}-textUtf8 :: Text -> Poke-textUtf8 = Poke . TextCompat.pokeInUtf8---- * ASCII integers------------------------------- |--- Encode Int8 as a signed ASCII decimal.-{-# INLINE [1] int8AsciiDec #-}-int8AsciiDec :: Int8 -> Poke-int8AsciiDec a =- Poke (Ffi.pokeIntInDec (fromIntegral a))---- |--- Encode Int16 as a signed ASCII decimal.-{-# INLINE [1] int16AsciiDec #-}-int16AsciiDec :: Int16 -> Poke-int16AsciiDec a =- Poke (Ffi.pokeIntInDec (fromIntegral a))---- |--- Encode Int32 as a signed ASCII decimal.-{-# INLINE [1] int32AsciiDec #-}-int32AsciiDec :: Int32 -> Poke-int32AsciiDec a =- Poke (Ffi.pokeIntInDec (fromIntegral a))---- |--- Encode Int64 as a signed ASCII decimal.-{-# INLINE [1] int64AsciiDec #-}-int64AsciiDec :: Int64 -> Poke-int64AsciiDec a =- Poke (Ffi.pokeLongLongIntInDec (fromIntegral a))---- |--- Encode Int as a signed ASCII decimal.-{-# INLINE [1] intAsciiDec #-}-intAsciiDec :: Int -> Poke-intAsciiDec a =- Poke (Ffi.pokeLongLongIntInDec (fromIntegral a))---- |--- Encode Word8 as an unsigned ASCII decimal.-{-# INLINE [1] word8AsciiDec #-}-word8AsciiDec :: Word8 -> Poke-word8AsciiDec a =- Poke (Ffi.pokeUIntInDec (fromIntegral a))---- |--- Encode Word16 as an unsigned ASCII decimal.-{-# INLINE [1] word16AsciiDec #-}-word16AsciiDec :: Word16 -> Poke-word16AsciiDec a =- Poke (Ffi.pokeUIntInDec (fromIntegral a))---- |--- Encode Word32 as an unsigned ASCII decimal.-{-# INLINE [1] word32AsciiDec #-}-word32AsciiDec :: Word32 -> Poke-word32AsciiDec a =- Poke (Ffi.pokeUIntInDec (fromIntegral a))---- |--- Encode Word64 as an unsigned ASCII decimal.-{-# INLINE [1] word64AsciiDec #-}-word64AsciiDec :: Word64 -> Poke-word64AsciiDec a =- Poke (Ffi.pokeLongLongUIntInDec (fromIntegral a))---- |--- Encode Word as an unsigned ASCII decimal.-{-# INLINE [1] wordAsciiDec #-}-wordAsciiDec :: Word -> Poke-wordAsciiDec a =- Poke (Ffi.pokeLongLongUIntInDec (fromIntegral a))---- |--- Encode Double as a signed ASCII decimal.-{-# INLINE doubleAsciiDec #-}-doubleAsciiDec :: Double -> Poke-doubleAsciiDec a =- Poke $ \ptr ->- Ffi.pokeDouble a ptr- & fmap (plusPtr ptr . fromIntegral)---- * Low level------------------------------- |--- Having the amount of bytes to be written precomputed,--- executes an action,--- which fills the pointer going downward,--- starting from the pointer that follows the chunk.--- I.e., you have to decrement the pointer--- before writing the first byte,--- decrement it again before writing the second byte and so on.-{-# INLINE sizedReverse #-}-sizedReverse :: Int -> (Ptr Word8 -> IO a) -> Poke-sizedReverse size action =- Poke $ \ptr ->- let afterPtr =- plusPtr ptr size- in action afterPtr $> afterPtr
− library/PtrPoker/Prelude.hs
@@ -1,78 +0,0 @@-module PtrPoker.Prelude- ( module Exports,- showAsText,- )-where--import Control.Applicative as Exports hiding (WrappedArrow (..))-import Control.Arrow as Exports hiding (first, second)-import Control.Category as Exports-import Control.Concurrent as Exports-import Control.Exception as Exports-import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)-import Control.Monad.Fail as Exports-import Control.Monad.Fix as Exports hiding (fix)-import Control.Monad.IO.Class as Exports-import Control.Monad.ST as Exports-import Data.Bifunctor as Exports-import Data.Bits as Exports-import Data.Bool as Exports-import Data.ByteString as Exports (ByteString)-import Data.Char as Exports-import Data.Coerce as Exports-import Data.Complex as Exports-import Data.Data as Exports-import Data.Dynamic as Exports-import Data.Either as Exports-import Data.Fixed as Exports-import Data.Foldable as Exports hiding (toList)-import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports hiding (unzip)-import Data.Functor.Compose as Exports-import Data.IORef as Exports-import Data.Int as Exports-import Data.Ix as Exports-import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)-import Data.List.NonEmpty as Exports (NonEmpty (..))-import Data.Maybe as Exports-import Data.Monoid as Exports hiding (Alt, (<>))-import Data.Ord as Exports-import Data.Proxy as Exports-import Data.Ratio as Exports-import Data.STRef as Exports-import Data.Scientific as Exports (Scientific)-import Data.Semigroup as Exports hiding (First (..), Last (..))-import Data.String as Exports-import Data.Text as Exports (Text)-import Data.Traversable as Exports-import Data.Tuple as Exports-import Data.Unique as Exports-import Data.Version as Exports-import Data.Void as Exports-import Data.Word as Exports-import Debug.Trace as Exports-import Foreign.ForeignPtr as Exports-import Foreign.Ptr as Exports-import Foreign.StablePtr as Exports-import Foreign.Storable as Exports-import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)-import GHC.Exts as Exports (ByteArray#, IsList (..), groupWith, inline, lazy, sortWith)-import GHC.Generics as Exports (Generic)-import GHC.IO.Exception as Exports-import GHC.OverloadedLabels as Exports-import Numeric as Exports-import System.Environment as Exports-import System.Exit as Exports-import System.IO as Exports (Handle, hClose)-import System.IO.Error as Exports-import System.IO.Unsafe as Exports-import System.Mem as Exports-import System.Mem.StableName as Exports-import System.Timeout as Exports-import Text.Printf as Exports (hPrintf, printf)-import Text.Read as Exports (Read (..), readEither, readMaybe)-import Unsafe.Coerce as Exports-import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))--showAsText :: (Show a) => a -> Text-showAsText = show >>> fromString
− library/PtrPoker/Size.hs
@@ -1,203 +0,0 @@--- |--- Functions that compute the required allocation size by value.-module PtrPoker.Size where--import qualified PtrPoker.Compat.Text as TextCompat-import PtrPoker.Prelude---- |--- Efficiently count the amount of bytes required to encode Word64--- as a decimal number in ASCII.------ Implemented as a balanced tree of \"ifs\"--- centered around the middle of the range.--- This is much faster than anything based on logarithms.-{-# INLINE word64AsciiDec #-}-word64AsciiDec :: Word64 -> Int-word64AsciiDec x =- if x > 9999999999- then- if x > 99999999999999- then- if x > 9999999999999999- then- if x > 99999999999999999- then- if x > 999999999999999999- then- if x > 9999999999999999999- then 20- else 19- else 18- else 17- else- if x > 999999999999999- then 16- else 15- else- if x > 999999999999- then- if x > 9999999999999- then 14- else 13- else- if x > 99999999999- then 12- else 11- else- if x > 99999- then- if x > 9999999- then- if x > 99999999- then- if x > 999999999- then 10- else 9- else 8- else- if x > 999999- then 7- else 6- else- if x > 99- then- if x > 999- then- if x > 9999- then 5- else 4- else 3- else- if x > 9- then 2- else 1---- |--- Efficiently count the amount of bytes required to encode Int64--- as a signed decimal number in ASCII.------ Implemented as a balanced tree of \"ifs\"--- centered around the middle of the range.--- This is much faster than anything based on logarithms.-{-# INLINE int64AsciiDec #-}-int64AsciiDec :: Int64 -> Int-int64AsciiDec x =- if x < 0- then- if x < -9999999999- then- if x < -99999999999999- then- if x < -9999999999999999- then- if x < -99999999999999999- then- if x < -999999999999999999- then 20- else 19- else 18- else- if x < -999999999999999- then 17- else 16- else- if x < -999999999999- then- if x < -9999999999999- then 15- else 14- else- if x < -99999999999- then 13- else 12- else- if x < -99999- then- if x < -9999999- then- if x < -99999999- then- if x < -999999999- then 11- else 10- else 9- else- if x < -999999- then 8- else 7- else- if x < -99- then- if x < -999- then- if x < -9999- then 6- else 5- else 4- else- if x < -9- then 3- else 2- else- if x > 9999999999- then- if x > 99999999999999- then- if x > 9999999999999999- then- if x > 99999999999999999- then- if x > 999999999999999999- then 19- else 18- else 17- else- if x > 999999999999999- then 16- else 15- else- if x > 999999999999- then- if x > 9999999999999- then 14- else 13- else- if x > 99999999999- then 12- else 11- else- if x > 99999- then- if x > 9999999- then- if x > 99999999- then- if x > 999999999- then 10- else 9- else 8- else- if x > 999999- then 7- else 6- else- if x > 99- then- if x > 999- then- if x > 9999- then 5- else 4- else 3- else- if x > 9- then 2- else 1---- |--- Efficiently count the amount of bytes required to encode Text--- in UTF8.-{-# INLINE textUtf8 #-}-textUtf8 :: Text -> Int-textUtf8 = TextCompat.utf8EncodingSize
− library/PtrPoker/Write.hs
@@ -1,270 +0,0 @@-module PtrPoker.Write where--import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Internal as ByteString-import qualified PtrPoker.ByteString as ByteString-import qualified PtrPoker.Ffi as Ffi-import qualified PtrPoker.Poke as Poke-import PtrPoker.Prelude hiding (concat)-import qualified PtrPoker.Size as Size---- |--- Execute Write, producing strict ByteString.-{-# INLINEABLE writeToByteString #-}-writeToByteString :: Write -> ByteString-writeToByteString Write {..} =- ByteString.unsafeCreate writeSize (void . Poke.pokePtr writePoke)---- |--- Specification of how many bytes to allocate and how to populate them.------ Useful for creating strict bytestrings and tasks like that.-data Write = Write- { writeSize :: Int,- writePoke :: Poke.Poke- }--instance Semigroup Write where- {-# INLINE (<>) #-}- Write lSize lPoke <> Write rSize rPoke =- Write (lSize + rSize) (lPoke <> rPoke)- {-# INLINE sconcat #-}- sconcat =- concat--instance Monoid Write where- {-# INLINE mempty #-}- mempty =- Write 0 mempty- {-# INLINE mconcat #-}- mconcat =- concat---- |--- Reuses the IsString instance of 'ByteString'.-instance IsString Write where- {-# INLINE fromString #-}- fromString =- byteString . fromString---- |--- Concatenate a foldable of writes.-{-# INLINE concat #-}-concat :: (Foldable f) => f Write -> Write-concat f =- Write- (foldl' (\a b -> a + writeSize b) 0 f)- (Poke.Poke (\p -> foldM (\p write -> Poke.pokePtr (writePoke write) p) p f))---- |--- Render Word8 as byte.-{-# INLINE word8 #-}-word8 :: Word8 -> Write-word8 a =- Write 1 (Poke.word8 a)---- |--- Render Word16 in Little-endian.-{-# INLINE lWord16 #-}-lWord16 :: Word16 -> Write-lWord16 a =- Write 2 (Poke.lWord16 a)---- |--- Render Word16 in Big-endian.-{-# INLINE bWord16 #-}-bWord16 :: Word16 -> Write-bWord16 a =- Write 2 (Poke.bWord16 a)---- |--- Render Word32 in Little-endian.-{-# INLINE lWord32 #-}-lWord32 :: Word32 -> Write-lWord32 a =- Write 4 (Poke.lWord32 a)---- |--- Render Word32 in Big-endian.-{-# INLINE bWord32 #-}-bWord32 :: Word32 -> Write-bWord32 a =- Write 4 (Poke.bWord32 a)---- |--- Render Word64 in Little-endian.-{-# INLINE lWord64 #-}-lWord64 :: Word64 -> Write-lWord64 a =- Write 8 (Poke.lWord64 a)---- |--- Render Word64 in Big-endian.-{-# INLINE bWord64 #-}-bWord64 :: Word64 -> Write-bWord64 a =- Write 8 (Poke.bWord64 a)---- |--- Render Int16 in Little-endian.-{-# INLINE lInt16 #-}-lInt16 :: Int16 -> Write-lInt16 a =- Write 2 (Poke.lInt16 a)---- |--- Render Int16 in Big-endian.-{-# INLINE bInt16 #-}-bInt16 :: Int16 -> Write-bInt16 a =- Write 2 (Poke.bInt16 a)---- |--- Render Int32 in Little-endian.-{-# INLINE lInt32 #-}-lInt32 :: Int32 -> Write-lInt32 a =- Write 4 (Poke.lInt32 a)---- |--- Render Int32 in Big-endian.-{-# INLINE bInt32 #-}-bInt32 :: Int32 -> Write-bInt32 a =- Write 4 (Poke.bInt32 a)---- |--- Render Int64 in Little-endian.-{-# INLINE lInt64 #-}-lInt64 :: Int64 -> Write-lInt64 a =- Write 8 (Poke.lInt64 a)---- |--- Render Int64 in Big-endian.-{-# INLINE bInt64 #-}-bInt64 :: Int64 -> Write-bInt64 a =- Write 8 (Poke.bInt64 a)---- |--- Render Word64 in ASCII decimal.-{-# INLINE word64AsciiDec #-}-word64AsciiDec :: Word64 -> Write-word64AsciiDec a =- Write size poke- where- size =- Size.word64AsciiDec a- poke =- Poke.sizedReverse size (Ffi.revPokeUInt64 (fromIntegral a))---- |--- Render Word in ASCII decimal.-{-# INLINE wordAsciiDec #-}-wordAsciiDec :: Word -> Write-wordAsciiDec =- word64AsciiDec . fromIntegral---- |--- Render Int64 in ASCII decimal.-{-# INLINE int64AsciiDec #-}-int64AsciiDec :: Int64 -> Write-int64AsciiDec a =- Write size poke- where- size =- Size.int64AsciiDec a- poke =- Poke.sizedReverse size (Ffi.revPokeInt64 (fromIntegral a))---- |--- Render Int in ASCII decimal.-{-# INLINE intAsciiDec #-}-intAsciiDec :: Int -> Write-intAsciiDec =- int64AsciiDec . fromIntegral---- |--- Render double interpreting non-real values,--- such as @NaN@, @Infinity@, @-Infinity@,--- as is.-{-# INLINE doubleAsciiDec #-}-doubleAsciiDec :: Double -> Write-doubleAsciiDec a =- if a == 0- then word8 48- else- if isNaN a- then "NaN"- else- if isInfinite a- then- if a < 0- then "-Infinity"- else "Infinity"- else- if a < 0- then word8 45 <> byteString (ByteString.double (negate a))- else byteString (ByteString.double a)---- |--- Render double interpreting non real values,--- such as @NaN@, @Infinity@, @-Infinity@,--- as zero.-{-# INLINE zeroNonRealDoubleAsciiDec #-}-zeroNonRealDoubleAsciiDec :: Double -> Write-zeroNonRealDoubleAsciiDec a =- if a == 0 || isNaN a || isInfinite a- then word8 48- else- if a < 0- then word8 45 <> byteString (ByteString.double (negate a))- else byteString (ByteString.double a)---- |--- Render Scientific in ASCII decimal.-{-# INLINE scientificAsciiDec #-}-scientificAsciiDec :: Scientific -> Write-scientificAsciiDec =- byteString . ByteString.scientific---- |--- Efficiently copy the contents of ByteString using @memcpy@.-{-# INLINE byteString #-}-byteString :: ByteString -> Write-byteString a =- Write (ByteString.length a) (inline Poke.byteString a)---- |--- Render Text in UTF8.------ Does pretty much the same as 'Data.Text.Encoding.encodeUtf8',--- both implementation and performance-wise,--- while allowing you to avoid redundant @memcpy@--- compared to @('byteString' . 'Data.Text.Encoding.encodeUtf8')@.------ Following are the benchmark results comparing the performance of--- @('writeToByteString' . 'textUtf8')@ with--- @Data.Text.Encoding.'Data.Text.Encoding.encodeUtf8'@--- on inputs in Latin and Greek (requiring different number of surrogate bytes).--- The results show that they are quite similar.------ === __Benchmark results__------ > textUtf8/ptr-poker/latin/1 25.61 ns--- > textUtf8/ptr-poker/latin/10 31.59 ns--- > textUtf8/ptr-poker/latin/100 121.5 ns--- > textUtf8/ptr-poker/greek/1 28.54 ns--- > textUtf8/ptr-poker/greek/10 41.97 ns--- > textUtf8/ptr-poker/greek/100 250.3 ns--- > textUtf8/text/latin/1 22.84 ns--- > textUtf8/text/latin/10 31.10 ns--- > textUtf8/text/latin/100 118.2 ns--- > textUtf8/text/greek/1 25.80 ns--- > textUtf8/text/greek/10 40.80 ns--- > textUtf8/text/greek/100 293.1 ns-{-# INLINEABLE textUtf8 #-}-textUtf8 :: Text -> Write-textUtf8 a =- Write (Size.textUtf8 a) (Poke.textUtf8 a)
ptr-poker.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ptr-poker-version: 0.1.2.16+version: 0.1.3 synopsis: Pointer poking action construction and composition toolkit description: Abstraction over memory writes. Efficiently building strict bytestrings is one usecase for it.@@ -16,7 +16,7 @@ source-repository head type: git- location: git://github.com/nikita-volkov/ptr-poker.git+ location: https://github.com/nikita-volkov/ptr-poker common base-settings default-language: Haskell2010@@ -63,7 +63,7 @@ library import: base-settings- hs-source-dirs: library+ hs-source-dirs: src/library exposed-modules: PtrPoker.Poke PtrPoker.Size@@ -79,10 +79,10 @@ PtrPoker.Prelude c-sources:- cbits/dtoa.c- cbits/int_encoding.c- cbits/itoa.c- cbits/text.c+ src/cbits/dtoa.c+ src/cbits/int_encoding.c+ src/cbits/itoa.c+ src/cbits/text.c build-depends: base >=4.11 && <5,@@ -93,10 +93,18 @@ test-suite test import: base-settings type: exitcode-stdio-1.0- hs-source-dirs: test+ hs-source-dirs: src/test main-is: Main.hs+ other-modules:+ SizeSpec+ WriteSpec++ build-tool-depends:+ hspec-discover:hspec-discover >=2.7 && <3+ build-depends:- hedgehog >=1.2 && <2,+ QuickCheck >=2.14 && <3,+ hspec >=2.7 && <3, isomorphism-class >=0.1 && <0.4, numeric-limits >=0.1 && <0.2, ptr-poker,@@ -105,7 +113,7 @@ benchmark bench import: base-settings type: exitcode-stdio-1.0- hs-source-dirs: bench+ hs-source-dirs: src/bench main-is: Main.hs ghc-options: -O2
+ src/bench/Main.hs view
@@ -0,0 +1,72 @@+module Main where++import Criterion.Main+import qualified Data.Text.Encoding as Text+import qualified PtrPoker.Write as Write+import Prelude++main :: IO ()+main =+ defaultMain+ [ bgroup+ "bWord32"+ [ bench "4"+ $ nf+ ( \(a, b, c, d) ->+ Write.toByteString+ $ Write.bWord32 a+ <> Write.bWord32 b+ <> Write.bWord32 c+ <> Write.bWord32 d+ )+ (1, 2, 3, 4)+ ],+ 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.toByteString . Write.textUtf8) latinSample1),+ bench "10" (nf (Write.toByteString . Write.textUtf8) latinSample10),+ bench "100" (nf (Write.toByteString . Write.textUtf8) latinSample100)+ ],+ bgroup+ "greek"+ [ bench "1" (nf (Write.toByteString . Write.textUtf8) greekSample1),+ bench "10" (nf (Write.toByteString . Write.textUtf8) greekSample10),+ bench "100" (nf (Write.toByteString . 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)+ ]+ ]+ ]+ ]
+ src/cbits/dtoa.c view
@@ -0,0 +1,383 @@+/*+Copyright https://github.com/juj++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.++*/+// modified version of https://github.com/juj/MathGeoLib/blob/master/src/Math/grisu3.c+/* This file is part of an implementation of the "grisu3" double to string+ conversion algorithm described in the research paper+ "Printing Floating-Point Numbers Quickly And Accurately with Integers"+ by Florian Loitsch, available at+ http://www.cs.tufts.edu/~nr/cs257/archive/florian-loitsch/printf.pdf */++#include <stdint.h> // uint64_t etc.+#include <assert.h> // assert+#include <math.h> // ceil+#include <stdio.h> // sprintf++#ifdef _MSC_VER+#pragma warning(disable : 4204) // nonstandard extension used : non-constant aggregate initializer+#endif++#define D64_SIGN 0x8000000000000000ULL+#define D64_EXP_MASK 0x7FF0000000000000ULL+#define D64_FRACT_MASK 0x000FFFFFFFFFFFFFULL+#define D64_IMPLICIT_ONE 0x0010000000000000ULL+#define D64_EXP_POS 52+#define D64_EXP_BIAS 1075+#define DIYFP_FRACT_SIZE 64+#define D_1_LOG2_10 0.30102999566398114 // 1 / lg(10)+#define MIN_TARGET_EXP -60+#define MASK32 0xFFFFFFFFULL++#define CAST_U64(d) (*(uint64_t*)&d)+#define MIN(x,y) ((x) <= (y) ? (x) : (y))+#define MAX(x,y) ((x) >= (y) ? (x) : (y))++#define MIN_CACHED_EXP -348+#define CACHED_EXP_STEP 8++typedef struct diy_fp+{+ uint64_t f;+ int e;+} diy_fp;++typedef struct power+{+ uint64_t fract;+ int16_t b_exp, d_exp;+} power;++static const power pow_cache[] =+{+ { 0xfa8fd5a0081c0288ULL, -1220, -348 },+ { 0xbaaee17fa23ebf76ULL, -1193, -340 },+ { 0x8b16fb203055ac76ULL, -1166, -332 },+ { 0xcf42894a5dce35eaULL, -1140, -324 },+ { 0x9a6bb0aa55653b2dULL, -1113, -316 },+ { 0xe61acf033d1a45dfULL, -1087, -308 },+ { 0xab70fe17c79ac6caULL, -1060, -300 },+ { 0xff77b1fcbebcdc4fULL, -1034, -292 },+ { 0xbe5691ef416bd60cULL, -1007, -284 },+ { 0x8dd01fad907ffc3cULL, -980, -276 },+ { 0xd3515c2831559a83ULL, -954, -268 },+ { 0x9d71ac8fada6c9b5ULL, -927, -260 },+ { 0xea9c227723ee8bcbULL, -901, -252 },+ { 0xaecc49914078536dULL, -874, -244 },+ { 0x823c12795db6ce57ULL, -847, -236 },+ { 0xc21094364dfb5637ULL, -821, -228 },+ { 0x9096ea6f3848984fULL, -794, -220 },+ { 0xd77485cb25823ac7ULL, -768, -212 },+ { 0xa086cfcd97bf97f4ULL, -741, -204 },+ { 0xef340a98172aace5ULL, -715, -196 },+ { 0xb23867fb2a35b28eULL, -688, -188 },+ { 0x84c8d4dfd2c63f3bULL, -661, -180 },+ { 0xc5dd44271ad3cdbaULL, -635, -172 },+ { 0x936b9fcebb25c996ULL, -608, -164 },+ { 0xdbac6c247d62a584ULL, -582, -156 },+ { 0xa3ab66580d5fdaf6ULL, -555, -148 },+ { 0xf3e2f893dec3f126ULL, -529, -140 },+ { 0xb5b5ada8aaff80b8ULL, -502, -132 },+ { 0x87625f056c7c4a8bULL, -475, -124 },+ { 0xc9bcff6034c13053ULL, -449, -116 },+ { 0x964e858c91ba2655ULL, -422, -108 },+ { 0xdff9772470297ebdULL, -396, -100 },+ { 0xa6dfbd9fb8e5b88fULL, -369, -92 },+ { 0xf8a95fcf88747d94ULL, -343, -84 },+ { 0xb94470938fa89bcfULL, -316, -76 },+ { 0x8a08f0f8bf0f156bULL, -289, -68 },+ { 0xcdb02555653131b6ULL, -263, -60 },+ { 0x993fe2c6d07b7facULL, -236, -52 },+ { 0xe45c10c42a2b3b06ULL, -210, -44 },+ { 0xaa242499697392d3ULL, -183, -36 },+ { 0xfd87b5f28300ca0eULL, -157, -28 },+ { 0xbce5086492111aebULL, -130, -20 },+ { 0x8cbccc096f5088ccULL, -103, -12 },+ { 0xd1b71758e219652cULL, -77, -4 },+ { 0x9c40000000000000ULL, -50, 4 },+ { 0xe8d4a51000000000ULL, -24, 12 },+ { 0xad78ebc5ac620000ULL, 3, 20 },+ { 0x813f3978f8940984ULL, 30, 28 },+ { 0xc097ce7bc90715b3ULL, 56, 36 },+ { 0x8f7e32ce7bea5c70ULL, 83, 44 },+ { 0xd5d238a4abe98068ULL, 109, 52 },+ { 0x9f4f2726179a2245ULL, 136, 60 },+ { 0xed63a231d4c4fb27ULL, 162, 68 },+ { 0xb0de65388cc8ada8ULL, 189, 76 },+ { 0x83c7088e1aab65dbULL, 216, 84 },+ { 0xc45d1df942711d9aULL, 242, 92 },+ { 0x924d692ca61be758ULL, 269, 100 },+ { 0xda01ee641a708deaULL, 295, 108 },+ { 0xa26da3999aef774aULL, 322, 116 },+ { 0xf209787bb47d6b85ULL, 348, 124 },+ { 0xb454e4a179dd1877ULL, 375, 132 },+ { 0x865b86925b9bc5c2ULL, 402, 140 },+ { 0xc83553c5c8965d3dULL, 428, 148 },+ { 0x952ab45cfa97a0b3ULL, 455, 156 },+ { 0xde469fbd99a05fe3ULL, 481, 164 },+ { 0xa59bc234db398c25ULL, 508, 172 },+ { 0xf6c69a72a3989f5cULL, 534, 180 },+ { 0xb7dcbf5354e9beceULL, 561, 188 },+ { 0x88fcf317f22241e2ULL, 588, 196 },+ { 0xcc20ce9bd35c78a5ULL, 614, 204 },+ { 0x98165af37b2153dfULL, 641, 212 },+ { 0xe2a0b5dc971f303aULL, 667, 220 },+ { 0xa8d9d1535ce3b396ULL, 694, 228 },+ { 0xfb9b7cd9a4a7443cULL, 720, 236 },+ { 0xbb764c4ca7a44410ULL, 747, 244 },+ { 0x8bab8eefb6409c1aULL, 774, 252 },+ { 0xd01fef10a657842cULL, 800, 260 },+ { 0x9b10a4e5e9913129ULL, 827, 268 },+ { 0xe7109bfba19c0c9dULL, 853, 276 },+ { 0xac2820d9623bf429ULL, 880, 284 },+ { 0x80444b5e7aa7cf85ULL, 907, 292 },+ { 0xbf21e44003acdd2dULL, 933, 300 },+ { 0x8e679c2f5e44ff8fULL, 960, 308 },+ { 0xd433179d9c8cb841ULL, 986, 316 },+ { 0x9e19db92b4e31ba9ULL, 1013, 324 },+ { 0xeb96bf6ebadf77d9ULL, 1039, 332 },+ { 0xaf87023b9bf0ee6bULL, 1066, 340 }+};++static int cached_pow(int exp, diy_fp *p)+{+ int k = (int)ceil((exp+DIYFP_FRACT_SIZE-1) * D_1_LOG2_10);+ int i = (k-MIN_CACHED_EXP-1) / CACHED_EXP_STEP + 1;+ p->f = pow_cache[i].fract;+ p->e = pow_cache[i].b_exp;+ return pow_cache[i].d_exp;+}++static diy_fp minus(diy_fp x, diy_fp y)+{+ diy_fp d; d.f = x.f - y.f; d.e = x.e;+ assert(x.e == y.e && x.f >= y.f);+ return d;+}++static diy_fp multiply(diy_fp x, diy_fp y)+{+ uint64_t a, b, c, d, ac, bc, ad, bd, tmp;+ diy_fp r;+ a = x.f >> 32; b = x.f & MASK32;+ c = y.f >> 32; d = y.f & MASK32;+ ac = a*c; bc = b*c;+ ad = a*d; bd = b*d;+ tmp = (bd >> 32) + (ad & MASK32) + (bc & MASK32);+ tmp += 1U << 31; // round+ r.f = ac + (ad >> 32) + (bc >> 32) + (tmp >> 32);+ r.e = x.e + y.e + 64;+ return r;+}++static diy_fp normalize_diy_fp(diy_fp n)+{+ assert(n.f != 0);+ while(!(n.f & 0xFFC0000000000000ULL)) { n.f <<= 10; n.e -= 10; }+ while(!(n.f & D64_SIGN)) { n.f <<= 1; --n.e; }+ return n;+}++static diy_fp double2diy_fp(double d)+{+ diy_fp fp;+ uint64_t u64 = CAST_U64(d);+ if (!(u64 & D64_EXP_MASK)) { fp.f = u64 & D64_FRACT_MASK; fp.e = 1 - D64_EXP_BIAS; }+ else { fp.f = (u64 & D64_FRACT_MASK) + D64_IMPLICIT_ONE; fp.e = (int)((u64 & D64_EXP_MASK) >> D64_EXP_POS) - D64_EXP_BIAS; }+ return fp;+}++// pow10_cache[i] = 10^(i-1)+static const unsigned int pow10_cache[] = { 0, 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000 };++static int largest_pow10(uint32_t n, int n_bits, uint32_t *power)+{+ int guess = ((n_bits + 1) * 1233 >> 12) + 1/*skip first entry*/;+ if (n < pow10_cache[guess]) --guess; // We don't have any guarantees that 2^n_bits <= n.+ *power = pow10_cache[guess];+ return guess;+}++static int round_weed(char *buffer, int len, uint64_t wp_W, uint64_t delta, uint64_t rest, uint64_t ten_kappa, uint64_t ulp)+{+ uint64_t wp_Wup = wp_W - ulp;+ uint64_t wp_Wdown = wp_W + ulp;+ while(rest < wp_Wup && delta - rest >= ten_kappa+ && (rest + ten_kappa < wp_Wup || wp_Wup - rest >= rest + ten_kappa - wp_Wup))+ {+ --buffer[len-1];+ rest += ten_kappa;+ }+ if (rest < wp_Wdown && delta - rest >= ten_kappa+ && (rest + ten_kappa < wp_Wdown || wp_Wdown - rest > rest + ten_kappa - wp_Wdown))+ return 0;++ return 2*ulp <= rest && rest <= delta - 4*ulp;+}++static int digit_gen(diy_fp low, diy_fp w, diy_fp high, char *buffer, int *length, int *kappa)+{+ uint64_t unit = 1;+ diy_fp too_low = { low.f - unit, low.e };+ diy_fp too_high = { high.f + unit, high.e };+ diy_fp unsafe_interval = minus(too_high, too_low);+ diy_fp one = { 1ULL << -w.e, w.e };+ uint32_t p1 = (uint32_t)(too_high.f >> -one.e);+ uint64_t p2 = too_high.f & (one.f - 1);+ uint32_t div;+ *kappa = largest_pow10(p1, DIYFP_FRACT_SIZE + one.e, &div);+ *length = 0;++ while(*kappa > 0)+ {+ uint64_t rest;+ int digit = p1 / div;+ buffer[*length] = (char)('0' + digit);+ ++*length;+ p1 %= div;+ --*kappa;+ rest = ((uint64_t)p1 << -one.e) + p2;+ if (rest < unsafe_interval.f) return round_weed(buffer, *length, minus(too_high, w).f, unsafe_interval.f, rest, (uint64_t)div << -one.e, unit);+ div /= 10;+ }++ for(;;)+ {+ int digit;+ p2 *= 10;+ unit *= 10;+ unsafe_interval.f *= 10;+ // Integer division by one.+ digit = (int)(p2 >> -one.e);+ buffer[*length] = (char)('0' + digit);+ ++*length;+ p2 &= one.f - 1; // Modulo by one.+ --*kappa;+ if (p2 < unsafe_interval.f) return round_weed(buffer, *length, minus(too_high, w).f * unit, unsafe_interval.f, p2, one.f, unit);+ }+}++int grisu3(double v, char *buffer, int *length, int *d_exp)+{+ int mk, kappa, success;+ diy_fp dfp = double2diy_fp(v);+ diy_fp w = normalize_diy_fp(dfp);++ // normalize boundaries+ diy_fp t = { (dfp.f << 1) + 1, dfp.e - 1 };+ diy_fp b_plus = normalize_diy_fp(t);+ diy_fp b_minus;+ diy_fp c_mk; // Cached power of ten: 10^-k+ uint64_t u64 = CAST_U64(v);+ assert(v > 0 && v <= 1.7976931348623157e308); // Grisu only handles strictly positive finite numbers.+ if (!(u64 & D64_FRACT_MASK) && (u64 & D64_EXP_MASK) != 0) { b_minus.f = (dfp.f << 2) - 1; b_minus.e = dfp.e - 2;} // lower boundary is closer?+ else { b_minus.f = (dfp.f << 1) - 1; b_minus.e = dfp.e - 1; }+ b_minus.f = b_minus.f << (b_minus.e - b_plus.e);+ b_minus.e = b_plus.e;++ mk = cached_pow(MIN_TARGET_EXP - DIYFP_FRACT_SIZE - w.e, &c_mk);++ w = multiply(w, c_mk);+ b_minus = multiply(b_minus, c_mk);+ b_plus = multiply(b_plus, c_mk);++ success = digit_gen(b_minus, w, b_plus, buffer, length, &kappa);+ *d_exp = kappa - mk;+ return success;+}++static int i_to_str(int val, char *str)+{+ int len, i;+ char *s;+ char *begin = str;+ if (val < 0) { *str++ = '-'; val = -val; }+ s = str;++ for(;;)+ {+ int ni = val / 10;+ int digit = val - ni*10;+ *s++ = (char)('0' + digit);+ if (ni == 0)+ break;+ val = ni;+ }+ *s = '\0';+ len = (int)(s - str);+ for(i = 0; i < len/2; ++i)+ {+ char ch = str[i];+ str[i] = str[len-1-i];+ str[len-1-i] = ch;+ }++ return (int)(s - begin);+}++int dtoa_grisu3(double v, char *dst)+{+ int d_exp, len, decimals, i;++ int success = grisu3(v, dst, &len, &d_exp);+ // If grisu3 was not able to convert the number to a string, then use old sprintf (suboptimal).+ if (!success) return sprintf(dst, "%.17g", v) + (int)(dst - dst);++ // We now have an integer string of form "151324135" and a base-10 exponent for that number.+ // Next, decide the best presentation for that string by whether to use a decimal point, or the scientific exponent notation 'e'.+ // We don't pick the absolute shortest representation, but pick a balance between readability and shortness, e.g.+ // 1.545056189557677e-308 could be represented in a shorter form+ // 1545056189557677e-323 but that would be somewhat unreadable.+ decimals = MIN(-d_exp, MAX(1, len-1));+ if (d_exp < 0 && len > 1) // Add decimal point?+ {+ int dot_pos = len-decimals;+ if (dot_pos == 0) {+ for(i = 0; i < decimals; ++i) {+ dst[len-i+1] = dst[len-i-1];+ }+ // put a 0 in front of the decimal point to make it a valid Haskell floating point number.+ dst[0] = '0';+ dst[1] = '.';+ len+= 2;+ } else {+ for(i = 0; i < decimals; ++i) {+ dst[len-i] = dst[len-i-1];+ }+ dst[dot_pos] = '.';+ len++;+ }++ d_exp += decimals;+ // Need scientific notation as well?+ if (d_exp != 0) { dst[len++] = 'e'; len += i_to_str(d_exp, dst+len); }+ }+ else if (d_exp < 0 && d_exp >= -3) // Add decimal point for numbers of form 0.000x where it's shorter?+ {+ // len here is 1!+ dst[1-d_exp] = dst[0];+ // put a 0 in front of the decimal point to make it a valid Haskell floating point number.+ dst[0] = '0';+ dst[1] = '.';+ for(i = 2; i < (1-d_exp); ++i) dst[i] = '0';+ len += -d_exp+1;+ }+ // Add scientific notation?+ else if (d_exp < 0 || d_exp > 2) { dst[len++] = 'e'; len += i_to_str(d_exp, dst+len); }+ // Add zeroes instead of scientific notation?+ else if (d_exp > 0) { while(d_exp-- > 0) dst[len++] = '0'; }+ // dst[len] = '\0'; // grisu3 doesn't null terminate, so ensure termination.+ return (int)(dst+len-dst);+}
+ src/cbits/int_encoding.c view
@@ -0,0 +1,65 @@+/*+ * Copyright (c) 2020 Nikita Volkov <nikita.y.volkov@mail.ru>.+ */++#include <string.h>+#include <stdbool.h>+#include <stdint.h>+#include <stdio.h>+#include <stdlib.h>+++void rev_poke_int64+(+ int64_t val,+ uint8_t* dst+)+{+ bool negate = false;++ if (val < 0)+ {+ int64_t b4 = val;+ val /= 10;+ if (val)+ {+ *--dst = val * 10 - b4 + 48;+ val = -val;+ negate = true;+ }+ else+ {+ *(dst - 1) = val * 10 - b4 + 48;+ *(dst - 2) = '-';+ return;+ }+ }++ do+ {+ int64_t b4 = val;+ val /= 10;+ *--dst = b4 - val * 10 + 48;+ }+ while (val);++ if (negate)+ {+ *--dst = '-';+ }+}++void rev_poke_uint64+(+ uint64_t val,+ uint8_t* dst+)+{+ do+ {+ uint64_t b4 = val;+ val /= 10;+ *--dst = b4 - val * 10 + 48;+ }+ while (val);+}
+ src/cbits/itoa.c view
@@ -0,0 +1,216 @@+///////////////////////////////////////////////////////////////+// Encoding numbers using ASCII characters //+// //+// inspired by: http://www.jb.man.ac.uk/~slowe/cpp/itoa.html //+// Borrowed from the "bytestring" library //+///////////////////////////////////////////////////////////////++#include <stdio.h>++// Decimal Encoding+///////////////////++static const char* digits = "0123456789abcdef";++// signed integers+char* int_dec (int x, char* buf)+{+ char c, *ptr = buf, *next_free;+ int x_tmp;++ // we cannot negate directly as 0 - (minBound :: Int) = minBound+ if (x < 0) {+ *ptr++ = '-';+ buf++;+ x_tmp = x;+ x /= 10;+ *ptr++ = digits[x * 10 - x_tmp];+ if (x == 0)+ return ptr;+ else+ x = -x;+ }++ // encode positive number as little-endian decimal+ do {+ x_tmp = x;+ x /= 10;+ *ptr++ = digits[x_tmp - x * 10];+ } while ( x );++ // reverse written digits+ next_free = ptr--;+ while (buf < ptr) {+ c = *ptr;+ *ptr-- = *buf;+ *buf++ = c;+ }+ return next_free;+}++// signed long long ints (64 bit integers)+char* long_long_int_dec (long long int x, char* buf)+{+ char c, *ptr = buf, *next_free;+ long long int x_tmp;++ // we cannot negate directly as 0 - (minBound :: Int) = minBound+ if (x < 0) {+ *ptr++ = '-';+ buf++;+ x_tmp = x;+ x /= 10;+ *ptr++ = digits[x * 10 - x_tmp];+ if (x == 0)+ return ptr;+ else+ x = -x;+ }++ // encode positive number as little-endian decimal+ do {+ x_tmp = x;+ x /= 10;+ *ptr++ = digits[x_tmp - x * 10];+ } while ( x );++ // reverse written digits+ next_free = ptr--;+ while (buf < ptr) {+ c = *ptr;+ *ptr-- = *buf;+ *buf++ = c;+ }+ return next_free;+}++// unsigned integers+char* uint_dec (unsigned int x, char* buf)+{+ char c, *ptr = buf, *next_free;+ unsigned int x_tmp;++ // encode positive number as little-endian decimal+ do {+ x_tmp = x;+ x /= 10;+ *ptr++ = digits[x_tmp - x * 10];+ } while ( x );++ // reverse written digits+ next_free = ptr--;+ while (buf < ptr) {+ c = *ptr;+ *ptr-- = *buf;+ *buf++ = c;+ }+ return next_free;+}++// unsigned long ints+char* long_long_uint_dec (long long unsigned int x, char* buf)+{+ char c, *ptr = buf, *next_free;+ long long unsigned int x_tmp;++ // encode positive number as little-endian decimal+ do {+ x_tmp = x;+ x /= 10;+ *ptr++ = digits[x_tmp - x * 10];+ } while ( x );++ // reverse written digits+ next_free = ptr--;+ while (buf < ptr) {+ c = *ptr;+ *ptr-- = *buf;+ *buf++ = c;+ }+ return next_free;+}+++// Padded, decimal, positive integers for the decimal output of bignums+///////////////////////////////////////////////////////////////////////++// Padded (9 digits), decimal, positive int:+// We will use it with numbers that fit in 31 bits; i.e., numbers smaller than+// 10^9, as "31 * log 2 / log 10 = 9.33"+void int_dec_padded9 (int x, char* buf)+{+ const int max_width_int32_dec = 9;+ char* ptr = buf + max_width_int32_dec;+ int x_tmp;++ // encode positive number as little-endian decimal+ do {+ x_tmp = x;+ x /= 10;+ *(--ptr) = digits[x_tmp - x * 10];+ } while ( x );++ // pad beginning+ while (buf < ptr) { *(--ptr) = '0'; }+}++// Padded (19 digits), decimal, positive long long int:+// We will use it with numbers that fit in 63 bits; i.e., numbers smaller than+// 10^18, as "63 * log 2 / log 10 = 18.96"+void long_long_int_dec_padded18 (long long int x, char* buf)+{+ const int max_width_int64_dec = 18;+ char* ptr = buf + max_width_int64_dec;+ long long int x_tmp;++ // encode positive number as little-endian decimal+ do {+ x_tmp = x;+ x /= 10;+ *(--ptr) = digits[x_tmp - x * 10];+ } while ( x );++ // pad beginning+ while (buf < ptr) { *(--ptr) = '0'; }+}+++///////////////////////+// Hexadecimal encoding+///////////////////////++// unsigned ints (32 bit words)+char* 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;+};++// unsigned long ints (64 bit words)+char* long_long_uint_hex (long long 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;+};
+ src/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;+}+#else+{++ 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;+}+#else+{+ 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
+ src/library/PtrPoker/ByteString.hs view
@@ -0,0 +1,43 @@+module PtrPoker.ByteString where++import Data.ByteString+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Builder.Extra as Builder+import qualified Data.ByteString.Builder.Scientific as ScientificBuilder+import Data.ByteString.Internal+import qualified Data.ByteString.Lazy as Lazy+import qualified PtrPoker.Compat.Text as TextCompat+import qualified PtrPoker.Ffi as Ffi+import PtrPoker.Prelude hiding (empty)++builderWithStrategy :: Builder.AllocationStrategy -> Builder.Builder -> ByteString+builderWithStrategy strategy builder =+ builder+ & Builder.toLazyByteStringWith strategy Lazy.empty+ & Lazy.toStrict++scientific :: Scientific -> ByteString+scientific sci =+ sci+ & ScientificBuilder.scientificBuilder+ & builderWithStrategy (Builder.untrimmedStrategy 128 128)++double :: Double -> ByteString+double dbl =+ unsafeCreateUptoN+ 25+ ( \ptr ->+ Ffi.pokeDouble dbl ptr+ & fmap fromIntegral+ )++unsafeCreateDownToN :: Int -> (Ptr Word8 -> IO Int) -> ByteString+unsafeCreateDownToN allocSize populate =+ unsafeDupablePerformIO $ do+ fp <- mallocByteString allocSize+ actualSize <- withForeignPtr fp (\p -> populate (plusPtr p (pred allocSize)))+ return $! PS fp (allocSize - actualSize) actualSize++{-# INLINE textUtf8 #-}+textUtf8 :: Text -> ByteString+textUtf8 = TextCompat.encodeInUtf8
+ src/library/PtrPoker/Compat/ByteString.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE CPP #-}++module PtrPoker.Compat.ByteString (poke) where++import Data.ByteString.Internal+import Foreign.Marshal.Utils+import qualified PtrPoker.Compat.ForeignPtr as ForeignPtr+import PtrPoker.Prelude hiding (poke)++{-# INLINE poke #-}+poke :: ByteString -> Ptr Word8 -> IO (Ptr Word8)++#if MIN_VERSION_bytestring(0,11,0)++poke (BS fptr length) ptr =+ {-# SCC "poke" #-}+ ForeignPtr.unsafeWithForeignPtr fptr $ \ bytesPtr ->+ copyBytes ptr bytesPtr length $>+ plusPtr ptr length++#else++poke (PS fptr offset length) ptr =+ {-# SCC "poke" #-}+ ForeignPtr.unsafeWithForeignPtr fptr $ \ bytesPtr ->+ copyBytes ptr (plusPtr bytesPtr offset) length $>+ plusPtr ptr length++#endif
+ src/library/PtrPoker/Compat/ForeignPtr.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}++module PtrPoker.Compat.ForeignPtr where++import PtrPoker.Prelude++#if MIN_VERSION_base(4,15,0)+import qualified GHC.ForeignPtr+#else+import qualified Foreign.ForeignPtr+#endif++-- | 'unsafeWithForeignPtr' compatibility wrapper.+--+-- GHC 9.0 made 'withForeignPtr' sound at the cost of performance. If you want to+-- use the faster unsafe implementation, it's now at 'unsafeWithForeignPtr', and+-- GHC asks you to promise that your continuation does not diverge. All we do here+-- is @memcpy@ bytestrings, so we gladly pinky swear. For more detail, see Ben+-- Gamari's post:+-- <https://www.haskell.org/ghc/blog/20210607-the-keepAlive-story.html>+--+-- Note that fumieval's mason uses 'unsafeWithForeignPtr' in the same way also to+-- copy bytestrings.+{-# INLINE unsafeWithForeignPtr #-}+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b+#if MIN_VERSION_base(4,15,0)+unsafeWithForeignPtr =+ GHC.ForeignPtr.unsafeWithForeignPtr+#else+unsafeWithForeignPtr =+ -- same implementation as new @unsafeWithForeignPtr@ (it was always unsafe)+ Foreign.ForeignPtr.withForeignPtr+#endif
+ src/library/PtrPoker/Compat/Text.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}++module PtrPoker.Compat.Text where++#if MIN_VERSION_text(2,0,0)+import qualified Data.Text.Array as TextArray+import qualified Data.Text.Encoding as TextEncoding+import qualified Data.Text.Internal as TextInternal+import PtrPoker.Prelude++{-# INLINE destruct #-}+destruct :: (ByteArray# -> Int -> Int -> x) -> Text -> x+destruct k (TextInternal.Text (TextArray.ByteArray arr) off len) = k arr off len++{-# INLINE utf8EncodingSize #-}+utf8EncodingSize :: Text -> Int+utf8EncodingSize = destruct $ \_arr _off len -> len++{-# INLINEABLE encodeInUtf8 #-}+encodeInUtf8 :: Text -> ByteString+encodeInUtf8 t = TextEncoding.encodeUtf8 t++{-# INLINE pokeInUtf8 #-}+pokeInUtf8 :: Text -> Ptr Word8 -> IO (Ptr Word8)+pokeInUtf8 (TextInternal.Text arr off len) p =+ stToIO (TextArray.copyToPointer arr off p len) $> plusPtr p len+#else+import qualified Data.ByteString.Internal as ByteStringInternal+import qualified Data.Text.Array as TextArray+import qualified Data.Text.Internal as TextInternal+import qualified PtrPoker.Ffi as Ffi+import PtrPoker.Prelude++{-# INLINE destruct #-}+destruct :: (ByteArray# -> Int -> Int -> x) -> Text -> x+destruct k (TextInternal.Text (TextArray.Array arr) off len) =+ k arr off len++{-# INLINEABLE utf8EncodingSize #-}+utf8EncodingSize :: Text -> Int+utf8EncodingSize (TextInternal.Text (TextArray.Array arr) off len) =+ Ffi.countTextAllocationSize+ arr+ (fromIntegral off)+ (fromIntegral len)+ & unsafeDupablePerformIO+ & fromIntegral++{-# INLINEABLE encodeInUtf8 #-}+encodeInUtf8 :: Text -> ByteString+encodeInUtf8 (TextInternal.Text (TextArray.Array arr) off len) =+ if len == 0+ then mempty+ else ByteStringInternal.unsafeCreateUptoN (len * 3) $ \ptr -> do+ postPtr <- inline Ffi.encodeText ptr arr (fromIntegral off) (fromIntegral len)+ return (minusPtr postPtr ptr)++{-# INLINE pokeInUtf8 #-}+pokeInUtf8 :: Text -> Ptr Word8 -> IO (Ptr Word8)+pokeInUtf8 (TextInternal.Text (TextArray.Array arr) off len) p =+ Ffi.encodeText p arr (fromIntegral off) (fromIntegral len)+#endif
+ src/library/PtrPoker/Ffi.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE UnliftedFFITypes #-}++module PtrPoker.Ffi where++import Foreign.C+import PtrPoker.Prelude++foreign import ccall unsafe "static int_dec"+ pokeIntInDec :: CInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static long_long_int_dec"+ pokeLongLongIntInDec :: CLLong -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static uint_dec"+ pokeUIntInDec :: CUInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static long_long_uint_dec"+ pokeLongLongUIntInDec :: CULLong -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static uint_hex"+ pokeUIntInHex :: CUInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static long_long_uint_hex"+ pokeLongLongUIntInHex :: CULLong -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static rev_poke_int64"+ revPokeInt64 :: CLLong -> Ptr Word8 -> IO ()++foreign import ccall unsafe "static rev_poke_uint64"+ revPokeUInt64 :: CULLong -> Ptr Word8 -> IO ()++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)
+ src/library/PtrPoker/IO/Prim.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE CPP #-}++module PtrPoker.IO.Prim where++import PtrPoker.Prelude++{-# INLINE pokeStorable #-}+pokeStorable :: (Storable a) => Ptr Word8 -> a -> IO ()+pokeStorable ptr value =+ {-# SCC "pokeStorable" #-}+ poke (castPtr ptr) value++{-# INLINE pokeWord8 #-}+pokeWord8 :: Ptr Word8 -> Word8 -> IO ()+pokeWord8 ptr value =+ {-# SCC "pokeWord8" #-}+ poke ptr value++{-# INLINE pokeWord8Off #-}+pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO ()+pokeWord8Off ptr off value =+ {-# SCC "pokeWord8Off" #-}+ pokeByteOff ptr off value++{-# INLINE pokeBEWord16 #-}+pokeBEWord16 :: Ptr Word8 -> Word16 -> IO ()+#ifdef WORDS_BIGENDIAN+pokeBEWord16 =+ {-# SCC "pokeBEWord16" #-}+ pokeStorable+#else+pokeBEWord16 ptr =+ {-# SCC "pokeBEWord16" #-}+ pokeStorable ptr . byteSwap16+#endif++{-# INLINE pokeBEWord32 #-}+pokeBEWord32 :: Ptr Word8 -> Word32 -> IO ()+#ifdef WORDS_BIGENDIAN+pokeBEWord32 =+ {-# SCC "pokeBEWord32" #-}+ pokeStorable+#else+pokeBEWord32 ptr =+ {-# SCC "pokeBEWord32" #-}+ pokeStorable ptr . byteSwap32+#endif++{-# INLINE pokeBEWord64 #-}+pokeBEWord64 :: Ptr Word8 -> Word64 -> IO ()+#ifdef WORDS_BIGENDIAN+pokeBEWord64 =+ {-# SCC "pokeBEWord64" #-}+ pokeStorable+#else+pokeBEWord64 ptr =+ {-# SCC "pokeBEWord64" #-}+ pokeStorable ptr . byteSwap64+#endif++{-# INLINE pokeLEWord16 #-}+pokeLEWord16 :: Ptr Word8 -> Word16 -> IO ()+#ifdef WORDS_BIGENDIAN+pokeLEWord16 ptr =+ {-# SCC "pokeLEWord16" #-}+ pokeStorable ptr . byteSwap16+#else+pokeLEWord16 =+ {-# SCC "pokeLEWord16" #-}+ pokeStorable+#endif++{-# INLINE pokeLEWord32 #-}+pokeLEWord32 :: Ptr Word8 -> Word32 -> IO ()+#ifdef WORDS_BIGENDIAN+pokeLEWord32 ptr =+ {-# SCC "pokeLEWord32" #-}+ pokeStorable ptr . byteSwap32+#else+pokeLEWord32 =+ {-# SCC "pokeLEWord32" #-}+ pokeStorable+#endif++{-# INLINE pokeLEWord64 #-}+pokeLEWord64 :: Ptr Word8 -> Word64 -> IO ()+#ifdef WORDS_BIGENDIAN+pokeLEWord64 ptr =+ {-# SCC "pokeLEWord64" #-}+ pokeStorable ptr . byteSwap64+#else+pokeLEWord64 =+ {-# SCC "pokeLEWord64" #-}+ pokeStorable+#endif
+ src/library/PtrPoker/Poke.hs view
@@ -0,0 +1,246 @@+module PtrPoker.Poke where++import qualified PtrPoker.Compat.ByteString as ByteStringCompat+import qualified PtrPoker.Compat.Text as TextCompat+import qualified PtrPoker.Ffi as Ffi+import qualified PtrPoker.IO.Prim as PrimIO+import PtrPoker.Prelude hiding (concat)++{-# RULES+"foldMap" forall f foldable.+ foldMap f foldable =+ Poke $ \p -> foldM (\p (Poke poker) -> poker p) p foldable+ #-}++-- |+-- Abstraction over an IO action,+-- which takes a pointer, populates it and+-- produces a pointer right after the populated data.+newtype Poke = Poke {pokePtr :: Ptr Word8 -> IO (Ptr Word8)}++instance Semigroup Poke where+ {-# INLINE [1] (<>) #-}+ Poke lIO <> Poke rIO =+ Poke (\p -> lIO p >>= rIO)+ sconcat =+ concat++instance Monoid Poke where+ {-# INLINE [1] mempty #-}+ mempty =+ Poke return+ mconcat =+ concat++-- |+-- Reuses the IsString instance of 'ByteString'.+instance IsString Poke where+ fromString = byteString . fromString++-- |+-- Concatenate a foldable of pokes.+{-# INLINE [1] concat #-}+concat :: (Foldable f) => f Poke -> Poke+concat pokers =+ Poke (\p -> foldM (\p (Poke io) -> io p) p pokers)++-- |+-- Efficiently copy the contents of ByteString using @memcpy@.+{-# INLINE byteString #-}+byteString :: ByteString -> Poke+byteString bs =+ Poke $ inline ByteStringCompat.poke bs++-- |+-- Encode Word8 as byte, incrementing the pointer by 1.+{-# INLINE [1] word8 #-}+word8 :: Word8 -> Poke+word8 a =+ Poke (\p -> PrimIO.pokeWord8 p a $> plusPtr p 1)++-- |+-- Encode Word16 in Little-endian.+{-# INLINE [1] lWord16 #-}+lWord16 :: Word16 -> Poke+lWord16 a =+ Poke (\p -> PrimIO.pokeLEWord16 p a $> plusPtr p 2)++-- |+-- Encode Word16 in Big-endian.+{-# INLINE [1] bWord16 #-}+bWord16 :: Word16 -> Poke+bWord16 a =+ Poke (\p -> PrimIO.pokeBEWord16 p a $> plusPtr p 2)++-- |+-- Encode Word32 in Little-endian.+{-# INLINE [1] lWord32 #-}+lWord32 :: Word32 -> Poke+lWord32 a =+ Poke (\p -> PrimIO.pokeLEWord32 p a $> plusPtr p 4)++-- |+-- Encode Word32 in Big-endian.+{-# INLINE [1] bWord32 #-}+bWord32 :: Word32 -> Poke+bWord32 a =+ Poke (\p -> PrimIO.pokeBEWord32 p a $> plusPtr p 4)++-- |+-- Encode Word64 in Little-endian.+{-# INLINE [1] lWord64 #-}+lWord64 :: Word64 -> Poke+lWord64 a =+ Poke (\p -> PrimIO.pokeLEWord64 p a $> plusPtr p 8)++-- |+-- Encode Word64 in Big-endian.+{-# INLINE [1] bWord64 #-}+bWord64 :: Word64 -> Poke+bWord64 a =+ Poke (\p -> PrimIO.pokeBEWord64 p a $> plusPtr p 8)++-- |+-- Encode Int16 in Little-endian.+{-# INLINE lInt16 #-}+lInt16 :: Int16 -> Poke+lInt16 = lWord16 . fromIntegral++-- |+-- Encode Int16 in Big-endian.+{-# INLINE bInt16 #-}+bInt16 :: Int16 -> Poke+bInt16 = bWord16 . fromIntegral++-- |+-- Encode Int32 in Little-endian.+{-# INLINE lInt32 #-}+lInt32 :: Int32 -> Poke+lInt32 = lWord32 . fromIntegral++-- |+-- Encode Int32 in Big-endian.+{-# INLINE bInt32 #-}+bInt32 :: Int32 -> Poke+bInt32 = bWord32 . fromIntegral++-- |+-- Encode Int64 in Little-endian.+{-# INLINE lInt64 #-}+lInt64 :: Int64 -> Poke+lInt64 = lWord64 . fromIntegral++-- |+-- Encode Int64 in Big-endian.+{-# INLINE bInt64 #-}+bInt64 :: Int64 -> Poke+bInt64 = bWord64 . fromIntegral++-- |+-- Encode Text in UTF8.+{-# INLINE textUtf8 #-}+textUtf8 :: Text -> Poke+textUtf8 = Poke . TextCompat.pokeInUtf8++-- * ASCII integers++-------------------------++-- |+-- Encode Int8 as a signed ASCII decimal.+{-# INLINE [1] int8AsciiDec #-}+int8AsciiDec :: Int8 -> Poke+int8AsciiDec a =+ Poke (Ffi.pokeIntInDec (fromIntegral a))++-- |+-- Encode Int16 as a signed ASCII decimal.+{-# INLINE [1] int16AsciiDec #-}+int16AsciiDec :: Int16 -> Poke+int16AsciiDec a =+ Poke (Ffi.pokeIntInDec (fromIntegral a))++-- |+-- Encode Int32 as a signed ASCII decimal.+{-# INLINE [1] int32AsciiDec #-}+int32AsciiDec :: Int32 -> Poke+int32AsciiDec a =+ Poke (Ffi.pokeIntInDec (fromIntegral a))++-- |+-- Encode Int64 as a signed ASCII decimal.+{-# INLINE [1] int64AsciiDec #-}+int64AsciiDec :: Int64 -> Poke+int64AsciiDec a =+ Poke (Ffi.pokeLongLongIntInDec (fromIntegral a))++-- |+-- Encode Int as a signed ASCII decimal.+{-# INLINE [1] intAsciiDec #-}+intAsciiDec :: Int -> Poke+intAsciiDec a =+ Poke (Ffi.pokeLongLongIntInDec (fromIntegral a))++-- |+-- Encode Word8 as an unsigned ASCII decimal.+{-# INLINE [1] word8AsciiDec #-}+word8AsciiDec :: Word8 -> Poke+word8AsciiDec a =+ Poke (Ffi.pokeUIntInDec (fromIntegral a))++-- |+-- Encode Word16 as an unsigned ASCII decimal.+{-# INLINE [1] word16AsciiDec #-}+word16AsciiDec :: Word16 -> Poke+word16AsciiDec a =+ Poke (Ffi.pokeUIntInDec (fromIntegral a))++-- |+-- Encode Word32 as an unsigned ASCII decimal.+{-# INLINE [1] word32AsciiDec #-}+word32AsciiDec :: Word32 -> Poke+word32AsciiDec a =+ Poke (Ffi.pokeUIntInDec (fromIntegral a))++-- |+-- Encode Word64 as an unsigned ASCII decimal.+{-# INLINE [1] word64AsciiDec #-}+word64AsciiDec :: Word64 -> Poke+word64AsciiDec a =+ Poke (Ffi.pokeLongLongUIntInDec (fromIntegral a))++-- |+-- Encode Word as an unsigned ASCII decimal.+{-# INLINE [1] wordAsciiDec #-}+wordAsciiDec :: Word -> Poke+wordAsciiDec a =+ Poke (Ffi.pokeLongLongUIntInDec (fromIntegral a))++-- |+-- Encode Double as a signed ASCII decimal.+{-# INLINE doubleAsciiDec #-}+doubleAsciiDec :: Double -> Poke+doubleAsciiDec a =+ Poke $ \ptr ->+ Ffi.pokeDouble a ptr+ & fmap (plusPtr ptr . fromIntegral)++-- * Low level++-------------------------++-- |+-- Having the amount of bytes to be written precomputed,+-- executes an action,+-- which fills the pointer going downward,+-- starting from the pointer that follows the chunk.+-- I.e., you have to decrement the pointer+-- before writing the first byte,+-- decrement it again before writing the second byte and so on.+{-# INLINE sizedReverse #-}+sizedReverse :: Int -> (Ptr Word8 -> IO a) -> Poke+sizedReverse size action =+ Poke $ \ptr ->+ let afterPtr =+ plusPtr ptr size+ in action afterPtr $> afterPtr
+ src/library/PtrPoker/Prelude.hs view
@@ -0,0 +1,78 @@+module PtrPoker.Prelude+ ( module Exports,+ showAsText,+ )+where++import Control.Applicative as Exports hiding (WrappedArrow (..))+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports+import Control.Monad.ST as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.ByteString as Exports (ByteString)+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports hiding (unzip)+import Data.Functor.Compose as Exports+import Data.IORef as Exports+import Data.Int as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.List.NonEmpty as Exports (NonEmpty (..))+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (Alt, (<>))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.Scientific as Exports (Scientific)+import Data.Semigroup as Exports hiding (First (..), Last (..))+import Data.String as Exports+import Data.Text as Exports (Text)+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Void as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports+import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (ByteArray#, IsList (..), groupWith, inline, lazy, sortWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import GHC.OverloadedLabels as Exports+import Numeric as Exports+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe)+import Unsafe.Coerce as Exports+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))++showAsText :: (Show a) => a -> Text+showAsText = show >>> fromString
+ src/library/PtrPoker/Size.hs view
@@ -0,0 +1,203 @@+-- |+-- Functions that compute the required allocation size by value.+module PtrPoker.Size where++import qualified PtrPoker.Compat.Text as TextCompat+import PtrPoker.Prelude++-- |+-- Efficiently count the amount of bytes required to encode Word64+-- as a decimal number in ASCII.+--+-- Implemented as a balanced tree of \"ifs\"+-- centered around the middle of the range.+-- This is much faster than anything based on logarithms.+{-# INLINE word64AsciiDec #-}+word64AsciiDec :: Word64 -> Int+word64AsciiDec x =+ if x > 9999999999+ then+ if x > 99999999999999+ then+ if x > 9999999999999999+ then+ if x > 99999999999999999+ then+ if x > 999999999999999999+ then+ if x > 9999999999999999999+ then 20+ else 19+ else 18+ else 17+ else+ if x > 999999999999999+ then 16+ else 15+ else+ if x > 999999999999+ then+ if x > 9999999999999+ then 14+ else 13+ else+ if x > 99999999999+ then 12+ else 11+ else+ if x > 99999+ then+ if x > 9999999+ then+ if x > 99999999+ then+ if x > 999999999+ then 10+ else 9+ else 8+ else+ if x > 999999+ then 7+ else 6+ else+ if x > 99+ then+ if x > 999+ then+ if x > 9999+ then 5+ else 4+ else 3+ else+ if x > 9+ then 2+ else 1++-- |+-- Efficiently count the amount of bytes required to encode Int64+-- as a signed decimal number in ASCII.+--+-- Implemented as a balanced tree of \"ifs\"+-- centered around the middle of the range.+-- This is much faster than anything based on logarithms.+{-# INLINE int64AsciiDec #-}+int64AsciiDec :: Int64 -> Int+int64AsciiDec x =+ if x < 0+ then+ if x < -9999999999+ then+ if x < -99999999999999+ then+ if x < -9999999999999999+ then+ if x < -99999999999999999+ then+ if x < -999999999999999999+ then 20+ else 19+ else 18+ else+ if x < -999999999999999+ then 17+ else 16+ else+ if x < -999999999999+ then+ if x < -9999999999999+ then 15+ else 14+ else+ if x < -99999999999+ then 13+ else 12+ else+ if x < -99999+ then+ if x < -9999999+ then+ if x < -99999999+ then+ if x < -999999999+ then 11+ else 10+ else 9+ else+ if x < -999999+ then 8+ else 7+ else+ if x < -99+ then+ if x < -999+ then+ if x < -9999+ then 6+ else 5+ else 4+ else+ if x < -9+ then 3+ else 2+ else+ if x > 9999999999+ then+ if x > 99999999999999+ then+ if x > 9999999999999999+ then+ if x > 99999999999999999+ then+ if x > 999999999999999999+ then 19+ else 18+ else 17+ else+ if x > 999999999999999+ then 16+ else 15+ else+ if x > 999999999999+ then+ if x > 9999999999999+ then 14+ else 13+ else+ if x > 99999999999+ then 12+ else 11+ else+ if x > 99999+ then+ if x > 9999999+ then+ if x > 99999999+ then+ if x > 999999999+ then 10+ else 9+ else 8+ else+ if x > 999999+ then 7+ else 6+ else+ if x > 99+ then+ if x > 999+ then+ if x > 9999+ then 5+ else 4+ else 3+ else+ if x > 9+ then 2+ else 1++-- |+-- Efficiently count the amount of bytes required to encode Text+-- in UTF8.+{-# INLINE textUtf8 #-}+textUtf8 :: Text -> Int+textUtf8 = TextCompat.utf8EncodingSize
+ src/library/PtrPoker/Write.hs view
@@ -0,0 +1,284 @@+module PtrPoker.Write where++import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Internal as ByteString+import qualified PtrPoker.ByteString as ByteString+import qualified PtrPoker.Ffi as Ffi+import qualified PtrPoker.Poke as Poke+import PtrPoker.Prelude hiding (concat)+import qualified PtrPoker.Size as Size++-- |+-- Execute Write, producing strict ByteString.+{-# INLINEABLE toByteString #-}+toByteString :: Write -> ByteString+toByteString Write {..} =+ ByteString.unsafeCreate writeSize (void . Poke.pokePtr writePoke)++-- |+-- Execute Write, producing strict ByteString.+{-# DEPRECATED writeToByteString "Use 'toByteString' instead" #-}+{-# INLINE writeToByteString #-}+writeToByteString :: Write -> ByteString+writeToByteString = toByteString++-- |+-- Specification of how many bytes to allocate and how to populate them.+--+-- Useful for creating strict bytestrings and tasks like that.+data Write = Write+ { writeSize :: Int,+ writePoke :: Poke.Poke+ }++instance Semigroup Write where+ {-# INLINE (<>) #-}+ Write lSize lPoke <> Write rSize rPoke =+ Write (lSize + rSize) (lPoke <> rPoke)+ {-# INLINE sconcat #-}+ sconcat =+ concat++instance Monoid Write where+ {-# INLINE mempty #-}+ mempty =+ Write 0 mempty+ {-# INLINE mconcat #-}+ mconcat =+ concat++-- |+-- Reuses the IsString instance of 'ByteString'.+instance IsString Write where+ {-# INLINE fromString #-}+ fromString =+ byteString . fromString++-- |+-- Force the evaluation of a write. Useful when a complex write is reused+-- multiple times to avoid recomputing its structure.+{-# INLINE force #-}+force :: Write -> Write+force = byteString . toByteString++-- |+-- Concatenate a foldable of writes.+{-# INLINE concat #-}+concat :: (Foldable f) => f Write -> Write+concat f =+ Write+ (foldl' (\a b -> a + writeSize b) 0 f)+ (Poke.Poke (\p -> foldM (\p write -> Poke.pokePtr (writePoke write) p) p f))++-- |+-- Render Word8 as byte.+{-# INLINE word8 #-}+word8 :: Word8 -> Write+word8 a =+ Write 1 (Poke.word8 a)++-- |+-- Render Word16 in Little-endian.+{-# INLINE lWord16 #-}+lWord16 :: Word16 -> Write+lWord16 a =+ Write 2 (Poke.lWord16 a)++-- |+-- Render Word16 in Big-endian.+{-# INLINE bWord16 #-}+bWord16 :: Word16 -> Write+bWord16 a =+ Write 2 (Poke.bWord16 a)++-- |+-- Render Word32 in Little-endian.+{-# INLINE lWord32 #-}+lWord32 :: Word32 -> Write+lWord32 a =+ Write 4 (Poke.lWord32 a)++-- |+-- Render Word32 in Big-endian.+{-# INLINE bWord32 #-}+bWord32 :: Word32 -> Write+bWord32 a =+ Write 4 (Poke.bWord32 a)++-- |+-- Render Word64 in Little-endian.+{-# INLINE lWord64 #-}+lWord64 :: Word64 -> Write+lWord64 a =+ Write 8 (Poke.lWord64 a)++-- |+-- Render Word64 in Big-endian.+{-# INLINE bWord64 #-}+bWord64 :: Word64 -> Write+bWord64 a =+ Write 8 (Poke.bWord64 a)++-- |+-- Render Int16 in Little-endian.+{-# INLINE lInt16 #-}+lInt16 :: Int16 -> Write+lInt16 a =+ Write 2 (Poke.lInt16 a)++-- |+-- Render Int16 in Big-endian.+{-# INLINE bInt16 #-}+bInt16 :: Int16 -> Write+bInt16 a =+ Write 2 (Poke.bInt16 a)++-- |+-- Render Int32 in Little-endian.+{-# INLINE lInt32 #-}+lInt32 :: Int32 -> Write+lInt32 a =+ Write 4 (Poke.lInt32 a)++-- |+-- Render Int32 in Big-endian.+{-# INLINE bInt32 #-}+bInt32 :: Int32 -> Write+bInt32 a =+ Write 4 (Poke.bInt32 a)++-- |+-- Render Int64 in Little-endian.+{-# INLINE lInt64 #-}+lInt64 :: Int64 -> Write+lInt64 a =+ Write 8 (Poke.lInt64 a)++-- |+-- Render Int64 in Big-endian.+{-# INLINE bInt64 #-}+bInt64 :: Int64 -> Write+bInt64 a =+ Write 8 (Poke.bInt64 a)++-- |+-- Render Word64 in ASCII decimal.+{-# INLINE word64AsciiDec #-}+word64AsciiDec :: Word64 -> Write+word64AsciiDec a =+ Write size poke+ where+ size =+ Size.word64AsciiDec a+ poke =+ Poke.sizedReverse size (Ffi.revPokeUInt64 (fromIntegral a))++-- |+-- Render Word in ASCII decimal.+{-# INLINE wordAsciiDec #-}+wordAsciiDec :: Word -> Write+wordAsciiDec =+ word64AsciiDec . fromIntegral++-- |+-- Render Int64 in ASCII decimal.+{-# INLINE int64AsciiDec #-}+int64AsciiDec :: Int64 -> Write+int64AsciiDec a =+ Write size poke+ where+ size =+ Size.int64AsciiDec a+ poke =+ Poke.sizedReverse size (Ffi.revPokeInt64 (fromIntegral a))++-- |+-- Render Int in ASCII decimal.+{-# INLINE intAsciiDec #-}+intAsciiDec :: Int -> Write+intAsciiDec =+ int64AsciiDec . fromIntegral++-- |+-- Render double interpreting non-real values,+-- such as @NaN@, @Infinity@, @-Infinity@,+-- as is.+{-# INLINE doubleAsciiDec #-}+doubleAsciiDec :: Double -> Write+doubleAsciiDec a =+ if a == 0+ then word8 48+ else+ if isNaN a+ then "NaN"+ else+ if isInfinite a+ then+ if a < 0+ then "-Infinity"+ else "Infinity"+ else+ if a < 0+ then word8 45 <> byteString (ByteString.double (negate a))+ else byteString (ByteString.double a)++-- |+-- Render double interpreting non real values,+-- such as @NaN@, @Infinity@, @-Infinity@,+-- as zero.+{-# INLINE zeroNonRealDoubleAsciiDec #-}+zeroNonRealDoubleAsciiDec :: Double -> Write+zeroNonRealDoubleAsciiDec a =+ if a == 0 || isNaN a || isInfinite a+ then word8 48+ else+ if a < 0+ then word8 45 <> byteString (ByteString.double (negate a))+ else byteString (ByteString.double a)++-- |+-- Render Scientific in ASCII decimal.+{-# INLINE scientificAsciiDec #-}+scientificAsciiDec :: Scientific -> Write+scientificAsciiDec =+ byteString . ByteString.scientific++-- |+-- Efficiently copy the contents of ByteString using @memcpy@.+{-# INLINE byteString #-}+byteString :: ByteString -> Write+byteString a =+ Write (ByteString.length a) (inline Poke.byteString a)++-- |+-- Render Text in UTF8.+--+-- Does pretty much the same as 'Data.Text.Encoding.encodeUtf8',+-- both implementation and performance-wise,+-- while allowing you to avoid redundant @memcpy@+-- compared to @('byteString' . 'Data.Text.Encoding.encodeUtf8')@.+--+-- Following are the benchmark results comparing the performance of+-- @('toByteString' . 'textUtf8')@ with+-- @Data.Text.Encoding.'Data.Text.Encoding.encodeUtf8'@+-- on inputs in Latin and Greek (requiring different number of surrogate bytes).+-- The results show that they are quite similar.+--+-- === __Benchmark results__+--+-- > textUtf8/ptr-poker/latin/1 25.61 ns+-- > textUtf8/ptr-poker/latin/10 31.59 ns+-- > textUtf8/ptr-poker/latin/100 121.5 ns+-- > textUtf8/ptr-poker/greek/1 28.54 ns+-- > textUtf8/ptr-poker/greek/10 41.97 ns+-- > textUtf8/ptr-poker/greek/100 250.3 ns+-- > textUtf8/text/latin/1 22.84 ns+-- > textUtf8/text/latin/10 31.10 ns+-- > textUtf8/text/latin/100 118.2 ns+-- > textUtf8/text/greek/1 25.80 ns+-- > textUtf8/text/greek/10 40.80 ns+-- > textUtf8/text/greek/100 293.1 ns+{-# INLINEABLE textUtf8 #-}+textUtf8 :: Text -> Write+textUtf8 a =+ Write (Size.textUtf8 a) (Poke.textUtf8 a)
+ src/test/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/test/SizeSpec.hs view
@@ -0,0 +1,40 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-}++module SizeSpec (spec) where++import qualified Data.ByteString.Char8 as Char8ByteString+import qualified Data.Text as Text+import qualified Data.Text.Encoding as TextEncoding+import qualified PtrPoker.Size as Size+import Test.Hspec+import Test.QuickCheck+import Prelude++spec :: Spec+spec = do+ describe "Size" $ do+ describe "word64AsciiDec" $ do+ it "computes correct size for Word64 ASCII decimal representation"+ $ property+ $ \a -> Size.word64AsciiDec a === length (show a)++ describe "int64AsciiDec" $ do+ it "computes correct size for Int64 ASCII decimal representation"+ $ property+ $ \a -> Size.int64AsciiDec a === length (show a)++ describe "textUtf8" $ do+ it "computes correct size for Text UTF-8 encoding (with unicode)"+ $ property+ $ \(NonEmpty str) ->+ let text = Text.pack str+ in Size.textUtf8 text === Char8ByteString.length (TextEncoding.encodeUtf8 text)++ it "computes correct size for Text UTF-8 encoding (ASCII only)"+ $ property+ $ forAll (getNonEmpty <$> (arbitrary `suchThat` (all isAsciiChar . getNonEmpty)))+ $ \str ->+ let text = Text.pack str+ in Size.textUtf8 text === Char8ByteString.length (TextEncoding.encodeUtf8 text)+ where+ isAsciiChar c = c <= '\127'
+ src/test/WriteSpec.hs view
@@ -0,0 +1,167 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-}++module WriteSpec (spec) where++import qualified Data.ByteString.Builder as ByteStringBuilder+import qualified Data.ByteString.Char8 as Char8ByteString+import qualified Data.Text as Text+import qualified Data.Text.Encoding as TextEncoding+import IsomorphismClass+import qualified Numeric.Limits as NumericLimits+import qualified PtrPoker.Write as Write+import Test.Hspec+import Test.QuickCheck+import Prelude hiding (choose)++spec :: Spec+spec = do+ describe "Write" $ do+ describe "wordAsciiDec" $ do+ it "writes Word in ASCII decimal format correctly"+ $ property+ $ \a ->+ let string = Char8ByteString.unpack (Write.toByteString (Write.wordAsciiDec a))+ in read string === a++ describe "intAsciiDec" $ do+ it "writes Int in ASCII decimal format correctly"+ $ property+ $ \a ->+ let string = Char8ByteString.unpack (Write.toByteString (Write.intAsciiDec a))+ in read string === a++ describe "doubleAsciiDec" $ do+ it "writes Double in ASCII decimal format correctly"+ $ property+ $ forAll realFloatGen+ $ \a ->+ let string = Char8ByteString.unpack (Write.toByteString (Write.doubleAsciiDec a))+ in if isNaN a+ then string === "NaN"+ else read string === a++ describe "zeroNonRealDoubleAsciiDec" $ do+ it "writes real Double in ASCII decimal format correctly"+ $ property+ $ forAll realRealFloatGen+ $ \a ->+ let string = Char8ByteString.unpack (Write.toByteString (Write.zeroNonRealDoubleAsciiDec a))+ in read string === a++ it "writes non-real Double as 0"+ $ property+ $ forAll nonRealRealFloatGen+ $ \a ->+ let string = Char8ByteString.unpack (Write.toByteString (Write.zeroNonRealDoubleAsciiDec a))+ in read @Integer string === 0++ describe "textUtf8" $ do+ it "writes ASCII text correctly"+ $ property+ $ forAll (getNonEmpty <$> (arbitrary `suchThat` (all isAsciiChar . getNonEmpty)))+ $ \str ->+ let text = Text.pack str+ in Write.toByteString (Write.textUtf8 text) === TextEncoding.encodeUtf8 text++ it "writes UTF-8 text correctly"+ $ property+ $ \(NonEmpty str) ->+ let text = Text.pack str+ in Write.toByteString (Write.textUtf8 text) === TextEncoding.encodeUtf8 text++ describe "word8" $ do+ it "writes Word8 correctly"+ $ property+ $ \a -> Write.toByteString (Write.word8 a) === to (ByteStringBuilder.word8 a)++ describe "lWord16" $ do+ it "writes Word16 in little-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.lWord16 a) === to (ByteStringBuilder.word16LE a)++ describe "bWord16" $ do+ it "writes Word16 in big-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.bWord16 a) === to (ByteStringBuilder.word16BE a)++ describe "lWord32" $ do+ it "writes Word32 in little-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.lWord32 a) === to (ByteStringBuilder.word32LE a)++ describe "bWord32" $ do+ it "writes Word32 in big-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.bWord32 a) === to (ByteStringBuilder.word32BE a)++ describe "lWord64" $ do+ it "writes Word64 in little-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.lWord64 a) === to (ByteStringBuilder.word64LE a)++ describe "bWord64" $ do+ it "writes Word64 in big-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.bWord64 a) === to (ByteStringBuilder.word64BE a)++ describe "lInt16" $ do+ it "writes Int16 in little-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.lInt16 a) === to (ByteStringBuilder.int16LE a)++ describe "bInt16" $ do+ it "writes Int16 in big-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.bInt16 a) === to (ByteStringBuilder.int16BE a)++ describe "lInt32" $ do+ it "writes Int32 in little-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.lInt32 a) === to (ByteStringBuilder.int32LE a)++ describe "bInt32" $ do+ it "writes Int32 in big-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.bInt32 a) === to (ByteStringBuilder.int32BE a)++ describe "lInt64" $ do+ it "writes Int64 in little-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.lInt64 a) === to (ByteStringBuilder.int64LE a)++ describe "bInt64" $ do+ it "writes Int64 in big-endian format correctly"+ $ property+ $ \a -> Write.toByteString (Write.bInt64 a) === to (ByteStringBuilder.int64BE a)++-- * Generators++realFloatGen :: Gen Double+realFloatGen =+ frequency+ [ (99, realRealFloatGen),+ (1, nonRealRealFloatGen)+ ]++nonRealRealFloatGen :: Gen Double+nonRealRealFloatGen =+ elements [0 / 0, 1 / 0, (-1) / 0, -0.0]++realRealFloatGen :: Gen Double+realRealFloatGen =+ frequency+ [ (50, fullRangeExponentialRealFloatGen),+ (50, simpleZeroToOneRealFloatGen)+ ]++fullRangeExponentialRealFloatGen :: Gen Double+fullRangeExponentialRealFloatGen =+ choose (NumericLimits.minValue, NumericLimits.maxValue)++simpleZeroToOneRealFloatGen :: Gen Double+simpleZeroToOneRealFloatGen = do+ int <- choose (0 :: Int, 999999)+ return (read ("0." <> show int))++isAsciiChar :: Char -> Bool+isAsciiChar c = c <= '\127'
− test/Main.hs
@@ -1,204 +0,0 @@-{-# OPTIONS_GHC -Wno-missing-signatures #-}--module Main where--import qualified Data.ByteString.Builder as ByteStringBuilder-import qualified Data.ByteString.Char8 as Char8ByteString-import qualified Data.Text.Encoding as Text-import Hedgehog-import qualified Hedgehog.Gen as Gen-import Hedgehog.Main-import qualified Hedgehog.Range as Range-import IsomorphismClass-import qualified Numeric.Limits as NumericLimits-import qualified PtrPoker.Size as Size-import qualified PtrPoker.Write as Write-import Prelude--main =- defaultMain $ pure $ checkParallel $ $$(discover)--prop_word64Size =- property $ do- a <- forAll (Gen.word64 (Range.exponential minBound maxBound))- Size.word64AsciiDec a- === length (show a)--prop_int64Size =- property $ do- a <- forAll (Gen.int64 (Range.exponential minBound maxBound))- Size.int64AsciiDec a- === length (show a)--prop_wordAsciiDec =- property $ do- a <- forAll (Gen.word (Range.exponential minBound maxBound))- let string =- Char8ByteString.unpack (Write.writeToByteString (Write.wordAsciiDec a))- annotate string- read string === a--prop_intAsciiDec =- property $ do- a <- forAll (Gen.int (Range.exponential minBound maxBound))- let string =- Char8ByteString.unpack (Write.writeToByteString (Write.intAsciiDec a))- annotate string- read string === a--prop_doubleAsciiDec =- property $ do- a <- forAll realFloatGen- let string =- Char8ByteString.unpack (Write.writeToByteString (Write.doubleAsciiDec a))- annotate string- if isNaN a- then string === "NaN"- else read string === a--prop_realZeroNonRealDoubleAsciiDec =- property $ do- a <- forAll realRealFloatGen- let string =- Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a))- annotate string- read string === a--prop_nonRealZeroNonRealDoubleAsciiDec =- withTests 99- $ property- $ do- a <- forAll nonRealRealFloatGen- let string =- Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a))- annotate string- read @Integer string === 0--prop_sizeOfTextUtf8 =- property $ do- a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode]))- Size.textUtf8 a- === Char8ByteString.length (Text.encodeUtf8 a)--prop_sizeOfTextASCII =- property $ do- a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii)- Size.textUtf8 a- === Char8ByteString.length (Text.encodeUtf8 a)--prop_textASCII =- property $ do- a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii)- Write.writeToByteString (Write.textUtf8 a)- === Text.encodeUtf8 a--prop_textUtf8 =- property $ do- a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode]))- Write.writeToByteString (Write.textUtf8 a)- === Text.encodeUtf8 a--prop_word8 =- property $ do- a <- forAll (Gen.word8 Range.constantBounded)- Write.writeToByteString (Write.word8 a)- === to (ByteStringBuilder.word8 a)--prop_lWord16 =- property $ do- a <- forAll (Gen.word16 Range.constantBounded)- Write.writeToByteString (Write.lWord16 a)- === to (ByteStringBuilder.word16LE a)--prop_bWord16 =- property $ do- a <- forAll (Gen.word16 Range.constantBounded)- Write.writeToByteString (Write.bWord16 a)- === to (ByteStringBuilder.word16BE a)--prop_lWord32 =- property $ do- a <- forAll (Gen.word32 Range.constantBounded)- Write.writeToByteString (Write.lWord32 a)- === to (ByteStringBuilder.word32LE a)--prop_bWord32 =- property $ do- a <- forAll (Gen.word32 Range.constantBounded)- Write.writeToByteString (Write.bWord32 a)- === to (ByteStringBuilder.word32BE a)--prop_lWord64 =- property $ do- a <- forAll (Gen.word64 Range.constantBounded)- Write.writeToByteString (Write.lWord64 a)- === to (ByteStringBuilder.word64LE a)--prop_bWord64 =- property $ do- a <- forAll (Gen.word64 Range.constantBounded)- Write.writeToByteString (Write.bWord64 a)- === to (ByteStringBuilder.word64BE a)--prop_lInt16 =- property $ do- a <- forAll (Gen.int16 Range.constantBounded)- Write.writeToByteString (Write.lInt16 a)- === to (ByteStringBuilder.int16LE a)--prop_bInt16 =- property $ do- a <- forAll (Gen.int16 Range.constantBounded)- Write.writeToByteString (Write.bInt16 a)- === to (ByteStringBuilder.int16BE a)--prop_lInt32 =- property $ do- a <- forAll (Gen.int32 Range.constantBounded)- Write.writeToByteString (Write.lInt32 a)- === to (ByteStringBuilder.int32LE a)--prop_bInt32 =- property $ do- a <- forAll (Gen.int32 Range.constantBounded)- Write.writeToByteString (Write.bInt32 a)- === to (ByteStringBuilder.int32BE a)--prop_lInt64 =- property $ do- a <- forAll (Gen.int64 Range.constantBounded)- Write.writeToByteString (Write.lInt64 a)- === to (ByteStringBuilder.int64LE a)--prop_bInt64 =- property $ do- a <- forAll (Gen.int64 Range.constantBounded)- Write.writeToByteString (Write.bInt64 a)- === to (ByteStringBuilder.int64BE a)---- * Gens-----------------------------realFloatGen =- Gen.frequency- [ (99, realRealFloatGen),- (1, nonRealRealFloatGen)- ]--nonRealRealFloatGen =- Gen.element [0 / 0, 1 / 0, (-1) / 0, -0]--realRealFloatGen =- Gen.frequency- [ (50, fullRangeExponentialRealFloatGen),- (50, simpleZeroToOneRealFloatGen)- ]--fullRangeExponentialRealFloatGen =- Gen.realFloat (Range.exponentialFloat NumericLimits.minValue NumericLimits.maxValue)--simpleZeroToOneRealFloatGen =- do- int <- Gen.int (Range.exponential 0 999999)- return (read ("0." <> show int))