[m-rev.] for review: fix float_to_string so that roundtripping works

[Peter Ross]

On Thu, Nov 21, 2002 at 02:26:50AM +1100, Fergus Henderson wrote:
> On 20-Nov-2002, Peter Ross <pro at missioncriticalit.com> wrote:
> > Estimated hours taken: 8
> > Branches: main
> > 
> > Fix the I/O routines for floats so that can roundtrip.
> > 
> > library/string.m:
> >     Ensure that string__float_to_string returns a float that is
> >     round-trippable.  On the C backend we do that by starting at the min
> >     precision required and increasing it until the float roundtrips.  On
> >     the IL backend the R flag guarantees that a double will be
> >     round-trippable, so we just use that.
> >     Change string__to_float so that it uses the format string for the
> >     precision float that we are using, and export this predicate for use
> >     by the trace system.
> >     Delete the unused string__float_to_f_string.
> > 
> > library/io.m:
> >     Call string__float_to_string to determine the float to output so
> >     that the float output is round-trippable.
> 
> This change will decrease efficiency of writing out floats, unfortunately,
> for two reasons:
> 
> 	(1) rather than just formatting the float once,
> 	    we format the float,
> 	    then scan it back in again,
> 	    then check if the two are equal,
> 	    and in some cases we may have to repeat the whole process
> 	    two or three times.
> 	    
> 	(2) io__write_float allocates space on the Mercury heap
> 	    and does not reclaim it
> 
> (1) is acceptable, since it seems to be the minimum necessary to fix the bug.
> But I'd rather avoid (2).
> 
> For formatting floats with "%.*g" format, a dynamically sized
> heap-allocated buffer is overkill, since the size needed is
> bounded by the precision plus a small constant; a fixed-size,
> stack-allocated buffer should be sufficient.
> 
I have to go to my french lesson now, so I will send you the interdiff
that is bootchecking now.

All I have identified is that I need to add a comment to
ML_sprintf_float to describe what it does.

diff -u library/io.m library/io.m
--- library/io.m	20 Nov 2002 10:43:29 -0000
+++ library/io.m	20 Nov 2002 16:25:52 -0000
@@ -4405,6 +4405,18 @@
 ").
 
 :- pragma foreign_proc("C",
+	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);
+	if (ML_fprintf(mercury_current_text_output, ""%s"", buf) < 0) {
+		mercury_output_error(mercury_current_text_output);
+	}
+	MR_update_io(IO0, IO);
+").
+
+:- pragma foreign_proc("C",
 	io__write_byte(Byte::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
@@ -4659,6 +4671,19 @@
 }").
 
 :- pragma foreign_proc("C",
+	io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
+		[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);
+	if (ML_fprintf(stream, ""%s"", buf) < 0) {
+		mercury_output_error(stream);
+	}
+	MR_update_io(IO0, IO);
+}").
+
+:- pragma foreign_proc("C",
 	io__write_byte(Stream::in, Byte::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "{
diff -u library/string.m library/string.m
--- library/string.m	20 Nov 2002 13:46:46 -0000
+++ library/string.m	20 Nov 2002 16:42:19 -0000
@@ -1826,45 +1826,21 @@
 :- pragma foreign_proc("C",
 	string__float_to_string(Flt::in, Str::uo),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
-#ifdef MR_USE_SINGLE_PREC_FLOAT
-	#define MIN_PRECISION	7
-	const char *format = ""%f"";
-#else
-	#define MIN_PRECISION	15
-	const char *format = ""%lf"";
-#endif
-	int i = MIN_PRECISION;
-	MR_Float round;
-
-		/*
-		 * Round-trip the float to ensure the precision was 
-		 * sufficient, and if not then try with the next precision.
-		*/
-	Str = MR_make_string(MR_PROC_LABEL, ""%#.*g"", i, Flt);
-	sscanf(Str, format, &round);
-
-	while (round != Flt) {
-		i++;
-		Str = MR_make_string(MR_PROC_LABEL, ""#%.*g"", i, Flt);
-		sscanf(Str, format, &round);
-	}
+	char buf[ML_SPRINTF_FLOAT_BUF_SIZE];
+	ML_sprintf_float(buf, Flt);
+	MR_make_aligned_string(Str, buf);
 }").
 
-:- pragma foreign_proc("il",
+:- pragma foreign_proc("C#",
 	string__float_to_string(FloatVal::in, FloatString::uo),
-	[will_not_call_mercury, promise_pure, thread_safe, max_stack_size(1)], "
-
-	ldloca	'FloatVal'
-	ldstr	""R""
+	[will_not_call_mercury, promise_pure, thread_safe], "
 
 		// The R format string prints the double out such that it
 		// can be round-tripped.
 		// XXX According to the documentation it tries the 15 digits of
 		// precision, then 17 digits skipping 16 digits of precision.
 		// unlike what we do for the C backend.
-	call instance string [mscorlib]System.Double::ToString(string)
-
-	stloc	'FloatString'
+	FloatString = FloatVal.ToString(""R"");
 ").
 
 string__float_to_string(_, _) :-
@@ -1872,21 +1848,67 @@
 	% matching foreign_proc version.
 	private_builtin__sorry("string__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, "
+void
+ML_sprintf_float(char *buf, MR_Float f)
+{
+	MR_Float round;
+	int 	 i = ML_MIN_PRECISION;
+
+	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),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
-#ifdef MR_USE_SINGLE_PREC_FLOAT
-  #define FMT    """"
-#else
-  #define FMT    ""l""
-#endif
-
+	/*
+	** The %c checks for any erroneous characters appearing after
+	** the float; if there are then sscanf() will return 2 rather
+	** than 1.
+	*/
 	char   	tmpc;
 	SUCCESS_INDICATOR =
 		(!MR_isspace(FloatString[0])) &&
-		(sscanf(FloatString, ""%"" FMT ""f%c"", &FloatVal, &tmpc) == 1);
+		(sscanf(FloatString, ML_FMT ""%c"", &FloatVal, &tmpc) == 1);
 		/* MR_TRUE if sscanf succeeds, MR_FALSE otherwise */
 }").
 
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------