[m-rev.] diff: fix output precision of deconstruct
Peter Ross
pro at missioncriticalit.com
Sat Nov 30 00:25:12 AEDT 2002
Hi,
This is one of many changes which fix problems with outputting floats.
None of these changes are on the release branch, do we want to add all
the changes to the release branch as well?
===================================================================
Estimated hours taken: 1
Branches: main
Fix a bug where we weren't outputting floats to enough precision when
deconstructing them.
runtime/mercury_ml_expand_body.h:
Use MR_sprintf_float to determine the representation of the
deconstructed float.
library/string.m:
library/io.m:
runtime/mercury_float.c:
runtime/mercury_float.h:
Move ML_sprintf_float to mercury_float.h.
tests/hard_coded/deconstruct_arg.exp:
tests/hard_coded/deconstruct_arg.exp2:
tests/hard_coded/deconstruct_arg.m:
Adapt the test case to test floats which require 17 digits of
precision.
Index: il/library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.278
diff -u -r1.278 io.m
--- il/library/io.m 28 Nov 2002 11:21:42 -0000 1.278
+++ il/library/io.m 29 Nov 2002 13:16:31 -0000
@@ -4410,8 +4410,8 @@
io__write_float(Val::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- char buf[ML_SPRINTF_FLOAT_BUF_SIZE];
- ML_sprintf_float(buf, Val);
+ char buf[MR_SPRINTF_FLOAT_BUF_SIZE];
+ MR_sprintf_float(buf, Val);
if (ML_fprintf(mercury_current_text_output, ""%s"", buf) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -4677,8 +4677,8 @@
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
- char buf[ML_SPRINTF_FLOAT_BUF_SIZE];
- ML_sprintf_float(buf, Val);
+ char buf[MR_SPRINTF_FLOAT_BUF_SIZE];
+ MR_sprintf_float(buf, Val);
if (ML_fprintf(stream, ""%s"", buf) < 0) {
mercury_output_error(stream);
}
Index: il/library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.189
diff -u -r1.189 string.m
--- il/library/string.m 27 Nov 2002 08:45:03 -0000 1.189
+++ il/library/string.m 29 Nov 2002 13:16:33 -0000
@@ -2771,9 +2771,7 @@
** For efficiency reasons we duplicate the C implementation
** of string__lowlevel_float_to_string
*/
- char buf[ML_SPRINTF_FLOAT_BUF_SIZE];
- ML_sprintf_float(buf, Flt);
- MR_make_aligned_string_copy(Str, buf);
+ MR_float_to_string(Flt, Str);
}").
% XXX The unsafe_promise_unique is needed because in
@@ -2833,9 +2831,7 @@
** Note any changes here will require the same changes in
** string__float_to_string.
*/
- char buf[ML_SPRINTF_FLOAT_BUF_SIZE];
- ML_sprintf_float(buf, Flt);
- MR_make_aligned_string_copy(Str, buf);
+ MR_float_to_string(Flt, Str);
}").
:- pragma foreign_proc("C#",
@@ -2855,67 +2851,6 @@
% matching foreign_proc version.
private_builtin__sorry("string__lowlevel_float_to_string").
-:- pragma foreign_decl(c, "
-#ifdef MR_USE_SINGLE_PREC_FLOAT
- #define ML_MIN_PRECISION 7
- #define ML_FMT ""%f""
-#else
- #define ML_MIN_PRECISION 15
- #define ML_FMT ""%lf""
-#endif
-#define ML_MAX_PRECISION (ML_MIN_PRECISION + 2)
-
-/*
-** The size of the buffer to pass to ML_sprintf_float.
-**
-** Longest possible string for %#.*g format is `-n.nnnnnnE-mmmm', which
-** has size PRECISION + MAX_EXPONENT_DIGITS + 5 (for the `-', `.', `E',
-** '-', and '\\0'). PRECISION is at most 20, and MAX_EXPONENT_DIGITS is
-** at most 5, so we need at most 30 chars. 80 is way more than enough.
-*/
-#define ML_SPRINTF_FLOAT_BUF_SIZE 80
-
-void ML_sprintf_float(char *buf, MR_Float f);
-").
-
-:- pragma foreign_code(c, "
-/*
-** ML_sprintf_float(buf, f)
-**
-** fills buff with the string representation of the float, f, such that
-** the string representation has enough precision to represent the
-** float, f.
-**
-** Note that buf must have size at least ML_SPRINTF_FLOAT_BUF_SIZE.
-*/
-void
-ML_sprintf_float(char *buf, MR_Float f)
-{
- MR_Float round = 0.0;
- int i = ML_MIN_PRECISION;
-
- /*
- ** Print the float at increasing precisions until the float
- ** is round-trippable.
- */
- do {
- sprintf(buf, ""%#.*g"", i, f);
- if (i >= ML_MAX_PRECISION) {
- /*
- ** This should be sufficient precision to
- ** round-trip any value. Don't bother checking
- ** whether it can actually be round-tripped,
- ** since if it can't, this is a bug in the C
- ** implementation.
- */
- break;
- }
- sscanf(buf, ML_FMT, &round);
- i++;
- } while (round != f);
-}
-").
-
:- pragma export(string__to_float(in, out), "ML_string_to_float").
:- pragma foreign_proc("C",
string__to_float(FloatString::in, FloatVal::out),
@@ -2928,7 +2863,7 @@
char tmpc;
SUCCESS_INDICATOR =
(!MR_isspace(FloatString[0])) &&
- (sscanf(FloatString, ML_FMT ""%c"", &FloatVal, &tmpc) == 1);
+ (sscanf(FloatString, MR_FLT_FMT ""%c"", &FloatVal, &tmpc) == 1);
/* MR_TRUE if sscanf succeeds, MR_FALSE otherwise */
}").
Index: il/runtime/mercury_float.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_float.c,v
retrieving revision 1.5
diff -u -r1.5 mercury_float.c
--- il/runtime/mercury_float.c 23 Nov 2000 02:00:28 -0000 1.5
+++ il/runtime/mercury_float.c 29 Nov 2002 13:16:33 -0000
@@ -46,3 +46,41 @@
}
}
+
+/*
+** MR_sprintf_float(buf, f)
+**
+** fills buff with the string representation of the float, f, such that
+** the string representation has enough precision to represent the
+** float, f.
+**
+** Note that buf must have size at least ML_SPRINTF_FLOAT_BUF_SIZE.
+*/
+void
+MR_sprintf_float(char *buf, MR_Float f)
+{
+ MR_Float round = 0.0;
+ int i = MR_FLT_MIN_PRECISION;
+
+ /*
+ ** Print the float at increasing precisions until the float
+ ** is round-trippable.
+ */
+ do {
+ sprintf(buf, "%#.*g", i, f);
+ if (i >= MR_FLT_MAX_PRECISION) {
+ /*
+ ** This should be sufficient precision to
+ ** round-trip any value. Don't bother checking
+ ** whether it can actually be round-tripped,
+ ** since if it can't, this is a bug in the C
+ ** implementation.
+ */
+ break;
+ }
+ sscanf(buf, MR_FLT_FMT, &round);
+ i++;
+ } while (round != f);
+
+ return;
+}
Index: il/runtime/mercury_float.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_float.h,v
retrieving revision 1.15
diff -u -r1.15 mercury_float.h
--- il/runtime/mercury_float.h 26 Aug 2002 04:06:37 -0000 1.15
+++ il/runtime/mercury_float.h 29 Nov 2002 13:16:33 -0000
@@ -14,15 +14,20 @@
#ifdef MR_USE_SINGLE_PREC_FLOAT
typedef float MR_Float;
+ #define MR_FLT_MIN_PRECISION 7
+ #define MR_FLT_FMT "%f"
#else
typedef double MR_Float;
+ #define MR_FLT_MIN_PRECISION 15
+ #define MR_FLT_FMT "%lf"
#endif
+#define MR_FLT_MAX_PRECISION (MR_FLT_MIN_PRECISION + 2)
#ifdef MR_BOXED_FLOAT
-#define MR_word_to_float(w) (* (MR_Float *) (w))
+#define MR_word_to_float(w) (* (MR_Float *) (w))
-#define MR_FLOAT_WORDS ((sizeof(MR_Float) + sizeof(MR_Word) - 1) \
+#define MR_FLOAT_WORDS ((sizeof(MR_Float) + sizeof(MR_Word) - 1) \
/ sizeof(MR_Word))
#ifdef MR_CONSERVATIVE_GC
@@ -89,6 +94,25 @@
#endif /* not __GNUC__ */
#endif /* not MR_BOXED_FLOAT */
+
+/*
+** The size of the buffer to pass to MR_sprintf_float.
+**
+** Longest possible string for %#.*g format is `-n.nnnnnnE-mmmm', which
+** has size PRECISION + MAX_EXPONENT_DIGITS + 5 (for the `-', `.', `E',
+** '-', and '\\0'). PRECISION is at most 20, and MAX_EXPONENT_DIGITS is
+** at most 5, so we need at most 30 chars. 80 is way more than enough.
+*/
+#define MR_SPRINTF_FLOAT_BUF_SIZE 80
+
+#define MR_float_to_string(Float, String) \
+ do { \
+ char buf[MR_SPRINTF_FLOAT_BUF_SIZE]; \
+ MR_sprintf_float(buf, Float); \
+ MR_make_aligned_string_copy(Str, buf); \
+ } while (0)
+
+void MR_sprintf_float(char *buf, MR_Float f);
MR_Integer MR_hash_float(MR_Float);
Index: il/runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.22
diff -u -r1.22 mercury_ml_expand_body.h
--- il/runtime/mercury_ml_expand_body.h 1 Aug 2002 11:52:27 -0000 1.22
+++ il/runtime/mercury_ml_expand_body.h 29 Nov 2002 13:16:36 -0000
@@ -676,13 +676,13 @@
#ifdef EXPAND_FUNCTOR_FIELD
{
MR_Word data_word;
- char buf[500];
+ char buf[MR_SPRINTF_FLOAT_BUF_SIZE];
MR_Float f;
char *str;
data_word = *data_word_ptr;
f = MR_word_to_float(data_word);
- sprintf(buf, "%#.15g", f);
+ MR_sprintf_float(buf, f);
MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
(strlen(buf) + sizeof(MR_Word)) / sizeof(MR_Word));
strcpy(str, buf);
Index: tests/hard_coded/deconstruct_arg.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/deconstruct_arg.exp,v
retrieving revision 1.3
diff -u -r1.3 deconstruct_arg.exp
--- tests/hard_coded/deconstruct_arg.exp 24 Feb 2002 11:53:41 -0000 1.3
+++ tests/hard_coded/deconstruct_arg.exp 29 Nov 2002 13:16:37 -0000
@@ -134,22 +134,22 @@
deconstruct limited deconstruct 3 of a
functor 'a' arity 0 []
-std_util functor: 3.14159000000000/0
-deconstruct functor: 3.14159000000000/0
-std_util argument 0 of 3.14159000000000 doesn't exist
-deconstruct argument 0 of 3.14159000000000 doesn't exist
-std_util argument 1 of 3.14159000000000 doesn't exist
-deconstruct argument 1 of 3.14159000000000 doesn't exist
-std_util argument 2 of 3.14159000000000 doesn't exist
-deconstruct argument 2 of 3.14159000000000 doesn't exist
-std_util deconstruct: functor 3.14159000000000 arity 0
+std_util functor: 0.12345678901234566/0
+deconstruct functor: 0.12345678901234566/0
+std_util argument 0 of 0.12345678901234566 doesn't exist
+deconstruct argument 0 of 0.12345678901234566 doesn't exist
+std_util argument 1 of 0.12345678901234566 doesn't exist
+deconstruct argument 1 of 0.12345678901234566 doesn't exist
+std_util argument 2 of 0.12345678901234566 doesn't exist
+deconstruct argument 2 of 0.12345678901234566 doesn't exist
+std_util deconstruct: functor 0.12345678901234566 arity 0
[]
-deconstruct deconstruct: functor 3.14159000000000 arity 0
+deconstruct deconstruct: functor 0.12345678901234566 arity 0
[]
-std_util limited deconstruct 3 of 3.14159000000000
-functor 3.14159000000000 arity 0 []
-deconstruct limited deconstruct 3 of 3.14159000000000
-functor 3.14159000000000 arity 0 []
+std_util limited deconstruct 3 of 0.12345678901234566
+functor 0.12345678901234566 arity 0 []
+deconstruct limited deconstruct 3 of 0.12345678901234566
+functor 0.12345678901234566 arity 0 []
std_util functor: 4/0
deconstruct functor: 4/0
Index: tests/hard_coded/deconstruct_arg.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/deconstruct_arg.exp2,v
retrieving revision 1.1
diff -u -r1.1 deconstruct_arg.exp2
--- tests/hard_coded/deconstruct_arg.exp2 26 Feb 2002 02:36:49 -0000 1.1
+++ tests/hard_coded/deconstruct_arg.exp2 29 Nov 2002 13:16:37 -0000
@@ -134,22 +134,22 @@
deconstruct limited deconstruct 3 of a
functor 'a' arity 0 []
-std_util functor: 3.14159000000000/0
-deconstruct functor: 3.14159000000000/0
-std_util argument 0 of 3.14159000000000 doesn't exist
-deconstruct argument 0 of 3.14159000000000 doesn't exist
-std_util argument 1 of 3.14159000000000 doesn't exist
-deconstruct argument 1 of 3.14159000000000 doesn't exist
-std_util argument 2 of 3.14159000000000 doesn't exist
-deconstruct argument 2 of 3.14159000000000 doesn't exist
-std_util deconstruct: functor 3.14159000000000 arity 0
+std_util functor: 0.12345678901234566/0
+deconstruct functor: 0.12345678901234566/0
+std_util argument 0 of 0.12345678901234566 doesn't exist
+deconstruct argument 0 of 0.12345678901234566 doesn't exist
+std_util argument 1 of 0.12345678901234566 doesn't exist
+deconstruct argument 1 of 0.12345678901234566 doesn't exist
+std_util argument 2 of 0.12345678901234566 doesn't exist
+deconstruct argument 2 of 0.12345678901234566 doesn't exist
+std_util deconstruct: functor 0.12345678901234566 arity 0
[]
-deconstruct deconstruct: functor 3.14159000000000 arity 0
+deconstruct deconstruct: functor 0.12345678901234566 arity 0
[]
-std_util limited deconstruct 3 of 3.14159000000000
-functor 3.14159000000000 arity 0 []
-deconstruct limited deconstruct 3 of 3.14159000000000
-functor 3.14159000000000 arity 0 []
+std_util limited deconstruct 3 of 0.12345678901234566
+functor 0.12345678901234566 arity 0 []
+deconstruct limited deconstruct 3 of 0.12345678901234566
+functor 0.12345678901234566 arity 0 []
std_util functor: 4/0
deconstruct functor: 4/0
Index: tests/hard_coded/deconstruct_arg.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/deconstruct_arg.m,v
retrieving revision 1.3
diff -u -r1.3 deconstruct_arg.m
--- tests/hard_coded/deconstruct_arg.m 24 Feb 2002 11:53:41 -0000 1.3
+++ tests/hard_coded/deconstruct_arg.m 29 Nov 2002 13:16:37 -0000
@@ -71,8 +71,8 @@
test_all(qwerty(5)), newline,
% test characters
test_all('a'), newline,
- % test floats
- test_all(3.14159), newline,
+ % test a float which requires 17 digits of precision
+ test_all(0.12345678901234566), newline,
% test integers
test_all(4), newline,
% test univ.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list