Merge branch 'sal/float_to_list_2/OTP-10752'

* sal/float_to_list_2/OTP-10752:
  Text representation of a float formatted using given options.

11 files changed, 318 insertions, 16 deletions

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index ce59908036..d09f286e36 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -968,6 +968,37 @@ true
       </desc>
     </func>
     <func>
+      <name>float_to_list(Float, Options) -> string()</name>
+      <fsummary>Text representation of a float formatted using given options</fsummary>
+      <type>
+        <v>Float = float()</v>
+        <v>Options = [Option]</v>
+        <v>Option = {decimals, Decimals::0..249} |
+                    {scientific, Decimals::0..249} |
+                    compact</v>
+      </type>
+      <desc>
+        <p>Returns a string which corresponds to the text
+          representation of <c>Float</c> using fixed decimal point formatting.
+          When <c>decimals</c> option is specified
+          the returned value will contain at most <c>Decimals</c> number of
+          digits past the decimal point.  If the number doesn't fit in the
+          internal static buffer of 256 bytes, the function throws <c>badarg</c>.
+          When <c>compact</c> option is provided
+          the trailing zeros at the end of the list are truncated (this option is
+          only meaningful together with the <c>decimals</c> option). When
+          <c>scientific</c> option is provided, the float will be formatted using
+          scientific notation with <c>Decimals</c> digits of precision. If
+          <c>Options</c> is <c>[]</c> the function behaves like <c>float_to_list/1</c>.
+          </p>
+        <pre>
+> <input>float_to_list(7.12, [{decimals, 4}]).</input>
+"7.1200"
+> <input>float_to_list(7.12, [{decimals, 4}, compact]).</input>
+"7.12"</pre>
+      </desc>
+    </func>
+    <func>
       <name name="fun_info" arity="1"/>
       <fsummary>Information about a fun</fsummary>
       <desc>
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index c47a608215..b74e2785e5 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -144,6 +144,7 @@ atom close
 atom closed
 atom code
 atom command
+atom compact
 atom compat_rel
 atom compile
 atom compressed
@@ -165,6 +166,7 @@ atom current_location
 atom current_stacktrace
 atom data
 atom debug_flags
+atom decimals
 atom delay_trap
 atom dexit
 atom depth
@@ -480,6 +482,7 @@ atom scheduler
 atom scheduler_id
 atom schedulers_online
 atom scheme
+atom scientific
 atom scope
 atom sensitive
 atom sequential_tracer
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 97c8114437..182129cd36 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -2917,7 +2917,73 @@ BIF_RETTYPE float_to_list_1(BIF_ALIST_1)
      need = i*2;
      hp = HAlloc(BIF_P, need);
      BIF_RET(buf_to_intlist(&hp, fbuf, i, NIL));
