Skip to content
New issue

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

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

Already on GitHub? Sign in to your account

Use fmtlib's Dragonbox #1612

Closed
wants to merge 3 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
223 changes: 35 additions & 188 deletions src/core/float_to_digits.cc
Original file line number Diff line number Diff line change
Expand Up @@ -23,19 +23,6 @@ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/
/* -^- */
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
Copyright (c) 2010, Juan Jose Garcia Ripoll.
Copyright (c) 2012, Christian E. Schafmeister

ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

See file '../../Copyright' for full details.
*/

#include <clasp/core/foundation.h>
#include <clasp/core/object.h>
Expand All @@ -49,174 +36,34 @@ THE SOFTWARE.

namespace core {

#define PRINT_BASE clasp_make_fixnum(10)
#define EXPT_RADIX(x) clasp_ash(clasp_make_fixnum(1), x)

typedef struct {
Real_sp r;
Real_sp s;
Real_sp mm;
Real_sp mp;
bool high_ok;
bool low_ok;
} float_approx;

Real_sp times2(Real_sp x) { return gc::As<Real_sp>(clasp_plus(x, x)); }

static float_approx* setup(Float_sp number, float_approx* approx) {
Real_mv mv_f = cl__integer_decode_float(number);
Integer_sp f = gc::As<Integer_sp>(mv_f);
MultipleValues& mvn = core::lisp_multipleValues();
Fixnum_sp fne = gc::As<Fixnum_sp>(mvn.valueGet(1, mv_f.number_of_values()));
Fixnum e = fne.unsafe_fixnum(), min_e;
bool limit_f = 0;
switch (clasp_t_of(number)) {
case number_SingleFloat:
min_e = FLT_MIN_EXP;
limit_f = (unbox_single_float(gc::As<SingleFloat_sp>(number)) == ldexpf(FLT_RADIX, FLT_MANT_DIG - 1));
break;
case number_DoubleFloat:
min_e = DBL_MIN_EXP;
limit_f = (gc::As<DoubleFloat_sp>(number)->get() == ldexp(FLT_RADIX, DBL_MANT_DIG - 1));
break;
#ifdef CLASP_LONG_FLOAT
case number_LongFloat:
min_e = LDBL_MIN_EXP;
limit_f = (number.as<LongFloat_O>()->get() == ldexpl(FLT_RADIX, LDBL_MANT_DIG - 1));
#endif
default:
SIMPLE_ERROR("Illegal type");
}
approx->low_ok = approx->high_ok = clasp_evenp(f);
if (e > 0) {
Real_sp be = EXPT_RADIX(e);
if (limit_f) {
Real_sp be1 = gc::As<Real_sp>(clasp_times(be, clasp_make_fixnum(FLT_RADIX)));
approx->r = times2(gc::As<Real_sp>(clasp_times(f, be1)));
approx->s = clasp_make_fixnum(FLT_RADIX * 2);
approx->mm = be;
approx->mp = be1;
} else {
approx->r = times2(gc::As<Real_sp>(clasp_times(f, be)));
approx->s = clasp_make_fixnum(2);
approx->mm = be;
approx->mp = be;
}
} else if (!limit_f || (e == min_e)) {
approx->r = times2(f);
approx->s = times2(EXPT_RADIX(-e));
approx->mp = clasp_make_fixnum(1);
approx->mm = clasp_make_fixnum(1);
} else {
approx->r = times2(clasp_make_fixnum(FLT_RADIX));
approx->s = times2(EXPT_RADIX(1 - e));
approx->mp = clasp_make_fixnum(FLT_RADIX);
approx->mm = clasp_make_fixnum(1);
}
return approx;
}
template <typename T> T_mv float_to_digits(T_sp tdigits, T number, T_sp round_position, T_sp relativep) {
using significand_type = typename fmt::detail::dragonbox::decimal_fp<T>::significand_type;

static Fixnum scale(float_approx* approx) {
Fixnum k = 0;
Real_sp x = gc::As<Real_sp>(clasp_plus(approx->r, approx->mp));
int sign;
do {
sign = clasp_number_compare(x, approx->s);
if (approx->high_ok) {
if (sign < 0)
break;
} else {
if (sign <= 0)
break;
}
approx->s = gc::As<Real_sp>(clasp_times(approx->s, PRINT_BASE));
k++;
} while (1);
do {
x = gc::As<Real_sp>(clasp_times(x, PRINT_BASE));
sign = clasp_number_compare(x, approx->s);
if (approx->high_ok) {
if (sign >= 0)
break;
} else {
if (sign > 0)
break;
}
k--;
approx->r = gc::As<Real_sp>(clasp_times(approx->r, PRINT_BASE));
approx->mm = gc::As<Real_sp>(clasp_times(approx->mm, PRINT_BASE));
approx->mp = gc::As<Real_sp>(clasp_times(approx->mp, PRINT_BASE));
} while (1);
return k;
}
StrNs_sp digits = tdigits.nilp() ? gc::As<StrNs_sp>(core__make_vector(cl::_sym_base_char, 10, true, clasp_make_fixnum(0)))
: gc::As<StrNs_sp>(tdigits);
auto decimal = fmt::detail::dragonbox::to_decimal(number);
int digit_count = fmt::detail::count_digits(decimal.significand);
auto position = decimal.exponent + digit_count;

static StrNs_sp generate(StrNs_sp digits, float_approx* approx) {
Real_sp d, x;
gctools::Fixnum digit;
bool tc1, tc2;
MultipleValues& mvn = core::lisp_multipleValues();
do {
Real_mv mv_d = clasp_truncate2(gc::As<Real_sp>(clasp_times(approx->r, PRINT_BASE)), approx->s);
d = mv_d;
approx->r = gc::As<Real_sp>(mvn.valueGet(1, mv_d.number_of_values()));
approx->mp = gc::As<Real_sp>(clasp_times(approx->mp, PRINT_BASE));
approx->mm = gc::As<Real_sp>(clasp_times(approx->mm, PRINT_BASE));
tc1 = approx->low_ok ? clasp_lowereq(approx->r, approx->mm) : clasp_lower(approx->r, approx->mm);
x = gc::As<Real_sp>(clasp_plus(approx->r, approx->mp));
tc2 = approx->high_ok ? clasp_greatereq(x, approx->s) : clasp_greater(x, approx->s);
if (tc1 || tc2) {
break;
}
digits->vectorPushExtend(clasp_make_character(clasp_digit_char(gc::As<Fixnum_sp>(d).unsafe_fixnum(), 10)));
} while (1);
if (tc2 && !tc1) {
digit = clasp_safe_fixnum(d) + 1;
} else if (tc1 && !tc2) {
digit = clasp_safe_fixnum(d);
} else if (clasp_lower(times2(approx->r), approx->s)) {
digit = clasp_safe_fixnum(d);
} else {
digit = clasp_safe_fixnum(d) + 1;
}
digits->vectorPushExtend(clasp_make_character(clasp_digit_char(digit, 10)));
return digits;
}
if (round_position.notnilp()) {
int pos = gc::As<Fixnum_sp>(round_position).unsafe_fixnum();
pos = relativep.nilp() ? (position - pos) : (pos + 1);

static void change_precision(float_approx* approx, T_sp tposition, T_sp relativep) {
if (tposition.nilp())
return;
gctools::Fixnum pos;
Fixnum_sp position = gc::As<Fixnum_sp>(tposition);
pos = position.unsafe_fixnum();
if (!relativep.nilp()) {
Real_sp k = clasp_make_fixnum(0);
Real_sp l = clasp_make_fixnum(1);
while (clasp_lower(clasp_times(approx->s, l), clasp_plus(approx->r, approx->mp))) {
k = gc::As<Real_sp>(clasp_one_plus(k));
l = gc::As<Real_sp>(clasp_times(l, PRINT_BASE));
}
position = gc::As<Real_sp>(clasp_minus(k, position));
{
Real_sp e1 = gc::As<Real_sp>(cl__expt(PRINT_BASE, position));
Real_sp e2 = gc::As<Real_sp>(clasp_divide(e1, clasp_make_fixnum(2)));
if (clasp_greatereq(clasp_plus(approx->r, clasp_times(approx->s, e1)), clasp_times(approx->s, e2)))
position = gc::As<Real_sp>(clasp_one_minus(position));
if (pos < 0) {
position -= pos;
pos = 0;
}
}
{
Real_sp x = gc::As<Real_sp>(clasp_times(approx->s, cl__expt(PRINT_BASE, position)));
Real_sp e = gc::As<Real_sp>(clasp_divide(x, clasp_make_fixnum(2)));
Real_sp low = clasp_max2(approx->mm, e);
Real_sp high = clasp_max2(approx->mp, e);
if (clasp_lowereq(approx->mm, low)) {
approx->mm = low;
approx->low_ok = 1;
}
if (clasp_lowereq(approx->mp, high)) {
approx->mp = high;
approx->high_ok = 1;

if (pos < digit_count) {
significand_type divisor = std::pow(10, digit_count - pos);
decimal.significand = (decimal.significand + (divisor / 2)) / divisor;
}
}

for (auto ch : std::to_string(decimal.significand))
digits->vectorPushExtend(clasp_make_character(ch), 64);

return Values(clasp_make_fixnum((decimal.significand == 0) ? 0 : position), digits);
}

CL_LAMBDA(digits number position relativep);
Expand All @@ -225,20 +72,20 @@ CL_DOCSTRING(R"dx(float_to_digits)dx");
DOCGROUP(clasp);
CL_DEFUN T_mv core__float_to_digits(T_sp tdigits, Float_sp number, T_sp position, T_sp relativep) {
ASSERT(tdigits.nilp() || gc::IsA<Str8Ns_sp>(tdigits));
gctools::Fixnum k;
float_approx approx[1];
setup(number, approx);
change_precision(approx, position, relativep);
k = scale(approx);
StrNs_sp digits;
if (tdigits.nilp()) {
digits =
gc::As<StrNs_sp>(core__make_vector(cl::_sym_base_char, 10, true /* adjustable */, clasp_make_fixnum(0) /* fill pointer */));
} else {
digits = gc::As<StrNs_sp>(tdigits);

switch (clasp_t_of(number)) {
case number_SingleFloat:
return float_to_digits<float>(tdigits, unbox_single_float(gc::As<SingleFloat_sp>(number)), position, relativep);
case number_DoubleFloat:
return float_to_digits<double>(tdigits, gc::As<DoubleFloat_sp>(number)->get(), position, relativep);
break;
#ifdef CLASP_LONG_FLOAT
case number_LongFloat:
return float_to_digits<LongFloat>(tdigits, gc::As<LongFloat_sp>(number)->get(), position, relativep);
#endif
default:
SIMPLE_ERROR("Illegal type");
}
generate(digits, approx);
return Values(clasp_make_fixnum(k), digits);
}

SYMBOL_EXPORT_SC_(CorePkg, float_to_digits);
Expand Down
2 changes: 2 additions & 0 deletions src/core/float_to_string.cc
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,8 @@ T_sp core_float_to_string_free(Float_sp number, Number_sp e_min, Number_sp e_max
/* Do we have to print in exponent notation? */
if (clasp_lowereq(exp, e_min) || clasp_lowereq(e_max, exp)) {
insert_char(buffer, base + 1, '.');
if (gc::As<StrNs_sp>(buffer)->fillPointer() == base + 2)
buffer->vectorPushExtend(clasp_make_character('0'));
print_float_exponent(buffer, number, e - 1);
} else if (e > 0) {
gc::Fixnum l = gc::As<StrNs_sp>(buffer)->fillPointer() - base;
Expand Down
18 changes: 16 additions & 2 deletions src/lisp/kernel/lsp/format.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -1374,14 +1374,27 @@
nil)))
(if (and w ovf e (> elen e)) ;exponent overflow
(dotimes (i w) (write-char ovf stream))
(multiple-value-bind (fstr flen lpoint)
(multiple-value-bind (fstr flen lpoint tpoint dpos)
(sys::flonum-to-string number spaceleft fdig (- expt) fmin)
(when (and (plusp k)
(< k dpos))
(incf expt (- dpos k))
(setf estr (decimal-string (abs expt))
tpoint nil)
(loop for pos from dpos downto k
do (setf (char fstr pos) (if (= pos k) #\. (char fstr (1- pos))))))
(when (eql fdig 0)
(setq tpoint nil))
(when w
(decf spaceleft flen)
(when lpoint
(if (> spaceleft 0)
(decf spaceleft)
(setq lpoint nil))))
(setq lpoint nil)))
(when tpoint
(if (> spaceleft 0)
(decf spaceleft)
(setq tpoint nil))))
(cond ((and w (< spaceleft 0) ovf)
;;significand overflow
(dotimes (i w) (write-char ovf stream)))
Expand All @@ -1392,6 +1405,7 @@
(if atsign (write-char #\+ stream)))
(when lpoint (write-char #\0 stream))
(write-string fstr stream)
(when tpoint (write-char #\0 stream))
(write-char (if marker
marker
(format-exponent-marker number))
Expand Down
1 change: 0 additions & 1 deletion tools-for-build/ansi-test-expected-failures.sexp
Original file line number Diff line number Diff line change
Expand Up @@ -87,7 +87,6 @@ DEFCLASS.FORWARD-REF.3
DEFSTRUCT.ERROR.3
DEFSTRUCT.ERROR.4
ALL-EXPORTED-CL-CLASS-NAMES-ARE-VALID
FORMAT.E.6
FORMAT.E.26

DEFINE-METHOD-COMBINATION-LONG.05.2
Expand Down
Loading