rhi/bytebuild
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Correct encoding of Doubles again

Browse source
This commit is contained in:
Andrew Martin 2021-01-22 11:13:02 -05:00
parent e4ecf54aba
commit e79864aa0d
3 changed files with 19 additions and 71 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
bytebuild.cabal
View file

@ -1,6 +1,6 @@
cabal-version: 2.2
name: bytebuild
version: 0.3.7.1
version: 0.3.8.0
synopsis: Serialize to a small byte arrays
description:
This is similar to the builder facilities provided by

74
cbits/bytebuild_custom.c
View file

@ -1,73 +1,11 @@
#include "Rts.h"
#include <stdint.h>
#define BYTEBUILD_DOUBLE_PRECISION 0.00000000000001
#include <string.h>
HsInt bytebuild_paste_double(char *s0, HsInt off, double n) {
char* s = s0 + off;
// handle special cases
if (n == 0 || isnan(n) || isinf(n)) {
*s = '0';
return 1;
} else {
int digit, m, m1;
char *c = s;
int neg = (n < 0);
if (neg)
n = -n;
// calculate magnitude
m = log10(n);
int useExp = (m >= 14 || (neg && m >= 9) || m <= -9);
if (neg)
*(c++) = '-';
// set up for scientific notation
if (useExp) {
if (m < 0)
m -= 1.0;
n = n / pow(10.0, m);
m1 = m;
m = 0;
}
if (m < 1.0) {
m = 0;
}
// convert the number
while (n > BYTEBUILD_DOUBLE_PRECISION || m >= 0) {
double weight = pow(10.0, m);
if (weight > 0 && !isinf(weight)) {
digit = floor(n / weight);
n -= (digit * weight);
*(c++) = '0' + digit;
}
if (m == 0 && n > 0)
*(c++) = '.';
m--;
}
if (useExp) {
// convert the exponent
int i, j;
*(c++) = 'e';
if (m1 > 0) {
*(c++) = '+';
} else {
*(c++) = '-';
m1 = -m1;
}
m = 0;
while (m1 > 0) {
*(c++) = '0' + m1 % 10;
m1 /= 10;
m++;
}
c -= m;
for (i = 0, j = m-1; i<j; i++, j--) {
// swap without temporary
c[i] ^= c[j];
c[j] ^= c[i];
c[i] ^= c[j];
}
c += m;
}
return (c - s);
}
char* start = s0 + off;
memset(start,0,32);
sprintf(s0 + off,"%.14g", n);
size_t r = strlen(start);
return (HsInt)r;
}

14
test/Main.hs
View file

@ -129,7 +129,7 @@ tests = testGroup "Tests"
, THU.testCase "doubleDec-D" $
pack ("-42") @=? runConcat 1 (doubleDec (-42))
, THU.testCase "doubleDec-E" $
pack ("-8.88888888888888e+14") @=? runConcat 1 (doubleDec (-888888888888888.8888888))
AsciiByteArray (pack ("-8.8888888888889e+14")) @=? AsciiByteArray (runConcat 1 (doubleDec (-888888888888888.8888888)))
, THU.testCase "doubleDec-F" $
pack ("42") @=? runConcat 1 (doubleDec 42)
, THU.testCase "doubleDec-G" $
@ -143,7 +143,17 @@ tests = testGroup "Tests"
, THU.testCase "doubleDec-K" $
pack ("-99999999") @=? runConcat 1 (doubleDec (-99999999))
, THU.testCase "doubleDec-L" $
AsciiByteArray (pack ("6.66666666666666e-12")) @=? AsciiByteArray (runConcat 1 (doubleDec (2 / 300_000_000_000)))
AsciiByteArray (pack ("6.6666666666667e-12")) @=? AsciiByteArray (runConcat 1 (doubleDec (2 / 300_000_000_000)))
, THU.testCase "doubleDec-M" $
AsciiByteArray (pack ("6.6666666666667e-10")) @=? AsciiByteArray (runConcat 1 (doubleDec 6.666666666666667e-10))
, THU.testCase "doubleDec-N" $
AsciiByteArray (pack ("5e-10")) @=? AsciiByteArray (runConcat 1 (doubleDec 5.0e-10))
, THU.testCase "doubleDec-O" $
AsciiByteArray (pack ("1.6666666666667e-10")) @=? AsciiByteArray (runConcat 1 (doubleDec 1.6666666666666669e-10))
, THU.testCase "doubleDec-P" $
AsciiByteArray (pack ("1e-09")) @=? AsciiByteArray (runConcat 1 (doubleDec 1.0e-9))
, THU.testCase "doubleDec-Q" $
AsciiByteArray (pack ("1e-08")) @=? AsciiByteArray (runConcat 1 (doubleDec 1.0e-8))
, THU.testCase "shortTextJsonString-A" $
pack ("\"hello\"") @=? runConcat 1 (shortTextJsonString "hello")
, THU.testCase "shortTextJsonString-B" $