- }
+}
+
+BIF_RETTYPE float_to_list_2(BIF_ALIST_2)
+{
+    const static int arity_two = make_arityval(2);
+    int decimals = SYS_DEFAULT_FLOAT_DECIMALS;
+    int compact = 0;
+    enum fmt_type_ {
+        FMT_LEGACY,
+        FMT_FIXED,
+        FMT_SCIENTIFIC
+    } fmt_type = FMT_LEGACY;
+    Eterm list = BIF_ARG_2;
+    Eterm arg;
+    int i;
+    Uint need;
+    Eterm* hp;
+    FloatDef f;
+    char fbuf[256];
+
+    /* check the arguments */
+    if (is_not_float(BIF_ARG_1))
+        goto badarg;
+
+    for(; is_list(list); list = CDR(list_val(list))) {
+        arg = CAR(list_val(list));
+        if (arg == am_compact) {
+            compact = 1;
+            continue;
+        } else if (is_tuple(arg)) {
+            Eterm* tp = tuple_val(arg);
+            if (*tp == arity_two && is_small(tp[2])) {
+                decimals = signed_val(tp[2]);
+                if (decimals > 0 && decimals < sizeof(fbuf) - 6 /* "X." ++ "e+YY" */)
+                    switch (tp[1]) {
+                        case am_decimals:
+                            fmt_type = FMT_FIXED;
+                            continue;
+                        case am_scientific:
+                            fmt_type = FMT_SCIENTIFIC;
+                            continue;
+                    }
+            }
+        }
+        goto badarg;
+    }
+    if (is_not_nil(list)) {
+        goto badarg;
+    }
+
+    GET_DOUBLE(BIF_ARG_1, f);
+
+    if (fmt_type == FMT_FIXED) {
+        if ((i = sys_double_to_chars_fast(f.fd, fbuf, sizeof(fbuf),
+                decimals, compact)) <= 0)
+            goto badarg;
+    } else {
+        if ((i = sys_double_to_chars_ext(f.fd, fbuf, sizeof(fbuf), decimals)) <= 0)
+            goto badarg;
+    }
+
+    need = i*2;
+    hp = HAlloc(BIF_P, need);
+    BIF_RET(buf_to_intlist(&hp, fbuf, i, NIL));
+badarg:
+    BIF_ERROR(BIF_P, BADARG);
+}
 
 /**********************************************************************/
 
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 59a91cd40c..a79feb6da3 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -64,6 +64,7 @@ bif erlang:external_size/1
 bif erlang:external_size/2
 ubif erlang:float/1
 bif erlang:float_to_list/1
+bif erlang:float_to_list/2
 bif erlang:fun_info/2
 bif erlang:garbage_collect/0
 bif erlang:garbage_collect/1
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 898a30b010..cecaff54a4 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -729,9 +729,12 @@ char * getenv_string(GETENV_STATE *);
 void fini_getenv_state(GETENV_STATE *);
 
 /* xxxP */
+#define SYS_DEFAULT_FLOAT_DECIMALS 20
 void init_sys_float(void);
 int sys_chars_to_double(char*, double*);
 int sys_double_to_chars(double, char*, size_t);
+int sys_double_to_chars_ext(double, char*, size_t, size_t);
+int sys_double_to_chars_fast(double, char*, int, int, int);
 void sys_get_pid(char *, size_t);
 
 /* erts_sys_putenv() returns, 0 on success and a value != 0 on failure. */
diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c
index 461e763f03..d22914acea 100644
--- a/erts/emulator/sys/common/erl_sys_common_misc.c
+++ b/erts/emulator/sys/common/erl_sys_common_misc.c
@@ -105,3 +105,154 @@ int erts_get_native_filename_encoding(void)
 {
     return filename_encoding;
 }
