diff: Miscellaneous library fixes
Andrew Bromage
bromage at cs.mu.OZ.AU
Mon Sep 7 09:34:50 AEST 1998
G'day all.
Just thought I'd sneak in these changes under the feature freeze. (Had
them sitting around for quite a while.)
Cheers,
Andrew Bromage
Estimated hours taken: 20
library/io.m:
library/io.nu.nl:
Implement io__read_line_as_string/{3,4}.
Also sneaked in here are some trivial whitespace fixes in some
of the pragma c_code which did not comply to our coding standards
(to do with type casting).
library/math.m:
library/float.m:
Addition of four new system constants (float__radix,
float__mantissa_digits, float__min_exponent and
float__max_exponent) plus predicate equivalents. Also
added in some extra documentation for the other constants.
Rename floating point constants using the C coding standard
way (ML_*).
Put code for mathematical domain checking inside
`#ifndef ML_OMIT_MATH_DOMAIN_CHECKS', so that the user
can disable domain checking. (Note: This is actually safe,
since the combination of floating point hardware and -lm
should do all these checks for you.)
NEWS:
Mention the above changes.
library/queue.m:
Fix a bug in queue__delete where the constraint that the `off'
list is empty if and only if the queue is empty was not being
preserved in all cases.
samples/cat.m:
samples/sort.m:
Use io__read_line_as_string.
tests/general/Mmakefile:
tests/general/read_line_as_string.exp:
tests/general/read_line_as_string.m:
Test case for io__read_line_as_string.
Index: NEWS
===================================================================
RCS file: /home/staff/zs/imp/mercury/NEWS,v
retrieving revision 1.116
diff -u -t -u -r1.116 NEWS
--- NEWS 1998/09/04 06:26:40 1.116
+++ NEWS 1998/09/04 07:11:00
@@ -325,8 +325,12 @@
bag__least_upper_bound/3, bag__remove_list/3, bag__det_remove_list/3,
det_univ_to_type/2, list__take_upto/3, set__count/2, set_ordlist__count/2,
store__new_cyclic_mutvar/4, relation__add_values/4,
- relation__from_assoc_list/2, relation__compose/3, varset__select/3
- and eqvclass__same_eqvclass_list/2.
+ relation__from_assoc_list/2, relation__compose/3, varset__select/3,
+ eqvclass__same_eqvclass_list/2 and io__read_line_as_string/{3,4}.
+
+ In addition, there are four new system constants added to the float
+ library module, float__radix, float__mantissa_digits, float__min_exponent
+ and float__max_exponent. There are also predicate equivalents for these.
Also the old relation__to_assoc_list/2 predicate has been renamed as
relation__to_key_assoc_list/2; there is a new relation__to_assoc_list/2
Index: samples/cat.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/samples/cat.m,v
retrieving revision 1.2
diff -u -t -u -r1.2 cat.m
--- cat.m 1997/09/10 11:00:15 1.2
+++ cat.m 1998/02/11 03:31:38
@@ -60,16 +60,15 @@
:- pred cat(io__state::di, io__state::uo) is det.
cat -->
- io__read_line(Result),
+ io__read_line_as_string(Result),
cat_2(Result).
-:- pred cat_2(io__result(list(char))::in, io__state::di, io__state::uo) is det.
+:- pred cat_2(io__result(string)::in, io__state::di, io__state::uo) is det.
cat_2(Result) -->
- ( { Result = ok(CharList) },
- { string__from_char_list(CharList, String) },
- io__write_string(String),
- io__read_line(NextResult),
+ ( { Result = ok(Line) },
+ io__write_string(Line),
+ io__read_line_as_string(NextResult),
cat_2(NextResult)
; { Result = eof }
; { Result = error(Error) },
Index: samples/sort.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/samples/sort.m,v
retrieving revision 1.2
diff -u -t -u -r1.2 sort.m
--- sort.m 1997/09/10 11:00:19 1.2
+++ sort.m 1998/02/11 05:54:37
@@ -79,11 +79,11 @@
sort -->
sort_2([]).
-:- pred sort_2(list(list(char)), io__state, io__state).
+:- pred sort_2(list(string), io__state, io__state).
:- mode sort_2(in, di, uo) is det.
sort_2(Lines0) -->
- io__read_line(Result),
+ io__read_line_as_string(Result),
(
{ Result = error(Error) },
{ io__error_message(Error, Msg) },
@@ -110,11 +110,10 @@
L = [H | NT]
).
-:- pred sort_output(list(list(char)), io__state, io__state).
+:- pred sort_output(list(string), io__state, io__state).
:- mode sort_output(in, di, uo) is det.
sort_output([]) --> [].
sort_output([Line | Lines]) -->
- { string__from_char_list(Line, LineStr) },
- io__write_string(LineStr),
+ io__write_string(Line),
sort_output(Lines).
Index: library/float.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/float.m,v
retrieving revision 1.27
diff -u -t -u -r1.27 float.m
--- float.m 1998/07/26 14:41:58 1.27
+++ float.m 1998/07/28 03:27:01
@@ -151,14 +151,48 @@
%
% Maximum floating-point number
+ %
+ % max = (1 - radix ** mantissa_digits) * radix ** max_exponent
+ %
:- func float__max = float.
% Minimum normalised floating-point number
+ %
+ % min = radix ** (min_exponent - 1)
+ %
:- func float__min = float.
% Smallest number x such that 1.0 + x \= 1.0
+ % This represents the largest relative spacing of two
+ % consecutive floating point numbers.
+ %
+ % epsilon = radix ** (1 - mantissa_digits)
:- func float__epsilon = float.
+ % Radix of the floating-point representation.
+ % In the literature, this is sometimes referred to as `b'.
+ %
+:- func float__radix = int.
+
+ % The number of base-radix digits in the mantissa. In the
+ % literature, this is sometimes referred to as `p' or `t'.
+ %
+:- func float__mantissa_digits = int.
+
+ % Minimum negative integer such that:
+ % radix ** (min_exponent - 1)
+ % is a normalised floating-point number. In the literature,
+ % this is sometimes referred to as `e_min'.)
+ %
+:- func float__min_exponent = int.
+
+ % Maximum integer such that:
+ % radix ** (max_exponent - 1)
+ % is a normalised floating-point number. In the literature,
+ % this is sometimes referred to as `e_max'.)
+ %
+:- func float__max_exponent = int.
+
%---------------------------------------------------------------------------%
% Predicate versions of the functions declared above.
@@ -237,6 +271,22 @@
:- pred float__epsilon(float).
:- mode float__epsilon(out) is det.
+ % Radix of the floating-point representation.
+:- pred float__radix(int).
+:- mode float__radix(out) is det.
+
+ % The number of base-radix digits in the mantissa.
+:- pred float__mantissa_digits(int).
+:- mode float__mantissa_digits(out) is det.
+
+ % Smallest exponent of a normalised floating-point number.
+:- pred float__min_exponent(int).
+:- mode float__min_exponent(out) is det.
+
+ % Largest exponent of a normalised floating-point number.
+:- pred float__max_exponent(int).
+:- mode float__max_exponent(out) is det.
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -433,35 +483,71 @@
:- pragma c_header_code("
+ #define ML_FLOAT_RADIX FLT_RADIX /* There is no DBL_RADIX. */
+
#if defined USE_SINGLE_PREC_FLOAT
- #define MERCURY_FLOAT_MAX FLT_MAX
- #define MERCURY_FLOAT_MIN FLT_MIN
- #define MERCURY_FLOAT_EPSILON FLT_EPSILON
+ #define ML_FLOAT_MAX FLT_MAX
+ #define ML_FLOAT_MIN FLT_MIN
+ #define ML_FLOAT_EPSILON FLT_EPSILON
+ #define ML_FLOAT_MANT_DIG FLT_MANT_DIG
+ #define ML_FLOAT_MIN_EXP FLT_MIN_EXP
+ #define ML_FLOAT_MAX_EXP FLT_MAX_EXP
#else
- #define MERCURY_FLOAT_MAX DBL_MAX
- #define MERCURY_FLOAT_MIN DBL_MIN
- #define MERCURY_FLOAT_EPSILON DBL_EPSILON
+ #define ML_FLOAT_MAX DBL_MAX
+ #define ML_FLOAT_MIN DBL_MIN
+ #define ML_FLOAT_EPSILON DBL_EPSILON
+ #define ML_FLOAT_MANT_DIG DBL_MANT_DIG
+ #define ML_FLOAT_MIN_EXP DBL_MIN_EXP
+ #define ML_FLOAT_MAX_EXP DBL_MAX_EXP
#endif
").
% Maximum floating-point number
:- pragma c_code(float__max(Max::out), will_not_call_mercury,
- "Max = MERCURY_FLOAT_MAX;").
+ "Max = ML_FLOAT_MAX;").
float__max = Max :- float__max(Max).
% Minimum normalised floating-point number */
:- pragma c_code(float__min(Min::out), will_not_call_mercury,
- "Min = MERCURY_FLOAT_MIN;").
+ "Min = ML_FLOAT_MIN;").
float__min = Min :- float__min(Min).
% Smallest x such that x \= 1.0 + x
:- pragma c_code(float__epsilon(Eps::out), will_not_call_mercury,
- "Eps = MERCURY_FLOAT_EPSILON;").
+ "Eps = ML_FLOAT_EPSILON;").
float__epsilon = Epsilon :- float__epsilon(Epsilon).
+
+ % Radix of the floating-point representation.
+:- pragma c_code(float__radix(Radix::out), will_not_call_mercury,
+ "Radix = ML_FLOAT_RADIX;").
+
+float__radix = Radix :- float__radix(Radix).
+
+ % The number of base-radix digits in the mantissa.
+:- pragma c_code(float__mantissa_digits(MantDig::out), will_not_call_mercury,
+ "MantDig = ML_FLOAT_MANT_DIG;").
+
+float__mantissa_digits = MantissaDig :- float__mantissa_digits(MantissaDig).
+
+ % Minimum negative integer such that:
+ % radix ** (min_exponent - 1)
+ % is a normalised floating-point number.
+:- pragma c_code(float__min_exponent(MinExp::out), will_not_call_mercury,
+ "MinExp = ML_FLOAT_MIN_EXP;").
+
+float__min_exponent = MinExponent :- float__min_exponent(MinExponent).
+
+ % Maximum integer such that:
+ % radix ** (max_exponent - 1)
+ % is a normalised floating-point number.
+:- pragma c_code(float__max_exponent(MaxExp::out), will_not_call_mercury,
+ "MaxExp = ML_FLOAT_MIN_EXP;").
+
+float__max_exponent = MaxExponent :- float__max_exponent(MaxExponent).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.162
diff -u -t -u -r1.162 io.m
--- io.m 1998/08/24 04:45:20 1.162
+++ io.m 1998/09/04 07:46:47
@@ -113,7 +113,13 @@
:- pred io__read_line(io__result(list(char)), io__state, io__state).
:- mode io__read_line(out, di, uo) is det.
-% Reads a line from the current input stream.
+% Reads a line from the current input stream, returns the
+% the result as a list of chars.
+
+:- pred io__read_line_as_string(io__result(string), io__state, io__state).
+:- mode io__read_line_as_string(out, di, uo) is det.
+% Reads a line from the current input stream, returns the
+% result as a string.
:- pred io__read_file(io__result(list(char)), io__state, io__state).
:- mode io__read_file(out, di, uo) is det.
@@ -145,7 +151,14 @@
:- pred io__read_line(io__input_stream, io__result(list(char)),
io__state, io__state).
:- mode io__read_line(in, out, di, uo) is det.
-% Reads a line from specified stream.
+% Reads a line from specified stream, returning the result
+% as a list of chars.
+
+:- pred io__read_line_as_string(io__input_stream, io__result(string),
+ io__state, io__state).
+:- mode io__read_line_as_string(in, out, di, uo) is det.
+% Reads a line from specified stream, returning the
+% result as a string.
:- pred io__read_file(io__input_stream, io__result(list(char)),
io__state, io__state).
@@ -1203,32 +1216,126 @@
io__read_line(Stream, Result).
io__read_line(Stream, Result) -->
- io__read_char(Stream, CharResult),
+ io__read_char_code(Stream, Code),
(
- { CharResult = error(Error) },
- { Result = error(Error) }
- ;
- { CharResult = eof },
+ { Code = -1 }
+ ->
{ Result = eof }
;
- { CharResult = ok(Char) },
+ { char__to_int(Char, Code) }
+ ->
( { Char = '\n' } ->
{ Result = ok([Char]) }
;
- io__read_line(Stream, Result0),
- (
- { Result0 = ok(Chars) },
- { Result = ok([Char | Chars]) }
- ;
- { Result0 = error(_) },
- { Result = Result0 }
- ;
- { Result0 = eof },
- { Result = ok([Char]) }
- )
+ io__read_line_2(Stream, Result0),
+ { Result = ok([Char | Result0]) }
)
+ ;
+ % XXX improve error message
+ { Result = error("read error") }
).
+:- pred io__read_line_2(io__input_stream, list(char), io__state, io__state).
+:- mode io__read_line_2(in, out, di, uo) is det.
+
+io__read_line_2(Stream, Result) -->
+ io__read_char_code(Stream, Code),
+ (
+ { Code = -1 }
+ ->
+ { Result = [] }
+ ;
+ { char__to_int(Char, Code) }
+ ->
+ ( { Char = '\n' } ->
+ { Result = [Char] }
+ ;
+ io__read_line_2(Stream, Chars),
+ { Result = [Char | Chars] }
+ )
+ ;
+ { Result = [] }
+ ).
+
+io__read_line_as_string(Result) -->
+ io__input_stream(Stream),
+ io__read_line_as_string(Stream, Result).
+
+io__read_line_as_string(Stream, Result, IO0, IO) :-
+ io__read_line_as_string_2(Stream, Res, String, IO0, IO),
+ ( Res < 0 ->
+ ( Res = -1 ->
+ Result = eof
+ ;
+ % XXX improve error message
+ Result = error("read error")
+ )
+ ;
+ Result = ok(String)
+ ).
+
+:- pred io__read_line_as_string_2(io__input_stream, int, string,
+ io__state, io__state).
+:- mode io__read_line_as_string_2(in, out, out, di, uo) is det.
+
+:- pragma c_code(io__read_line_as_string_2(File::in, Res :: out,
+ RetString::out, IO0::di, IO::uo),
+ will_not_call_mercury,
+"
+#define READ_LINE_GROW(n) ((n) * 3 / 2)
+#define BYTES_TO_WORDS(n) (((n) + sizeof(Word) - 1) / sizeof(Word))
+#define READ_LINE_START 1024
+
+ Char initial_read_buffer[READ_LINE_START];
+ Char *read_buffer = initial_read_buffer;
+ size_t read_buf_size = READ_LINE_START;
+ size_t i;
+ int char_code = '\\0';
+
+ Res = 0;
+ for (i = 0; char_code != '\\n'; ) {
+ char_code = mercury_getc((MercuryFile *) File);
+ if (char_code == -1) {
+ if (i == 0) {
+ Res = -1;
+ }
+ break;
+ }
+ if (char_code != (Char) char_code) {
+ Res = -2;
+ break;
+ }
+ read_buffer[i++] = char_code;
+ MR_assert(i <= read_buf_size);
+ if (i == read_buf_size) {
+ /* Grow the read buffer */
+ read_buf_size = READ_LINE_GROW(read_buf_size);
+ if (read_buffer == initial_read_buffer) {
+ read_buffer = checked_malloc(read_buf_size
+ * sizeof(Char));
+ memcpy(read_buffer, initial_read_buffer,
+ READ_LINE_START);
+ }
+ else {
+ read_buffer = checked_realloc(read_buffer,
+ read_buf_size * sizeof(Char));
+ }
+ }
+ }
+ if (Res == 0) {
+ incr_hp_atomic(RetString,
+ BYTES_TO_WORDS((i + 1) * sizeof(Char)));
+ memcpy((void *) RetString, read_buffer, i * sizeof(Char));
+ ((Char *) RetString)[i] = '\\0';
+ } else {
+ RetString = NULL;
+ }
+ if (read_buffer != initial_read_buffer) {
+ free(read_buffer);
+ }
+ update_io(IO0, IO);
+").
+
io__read_file(Result) -->
io__input_stream(Stream),
io__read_file(Stream, Result).
@@ -2525,9 +2632,9 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__putback_char(File::in, Character::in, IO0::di, IO::uo),
+:- pragma(c_code, io__putback_char(File::in, Character::in, IO0::di, IO::uo),
will_not_call_mercury, "{
- MercuryFile* mf = (MercuryFile *)File;
+ MercuryFile* mf = (MercuryFile *) File;
if (Character == '\\n') {
mf->line_number--;
}
@@ -2538,9 +2645,9 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__putback_byte(File::in, Character::in, IO0::di, IO::uo),
+:- pragma(c_code, io__putback_byte(File::in, Character::in, IO0::di, IO::uo),
will_not_call_mercury, "{
- MercuryFile* mf = (MercuryFile *)File;
+ MercuryFile* mf = (MercuryFile *) File;
/* XXX should work even if ungetc() fails */
if (ungetc(Character, mf->file) == EOF) {
fatal_error(""io__putback_byte: ungetc failed"");
@@ -2843,7 +2950,7 @@
io__set_input_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
will_not_call_mercury, "
OutStream = (Word) mercury_current_text_input;
- mercury_current_text_input = (MercuryFile*) NewStream;
+ mercury_current_text_input = (MercuryFile *) NewStream;
update_io(IO0, IO);
").
@@ -2851,7 +2958,7 @@
io__set_output_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
will_not_call_mercury, "
OutStream = (Word) mercury_current_text_output;
- mercury_current_text_output = (MercuryFile*) NewStream;
+ mercury_current_text_output = (MercuryFile *) NewStream;
update_io(IO0, IO);
").
@@ -2859,7 +2966,7 @@
io__set_binary_input_stream(NewStream::in, OutStream::out,
IO0::di, IO::uo), will_not_call_mercury, "
OutStream = (Word) mercury_current_binary_input;
- mercury_current_binary_input = (MercuryFile*) NewStream;
+ mercury_current_binary_input = (MercuryFile *) NewStream;
update_io(IO0, IO);
").
@@ -2867,7 +2974,7 @@
io__set_binary_output_stream(NewStream::in, OutStream::out,
IO0::di, IO::uo), will_not_call_mercury, "
OutStream = (Word) mercury_current_binary_output;
- mercury_current_binary_output = (MercuryFile*) NewStream;
+ mercury_current_binary_output = (MercuryFile *) NewStream;
update_io(IO0, IO);
").
@@ -2888,25 +2995,25 @@
:- pragma c_code(io__close_input(Stream::in, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
- mercury_close((MercuryFile*)Stream);
+ mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_output(Stream::in, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
- mercury_close((MercuryFile*)Stream);
+ mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_binary_input(Stream::in, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
- mercury_close((MercuryFile*)Stream);
+ mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_binary_output(Stream::in, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
- mercury_close((MercuryFile*)Stream);
+ mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
Index: library/io.nu.nl
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.nu.nl,v
retrieving revision 1.63
diff -u -t -u -r1.63 io.nu.nl
--- io.nu.nl 1998/07/28 02:21:57 1.63
+++ io.nu.nl 1998/07/28 03:27:02
@@ -315,6 +315,10 @@
Result = ok(Term)
}.
+ % In Prolog, strings and lists of chars are the same.
+io__read_line_as_string(S, Result) -->
+ io__read_line(S, Result).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/math.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/math.m,v
retrieving revision 1.15
diff -u -t -u -r1.15 math.m
--- math.m 1998/08/24 04:45:24 1.15
+++ math.m 1998/09/04 07:51:13
@@ -11,11 +11,34 @@
% Higher mathematical operations. (The basics are in float.m.)
% The predicates in this module are not yet implemented in Prolog.
%
-% Domain errors are currently handled by a program abort. This is
-% because Mercury currently does not have exceptions built in.
+% By default, domain errors are currently handled by a program abort.
+% This is because Mercury currently does not have exceptions built in.
% Exception-handling would be nice, but it's kind of low on the
% priority scale.
%
+% For better performance, it is possible to disable the Mercury domain
+% checking by compiling with `--intermodule-optimization' and the C macro
+% symbol `ML_OMIT_MATH_DOMAIN_CHECKS' defined, e.g. by using
+% `MCFLAGS=--intermodule-optimization' and
+% `MGNUCFLAGS=-DML_OMIT_MATH_DOMAIN_CHECKS' in your Mmakefile,
+% or by compiling with the command
+% `mmc --intermodule-optimization --cflags -DML_OMIT_MATH_DOMAIN_CHECKS'.
+%
+% For maximum performance, all Mercury domain checking can be disabled by
+% recompiling this module using `MGNUCFLAGS=-DML_OMIT_MATH_DOMAIN_CHECKS'
+% or `mmc --cflags -DML_OMIT_MATH_DOMAIN_CHECKS' as above. You can
+% either recompile the entire library, or just copy `math.m' to your
+% application's source directory and link with it directly instead of as
+% part of the library.
+%
+% Note that the above performance improvements are semantically safe,
+% since the C math library and/or floating point hardware perform these
+% checks for you. The benefit of having the Mercury library perform the
+% checks instead is that Mercury will tell you in which function or
+% predicate the error occurred, as well as giving you a stack trace if
+% that is enabled; with the checks disabled you only have the information
+% that the floating-point exception signal handler gives you.
+%
%---------------------------------------------------------------------------%
:- module math.
@@ -178,11 +201,11 @@
** Mathematical constants.
*/
- #define MERCURY_FLOAT__E 2.7182818284590452354
- #define MERCURY_FLOAT__PI 3.1415926535897932384
- #define MERCURY_FLOAT__LN2 0.69314718055994530941
+ #define ML_FLOAT_E 2.7182818284590452354
+ #define ML_FLOAT_PI 3.1415926535897932384
+ #define ML_FLOAT_LN2 0.69314718055994530941
- void mercury_domain_error(const char *where);
+ void ML_math_domain_error(const char *where);
"). % end pragma c_header_code
@@ -194,12 +217,14 @@
** Handle domain errors.
*/
void
- mercury_domain_error(const char *where)
+ ML_math_domain_error(const char *where)
{
fflush(stdout);
fprintf(stderr,
""Software error: Domain error in call to `%s'\n"",
where);
+ MR_trace_report(stderr);
+ MR_dump_stack(MR_succip, MR_sp, MR_curfr);
exit(1);
}
@@ -210,12 +235,12 @@
%
% Pythagoras' number
:- pragma c_code(math__pi = (Pi::out), [will_not_call_mercury, thread_safe],"
- Pi = MERCURY_FLOAT__PI;
+ Pi = ML_FLOAT_PI;
").
% Base of natural logarithms
:- pragma c_code(math__e = (E::out), [will_not_call_mercury, thread_safe],"
- E = MERCURY_FLOAT__E;
+ E = ML_FLOAT_E;
").
%
@@ -253,9 +278,9 @@
:- pragma c_code(math__truncate(X::in) = (Trunc::out),
[will_not_call_mercury, thread_safe],"
if (X < 0.0) {
- Trunc = ceil(X);
+ Trunc = ceil(X);
} else {
- Trunc = floor(X);
+ Trunc = floor(X);
}
").
@@ -267,10 +292,12 @@
% X >= 0
%
:- pragma c_code(math__sqrt(X::in) = (SquareRoot::out),
- [will_not_call_mercury, thread_safe],"
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < 0.0) {
- mercury_domain_error(""math__sqrt"");
+ ML_math_domain_error(""math__sqrt"");
}
+#endif
SquareRoot = sqrt(X);
").
@@ -283,18 +310,22 @@
% X = 0 implies Y > 0
%
:- pragma c_code(math__pow(X::in, Y::in) = (Res::out),
- [will_not_call_mercury, thread_safe],"
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < 0.0) {
- mercury_domain_error(""math__pow"");
+ ML_math_domain_error(""math__pow"");
}
if (X == 0.0) {
- if (Y <= 0.0) {
- mercury_domain_error(""math__pow"");
- }
- Res = 0.0;
+ if (Y <= 0.0) {
+ ML_math_domain_error(""math__pow"");
+ }
+ Res = 0.0;
} else {
- Res = pow(X, Y);
+ Res = pow(X, Y);
}
+#else
+ Res = pow(X, Y);
+#endif
").
%
@@ -314,10 +345,12 @@
% X > 0
%
:- pragma c_code(math__ln(X::in) = (Log::out),
- [will_not_call_mercury, thread_safe],"
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0) {
- mercury_domain_error(""math__ln"");
+ ML_math_domain_error(""math__ln"");
}
+#endif
Log = log(X);
").
@@ -329,9 +362,12 @@
% X > 0
%
:- pragma c_code(math__log10(X::in) = (Log10::out),
- [will_not_call_mercury, thread_safe],"
- if (X <= 0.0)
- mercury_domain_error(""math__log10"");
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X <= 0.0) {
+ ML_math_domain_error(""math__log10"");
+ }
+#endif
Log10 = log10(X);
").
@@ -343,11 +379,13 @@
% X > 0
%
:- pragma c_code(math__log2(X::in) = (Log2::out),
- [will_not_call_mercury, thread_safe],"
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0) {
- mercury_domain_error(""math__log2"");
+ ML_math_domain_error(""math__log2"");
}
- Log2 = log(X) / MERCURY_FLOAT__LN2;
+#endif
+ Log2 = log(X) / ML_FLOAT_LN2;
").
%
@@ -360,13 +398,15 @@
% B \= 1
%
:- pragma c_code(math__log(B::in, X::in) = (Log::out),
- [will_not_call_mercury, thread_safe],"
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0 || B <= 0.0) {
- mercury_domain_error(""math__log"");
+ ML_math_domain_error(""math__log"");
}
if (B == 1.0) {
- mercury_domain_error(""math__log"");
+ ML_math_domain_error(""math__log"");
}
+#endif
Log = log(X)/log(B);
").
@@ -402,10 +442,12 @@
% X must be in the range [-1,1]
%
:- pragma c_code(math__asin(X::in) = (ASin::out),
- [will_not_call_mercury, thread_safe],"
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < -1.0 || X > 1.0) {
- mercury_domain_error(""math__asin"");
+ ML_math_domain_error(""math__asin"");
}
+#endif
ASin = asin(X);
").
@@ -417,10 +459,12 @@
% X must be in the range [-1,1]
%
:- pragma c_code(math__acos(X::in) = (ACos::out),
- [will_not_call_mercury, thread_safe],"
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < -1.0 || X > 1.0) {
- mercury_domain_error(""math__acos"");
+ ML_math_domain_error(""math__acos"");
}
+#endif
ACos = acos(X);
").
@@ -660,11 +704,11 @@
%
% Pythagoras' number
:- pragma c_code(math__pi(Pi::out), [will_not_call_mercury, thread_safe],
- "Pi = MERCURY_FLOAT__PI;").
+ "Pi = ML_FLOAT_PI;").
% Base of natural logarithms
:- pragma c_code(math__e(E::out), [will_not_call_mercury, thread_safe],
- "E = MERCURY_FLOAT__E;").
+ "E = ML_FLOAT_E;").
%
% math__ceiling(X, Ceil) is true if Ceil is the smallest integer
@@ -699,9 +743,9 @@
:- pragma c_code(math__truncate(X::in, Trunc::out),
[will_not_call_mercury, thread_safe], "
if (X < 0.0) {
- Trunc = ceil(X);
+ Trunc = ceil(X);
} else {
- Trunc = floor(X);
+ Trunc = floor(X);
}
").
@@ -714,9 +758,11 @@
%
:- pragma c_code(math__sqrt(X::in, SquareRoot::out),
[will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < 0.0) {
- mercury_domain_error(""math__sqrt"");
+ ML_math_domain_error(""math__sqrt"");
}
+#endif
SquareRoot = sqrt(X);
").
@@ -730,17 +776,21 @@
%
:- pragma c_code(math__pow(X::in, Y::in, Res::out),
[will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < 0.0) {
- mercury_domain_error(""math__pow"");
+ ML_math_domain_error(""math__pow"");
}
if (X == 0.0) {
- if (Y <= 0.0) {
- mercury_domain_error(""math__pow"");
- }
- Res = 0.0;
+ if (Y <= 0.0) {
+ ML_math_domain_error(""math__pow"");
+ }
+ Res = 0.0;
} else {
- Res = pow(X, Y);
+ Res = pow(X, Y);
}
+#else
+ Res = pow(X, Y);
+#endif
").
%
@@ -761,9 +811,11 @@
%
:- pragma c_code(math__ln(X::in, Log::out),
[will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0) {
- mercury_domain_error(""math__ln"");
+ ML_math_domain_error(""math__ln"");
}
+#endif
Log = log(X);
").
@@ -776,8 +828,11 @@
%
:- pragma c_code(math__log10(X::in, Log10::out),
[will_not_call_mercury, thread_safe], "
- if (X <= 0.0)
- mercury_domain_error(""math__log10"");
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X <= 0.0) {
+ ML_math_domain_error(""math__log10"");
+ }
+#endif
Log10 = log10(X);
").
@@ -790,10 +845,12 @@
%
:- pragma c_code(math__log2(X::in, Log2::out),
[will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0) {
- mercury_domain_error(""math__log2"");
+ ML_math_domain_error(""math__log2"");
}
- Log2 = log(X) / MERCURY_FLOAT__LN2;
+#endif
+ Log2 = log(X) / ML_FLOAT_LN2;
").
%
@@ -807,12 +864,14 @@
%
:- pragma c_code(math__log(B::in, X::in, Log::out),
[will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0 || B <= 0.0) {
- mercury_domain_error(""math__log"");
+ ML_math_domain_error(""math__log"");
}
if (B == 1.0) {
- mercury_domain_error(""math__log"");
+ ML_math_domain_error(""math__log"");
}
+#endif
Log = log(X)/log(B);
").
@@ -849,9 +908,11 @@
%
:- pragma c_code(math__asin(X::in, ASin::out),
[will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < -1.0 || X > 1.0) {
- mercury_domain_error(""math__asin"");
+ ML_math_domain_error(""math__asin"");
}
+#endif
ASin = asin(X);
").
@@ -864,9 +925,11 @@
%
:- pragma c_code(math__acos(X::in, ACos::out),
[will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < -1.0 || X > 1.0) {
- mercury_domain_error(""math__acos"");
+ ML_math_domain_error(""math__acos"");
}
+#endif
ACos = asin(X);
").
Index: library/queue.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/queue.m,v
retrieving revision 1.19
diff -u -t -u -r1.19 queue.m
--- queue.m 1998/02/24 23:59:52 1.19
+++ queue.m 1998/04/09 02:05:56
@@ -165,7 +165,14 @@
queue__list_to_queue(List, [] - List).
queue__delete_all(On0 - Off0, Elem, On - Off) :-
- list__delete_all(On0, Elem, On),
- list__delete_all(Off0, Elem, Off).
+ list__delete_all(On0, Elem, On1),
+ list__delete_all(Off0, Elem, Off1),
+ ( Off1 = [] ->
+ list__reverse(On1, Off),
+ On = []
+ ;
+ On = On1,
+ Off = Off1
+ ).
%--------------------------------------------------------------------------%
Index: tests/general//Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/general/Mmakefile,v
retrieving revision 1.20
diff -u -t -u -r1.20 Mmakefile
--- Mmakefile 1998/08/07 05:13:09 1.20
+++ Mmakefile 1998/09/06 23:21:58
@@ -53,6 +53,7 @@
prune_switch \
semi_fail_in_non_ite \
semidet_lambda \
+ read_line_as_string \
semidet_map \
set_test \
string_format_test \
New File: tests/general//read_line_as_string.exp
===================================================================
Hello
world
[Deleted for diff purposes: A line containing 2047 a's]
New File: tests/general//read_line_as_string.m
===================================================================
:- module read_line_as_string.
:- interface.
:- import_module io.
:- pred main(io__state :: di, io__state :: uo) is det.
:- implementation.
main -->
io__open_input("read_line_as_string.exp", Result),
( { Result = ok(Stream) } ->
io__set_input_stream(Stream, _),
io__read_line_as_string(Result2),
cat(Result2)
;
io__write_string("Error opening file!")
).
:- pred cat(io__result(string)::in, io__state::di, io__state::uo) is det.
cat(Result) -->
( { Result = ok(Line) },
io__write_string(Line),
io__read_line_as_string(NextResult),
cat(NextResult)
; { Result = eof }
; { Result = error(_Error) },
io__write_string("Error reading file!")
).
% Test for the times before io__read_line_as_string isn't implemented. :-)
%
% :- import_module string.
% :- pred read_line_as_string(io__result(string) :: out, io__state :: di,
% io__state :: uo) is det.
%
% read_line_as_string(Result) -->
% io__read_line(Result0),
% ( { Result0 = ok(Line0) },
% { string__from_char_list(Line0, Line) },
% { Result = ok(Line) }
% ; { Result0 = eof },
% { Result = eof }
% ; { Result0 = error(Error) },
% { Result = error(Error) }
% ).
More information about the developers
mailing list