+
+/* For internal use by sys_double_to_chars_fast() */
+static char* float_first_trailing_zero(char* p)
+{
+    for (--p; *p == '0' && *(p-1) == '0'; --p);
+    if (*(p-1) == '.') ++p;
+    return p;
+}
+
+int
+sys_double_to_chars(double fp, char *buffer, size_t buffer_size)
+{
+    return sys_double_to_chars_ext(fp, buffer, buffer_size, SYS_DEFAULT_FLOAT_DECIMALS);
+}
+
+int
+sys_double_to_chars_fast(double f, char *outbuf, int maxlen, int decimals, int compact)
+{
+    enum {
+          FRAC_SIZE  = 52
+        , EXP_SIZE   = 11
+        , EXP_MASK   = (1ll << EXP_SIZE) - 1
+        , FRAC_MASK  = (1ll << FRAC_SIZE) - 1
+        , FRAC_MASK2 = (1ll << (FRAC_SIZE + 1)) - 1
+        , MAX_FLOAT  = 1ll << (FRAC_SIZE+1)
+    };
+
+    long long mantissa, int_part, int_part2, frac_part;
+    short exp;
+    int sign, i, n, m, max;
+    double absf;
+    union { long long L; double F; } x;
+    char c, *p = outbuf;
+    int digit, roundup;
+
+    x.F = f;
+
+    exp      = (x.L >> FRAC_SIZE) & EXP_MASK;
+    mantissa = x.L & FRAC_MASK;
+    sign     = x.L >= 0 ? 1 : -1;
+    if (exp == EXP_MASK) {
+        if (mantissa == 0) {
+            if (sign == -1)
+                *p++ = '-';
+            *p++ = 'i';
+            *p++ = 'n';
+            *p++ = 'f';
+        } else {
+            *p++ = 'n';
+            *p++ = 'a';
+            *p++ = 'n';
+        }
+        *p = '\0';
+        return p - outbuf;
+    }
+
+    exp      -= EXP_MASK >> 1;
+    mantissa |= (1ll << FRAC_SIZE);
+    frac_part = 0;
+    int_part  = 0;
+    absf      = f * sign;
+
+    /* Don't bother with optimizing too large numbers and decimals */
+    if (absf > MAX_FLOAT || decimals > maxlen-17) {
+        int len = erts_snprintf(outbuf, maxlen, "%.*f", decimals, f);
+        if (len >= maxlen)
+            return -1;
+        p = outbuf + len;
+        /* Delete trailing zeroes */
+        if (compact)
+            p = float_first_trailing_zero(outbuf + len);
+        *p = '\0';
+        return p - outbuf;
+    }
+
+    if (exp >= FRAC_SIZE)
+        int_part  = mantissa << (exp - FRAC_SIZE);
+    else if (exp >= 0) {
+        int_part  = mantissa >> (FRAC_SIZE - exp);
+        frac_part = (mantissa << (exp + 1)) & FRAC_MASK2;
+    }
+    else /* if (exp < 0) */
+        frac_part = (mantissa & FRAC_MASK2) >> -(exp + 1);
+
+    if (int_part == 0) {
+        if (sign == -1)
+            *p++ = '-';
+        *p++ = '0';
+    } else {
+        int ret;
+        while (int_part != 0) {
+            int_part2 = int_part / 10;
+            *p++ = (char)(int_part - ((int_part2 << 3) + (int_part2 << 1)) + '0');
+            int_part = int_part2;
+        }
+        if (sign == -1)
+            *p++ = '-';
+        /* Reverse string */
+        ret = p - outbuf;
+        for (i = 0, n = ret/2; i < n; i++) {
+            int j = ret - i - 1;
+            c = outbuf[i];
+            outbuf[i] = outbuf[j];
+            outbuf[j] = c;
+        }
+    }
+    if (decimals != 0)
+        *p++ = '.';
+
+    max = maxlen - (p - outbuf) - 1 /* leave room for trailing '\0' */;
+    if (max > decimals)
+        max = decimals;
+    for (m = 0; m < max; m++) {
+        /* frac_part *= 10; */
+        frac_part = (frac_part << 3) + (frac_part << 1);
+
+        *p++ = (char)((frac_part >> (FRAC_SIZE + 1)) + '0');
+        frac_part &= FRAC_MASK2;
+    }
+
+    roundup = 0;
+    /* Rounding - look at the next digit */
+    frac_part = (frac_part << 3) + (frac_part << 1);
+    digit = (frac_part >> (FRAC_SIZE + 1));
+    if (digit > 5)
+        roundup = 1;
+    else if (digit == 5) {
+        frac_part &= FRAC_MASK2;
+        if (frac_part != 0) roundup = 1;
+    }
+    if (roundup) {
+        char d;
+        int pos = p - outbuf - 1;
+        do {
+            d = outbuf[pos];
+            if (d == '-') break;
+            if (d == '.') continue;
+            if (++d != ':') {
+                outbuf[pos] = d;
+                break;
+            }
+            outbuf[pos] = '0';
+        } while (--pos);
+    }
+
+    /* Delete trailing zeroes */
+    if (compact && *(p - 1) == '0')
+        p = float_first_trailing_zero(--p);
+    *p = '\0';
+    return p - outbuf;
+}
diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c
index 3fcb4d88dc..6875c17a75 100644
--- a/erts/emulator/sys/unix/sys_float.c
+++ b/erts/emulator/sys/unix/sys_float.c
@@ -735,7 +735,7 @@ void erts_sys_unblock_fpe(int unmasked)
 
 /* 
  ** Convert a double to ascii format 0.dddde[+|-]ddd
- ** return number of characters converted
+ ** return number of characters converted or -1 if error.
  **
  ** These two functions should maybe use localeconv() to pick up
  ** the current radix character, but since it is uncertain how
@@ -745,11 +745,12 @@ void erts_sys_unblock_fpe(int unmasked)
  */
 
 int
-sys_double_to_chars(double fp, char *buffer, size_t buffer_size)
+sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t decimals)
 {
     char *s = buffer;
-    
-    (void) erts_snprintf(buffer, buffer_size, "%.20e", fp);
+
+    if (erts_snprintf(buffer, buffer_size, "%.*e", decimals, fp) >= buffer_size)
+        return -1;
     /* Search upto decimal point */
     if (*s == '+' || *s == '-') s++;
     while (ISDIGIT(*s)) s++;
diff --git a/erts/emulator/sys/win32/sys_float.c b/erts/emulator/sys/win32/sys_float.c
index 09dad89140..960edaa7a5 100644
--- a/erts/emulator/sys/win32/sys_float.c
+++ b/erts/emulator/sys/win32/sys_float.c
@@ -114,15 +114,16 @@ sys_chars_to_double(char *buf, double *fp)
 
 /* 
 ** Convert a double to ascii format 0.dddde[+|-]ddd
-** return number of characters converted
+** return number of characters converted or -1 if error.
 */
 
 int
-sys_double_to_chars(double fp, char *buffer, size_t buffer_size)
+sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t decimals)
 {
     char *s = buffer;
-    
-    (void) erts_snprintf(buffer, buffer_size, "%.20e", fp);
+
+    if (erts_snprintf(buffer, buffer_size, "%.*e", decimals, fp) >= buffer_size)
+        return -1;
     /* Search upto decimal point */
     if (*s == '+' || *s == '-') s++;
     while (isdigit(*s)) s++;
diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl
index 4459732257..7a045484cf 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -25,6 +25,7 @@
 %% 	abs/1
 %%	float/1
 %%	float_to_list/1
+%%  float_to_list/2
 %%	integer_to_list/1
 %%	list_to_float/1
 %%	list_to_integer/1
@@ -114,14 +115,46 @@ t_float(Config) when is_list(Config) ->
     ok.
 
 
-%% Tests float_to_list/1.
+%% Tests float_to_list/1, float_to_list/2.
 
 t_float_to_list(Config) when is_list(Config) ->
-    ?line test_ftl("0.0e+0", 0.0),
-    ?line test_ftl("2.5e+1", 25.0),
-    ?line test_ftl("2.5e+0", 2.5),
-    ?line test_ftl("2.5e-1", 0.25),
-    ?line test_ftl("-3.5e+17", -350.0e15),
+    test_ftl("0.0e+0", 0.0),
+    test_ftl("2.5e+1", 25.0),
+    test_ftl("2.5e+0", 2.5),
+    test_ftl("2.5e-1", 0.25),
+    test_ftl("-3.5e+17", -350.0e15),
+    "1.00000000000000000000e+00"  = float_to_list(1.0),
+    "1.00000000000000000000e+00"  = float_to_list(1.0,  []),
+    "-1.00000000000000000000e+00" = float_to_list(-1.0, []),
+    "-1.00000000000000000000"     = float_to_list(-1.0, [{decimals, 20}]),
+    {'EXIT', {badarg, _}}         = (catch float_to_list(1.0,  [{decimals, -1}])),
+    {'EXIT', {badarg, _}}         = (catch float_to_list(1.0,  [{decimals, 250}])),
+    {'EXIT', {badarg, _}}         = (catch float_to_list(1.0e+300, [{decimals, 1}])),
+    "1.0e+300"                    = float_to_list(1.0e+300, [{scientific, 1}]),
+    "1.0"                         = float_to_list(1.0,  [{decimals,   249}, compact]),
+    Expected = "1." ++ string:copies("0", 249) ++ "e+00",
+    Expected = float_to_list(1.0,  [{scientific, 249}, compact]),
+
+    X1 = float_to_list(1.0),
+    X2 = float_to_list(1.0, [{scientific, 20}]),
+    X1 = X2,
+    "1.000e+00" = float_to_list(1.0,   [{scientific, 3}]),
+    "1.000"     = float_to_list(1.0,   [{decimals,   3}]),
+    "1.0"       = float_to_list(1.0,   [{decimals, 3}, compact]),
+    "1.12"      = float_to_list(1.123, [{decimals, 2}]),
+    "1.123"     = float_to_list(1.123, [{decimals, 3}]),
+    "1.123"     = float_to_list(1.123, [{decimals, 3}, compact]),
+    "1.1230"    = float_to_list(1.123, [{decimals, 4}]),
+    "1.12300"   = float_to_list(1.123, [{decimals, 5}]),
+    "1.123"     = float_to_list(1.123, [{decimals, 5}, compact]),
+    "1.1234"    = float_to_list(1.1234,[{decimals, 6}, compact]),
+    "2.333333"  = erlang:float_to_list(7/3, [{decimals, 6}, compact]),
+    "2.333333"  = erlang:float_to_list(7/3, [{decimals, 6}]),
+    "0.00000000000000000000e+00" = float_to_list(0.0, [compact]),
+    "0.0"       = float_to_list(0.0,   [{decimals, 10}, compact]),
+    "123000000000000000000.0"    = float_to_list(1.23e20, [{decimals,   10}, compact]),
+    "1.2300000000e+20"           = float_to_list(1.23e20, [{scientific, 10}, compact]),
+    "1.23000000000000000000e+20" = float_to_list(1.23e20, []),
     ok.
     
 test_ftl(Expect, Float) ->
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index e966ac5296..50546b1856 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -84,7 +84,8 @@
 -export([display_nl/0, display_string/1, dist_exit/3, erase/0, erase/1]).
 -export([error/1, error/2, exit/1, exit/2, external_size/1]).
 -export([external_size/2, finish_after_on_load/2, finish_loading/1, float/1]).
--export([float_to_list/1, fun_info/2, fun_to_list/1, function_exported/3]).
+-export([float_to_list/1, float_to_list/2]).
+-export([fun_info/2, fun_to_list/1, function_exported/3]).
 -export([garbage_collect/0, garbage_collect/1]).
 -export([garbage_collect_message_area/0, get/0, get/1, get_keys/1]).
 -export([get_module_info/1, get_stacktrace/0, group_leader/0]).
@@ -711,6 +712,16 @@ float(_Number) ->
 float_to_list(_Float) ->
     erlang:nif_error(undefined).
 
+%% float_to_list/2
+-spec float_to_list(Float, Options) -> string() when
+      Float :: float(),
+      Options :: [Option],
+      Option  :: {decimals, non_neg_integer()} |
+                 {scientific, non_neg_integer()} |
+                 compact.
+float_to_list(_Float, _Options) ->
+    erlang:nif_error(undefined).
+
 %% fun_info/2
 -spec erlang:fun_info(Fun, Item) -> {Item, Info} when
       Fun :: function(),
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index 3063881890..bf2fffbd97 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -278,6 +278,7 @@ bif(exit, 1) -> true;
 bif(exit, 2) -> true;
 bif(float, 1) -> true;
 bif(float_to_list, 1) -> true;
+bif(float_to_list, 2) -> true;
 bif(garbage_collect, 0) -> true;
 bif(garbage_collect, 1) -> true;
 bif(get, 0) -> true;