[m-rev.] for review: improve standard library error handling
Simon Taylor
stayl at cs.mu.OZ.AU
Thu Aug 30 02:31:27 AEST 2001
Estimated hours taken: 6
Branches: main
Generate exceptions rather than program aborts for domain errors
and out of bounds array accesses.
Improve the handling of the arithmetic functions.
library/float.m:
library/int.m:
compiler/builtin_ops.m:
Handle division by zero with an exception rather than a
program abort.
Add int__unchecked_quotient and float__unchecked_quotient,
which don't check for division by zero.
Remove reverse modes of the arithmetic functions in float.m.
Richard O'Keefe pointed out a while ago that they don't work
because of rounding errors.
Remove the long obsolete `int__builtin_*' and
`float__builtin_float_*' predicates.
library/math.m:
library/array.m:
Generate exceptions rather than program aborts.
The bounds and domain checks are now implemented in
Mercury, so they do not need to be duplicated for each
target language.
As discussed on mercury-users a while ago, math__pow(0.0, 0.0)
should return 1.0. This is also consistent with float__pow.
See <http://www.cs.mu.oz.au/research/mercury/mailing-lists/mercury-users/mercury-users.0104/0130.html>.
NEWS:
Document the changes.
tests/general/float_test.m:
tests/general/string_format_test.m:
tests/hard_coded/ho_solns.m:
tests/hard_coded/ho_univ_to_type.m:
tests/hard_coded/qual_strang.m:
tests/hard_coded/qual_strung.m:
Rename occurrences of `builtin_*'.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.216
diff -u -u -r1.216 NEWS
--- NEWS 2001/08/13 05:49:27 1.216
+++ NEWS 2001/08/29 16:13:50
@@ -22,6 +22,16 @@
Reference Manual.
Changes to the Mercury standard library:
+* The predicates and functions in int.m, float, math.m and array.m now
+ generate exceptions rather than program aborts on domain errors and
+ out-of-bounds array accesses.
+
+* We've removed the buggy reverse modes of the arithmetic functions in
+ float.m (because of rounding errors the functions aren't actually
+ reversible).
+
+* math__pow(0.0, 0.0) now returns 1.0, not 0.0.
+
* The exception module has a new predicate `try_store', which is
like `try_io', but which works with stores rather than io__states.
@@ -46,6 +56,11 @@
representations of term components as strings.
* We've made the outputs of the string concatenation primitives unique.
+
+* We've removed the long obsolete `int__builtin_*' and
+ `float__builtin_float_*' predicates, which were synonyms
+ for the arithmetic functions dating from when Mercury didn't
+ have functions.
Changes to the Mercury implementation:
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.7
diff -u -u -r1.7 builtin_ops.m
--- compiler/builtin_ops.m 2001/07/08 16:40:04 1.7
+++ compiler/builtin_ops.m 2001/08/29 09:44:51
@@ -175,94 +175,42 @@
builtin_translation("private_builtin", "builtin_int_lt", 0, [X, Y],
test(binary((<), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_plus", 0, [X, Y, Z],
- assign(Z, binary((+), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_plus", 1, [X, Y, Z],
- assign(X, binary((-), leaf(Z), leaf(Y)))).
-builtin_translation("int", "builtin_plus", 2, [X, Y, Z],
- assign(Y, binary((-), leaf(Z), leaf(X)))).
builtin_translation("int", "+", 0, [X, Y, Z],
assign(Z, binary((+), leaf(X), leaf(Y)))).
builtin_translation("int", "+", 1, [X, Y, Z],
assign(X, binary((-), leaf(Z), leaf(Y)))).
builtin_translation("int", "+", 2, [X, Y, Z],
assign(Y, binary((-), leaf(Z), leaf(X)))).
-builtin_translation("int", "builtin_minus", 0, [X, Y, Z],
- assign(Z, binary((-), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_minus", 1, [X, Y, Z],
- assign(X, binary((+), leaf(Y), leaf(Z)))).
-builtin_translation("int", "builtin_minus", 2, [X, Y, Z],
- assign(Y, binary((-), leaf(X), leaf(Z)))).
builtin_translation("int", "-", 0, [X, Y, Z],
assign(Z, binary((-), leaf(X), leaf(Y)))).
builtin_translation("int", "-", 1, [X, Y, Z],
assign(X, binary((+), leaf(Y), leaf(Z)))).
builtin_translation("int", "-", 2, [X, Y, Z],
assign(Y, binary((-), leaf(X), leaf(Z)))).
-builtin_translation("int", "builtin_times", 0, [X, Y, Z],
- assign(Z, binary((*), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_times", 1, [X, Y, Z],
- assign(X, binary((/), leaf(Z), leaf(Y)))).
-builtin_translation("int", "builtin_times", 2, [X, Y, Z],
- assign(Y, binary((/), leaf(Z), leaf(X)))).
builtin_translation("int", "*", 0, [X, Y, Z],
assign(Z, binary((*), leaf(X), leaf(Y)))).
-builtin_translation("int", "*", 1, [X, Y, Z],
- assign(X, binary((/), leaf(Z), leaf(Y)))).
-builtin_translation("int", "*", 2, [X, Y, Z],
- assign(Y, binary((/), leaf(Z), leaf(X)))).
-builtin_translation("int", "builtin_div", 0, [X, Y, Z],
+builtin_translation("int", "unchecked_quotient", 0, [X, Y, Z],
assign(Z, binary((/), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_div", 1, [X, Y, Z],
- assign(X, binary((*), leaf(Y), leaf(Z)))).
-builtin_translation("int", "builtin_div", 2, [X, Y, Z],
- assign(Y, binary((/), leaf(X), leaf(Z)))).
-builtin_translation("int", "//", 0, [X, Y, Z],
- assign(Z, binary((/), leaf(X), leaf(Y)))).
-builtin_translation("int", "//", 1, [X, Y, Z],
- assign(X, binary((*), leaf(Y), leaf(Z)))).
-builtin_translation("int", "//", 2, [X, Y, Z],
- assign(Y, binary((/), leaf(X), leaf(Z)))).
-builtin_translation("int", "builtin_mod", 0, [X, Y, Z],
- assign(Z, binary((mod), leaf(X), leaf(Y)))).
builtin_translation("int", "rem", 0, [X, Y, Z],
assign(Z, binary((mod), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_left_shift", 0, [X, Y, Z],
- assign(Z, binary((<<), leaf(X), leaf(Y)))).
builtin_translation("int", "unchecked_left_shift", 0, [X, Y, Z],
assign(Z, binary((<<), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_right_shift", 0, [X, Y, Z],
- assign(Z, binary((>>), leaf(X), leaf(Y)))).
builtin_translation("int", "unchecked_right_shift", 0, [X, Y, Z],
assign(Z, binary((>>), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_bit_and", 0, [X, Y, Z],
- assign(Z, binary((&), leaf(X), leaf(Y)))).
builtin_translation("int", "/\\", 0, [X, Y, Z],
assign(Z, binary((&), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_bit_or", 0, [X, Y, Z],
- assign(Z, binary(('|'), leaf(X), leaf(Y)))).
builtin_translation("int", "\\/", 0, [X, Y, Z],
assign(Z, binary(('|'), leaf(X), leaf(Y)))).
-builtin_translation("int", "builtin_bit_xor", 0, [X, Y, Z],
- assign(Z, binary((^), leaf(X), leaf(Y)))).
-builtin_translation("int", "^", 0, [X, Y, Z],
- assign(Z, binary((^), leaf(X), leaf(Y)))).
builtin_translation("int", "xor", 0, [X, Y, Z],
assign(Z, binary((^), leaf(X), leaf(Y)))).
builtin_translation("int", "xor", 1, [X, Y, Z],
assign(Y, binary((^), leaf(X), leaf(Z)))).
builtin_translation("int", "xor", 2, [X, Y, Z],
assign(X, binary((^), leaf(Y), leaf(Z)))).
-builtin_translation("int", "builtin_unary_plus", 0, [X, Y],
- assign(Y, leaf(X))).
builtin_translation("int", "+", 0, [X, Y],
assign(Y, leaf(X))).
-builtin_translation("int", "builtin_unary_minus", 0, [X, Y],
- assign(Y, binary((-), int_const(0), leaf(X)))).
builtin_translation("int", "-", 0, [X, Y],
assign(Y, binary((-), int_const(0), leaf(X)))).
-builtin_translation("int", "builtin_bit_neg", 0, [X, Y],
- assign(Y, unary(bitwise_complement, leaf(X)))).
builtin_translation("int", "\\", 0, [X, Y],
assign(Y, unary(bitwise_complement, leaf(X)))).
builtin_translation("int", ">", 0, [X, Y],
@@ -274,72 +222,24 @@
builtin_translation("int", "=<", 0, [X, Y],
test(binary((<=), leaf(X), leaf(Y)))).
-builtin_translation("float", "builtin_float_plus", 0, [X, Y, Z],
- assign(Z, binary(float_plus, leaf(X), leaf(Y)))).
-builtin_translation("float", "builtin_float_plus", 1, [X, Y, Z],
- assign(X, binary(float_minus, leaf(Z), leaf(Y)))).
-builtin_translation("float", "builtin_float_plus", 2, [X, Y, Z],
- assign(Y, binary(float_minus, leaf(Z), leaf(X)))).
builtin_translation("float", "+", 0, [X, Y, Z],
assign(Z, binary(float_plus, leaf(X), leaf(Y)))).
-builtin_translation("float", "+", 1, [X, Y, Z],
- assign(X, binary(float_minus, leaf(Z), leaf(Y)))).
-builtin_translation("float", "+", 2, [X, Y, Z],
- assign(Y, binary(float_minus, leaf(Z), leaf(X)))).
-builtin_translation("float", "builtin_float_minus", 0, [X, Y, Z],
- assign(Z, binary(float_minus, leaf(X), leaf(Y)))).
-builtin_translation("float", "builtin_float_minus", 1, [X, Y, Z],
- assign(X, binary(float_plus, leaf(Y), leaf(Z)))).
-builtin_translation("float", "builtin_float_minus", 2, [X, Y, Z],
- assign(Y, binary(float_minus, leaf(X), leaf(Z)))).
builtin_translation("float", "-", 0, [X, Y, Z],
assign(Z, binary(float_minus, leaf(X), leaf(Y)))).
-builtin_translation("float", "-", 1, [X, Y, Z],
- assign(X, binary(float_plus, leaf(Y), leaf(Z)))).
-builtin_translation("float", "-", 2, [X, Y, Z],
- assign(Y, binary(float_minus, leaf(X), leaf(Z)))).
-builtin_translation("float", "builtin_float_times", 0, [X, Y, Z],
- assign(Z, binary(float_times, leaf(X), leaf(Y)))).
-builtin_translation("float", "builtin_float_times", 1, [X, Y, Z],
- assign(X, binary(float_divide, leaf(Z), leaf(Y)))).
-builtin_translation("float", "builtin_float_times", 2, [X, Y, Z],
- assign(Y, binary(float_divide, leaf(Z), leaf(X)))).
builtin_translation("float", "*", 0, [X, Y, Z],
assign(Z, binary(float_times, leaf(X), leaf(Y)))).
-builtin_translation("float", "*", 1, [X, Y, Z],
- assign(X, binary(float_divide, leaf(Z), leaf(Y)))).
-builtin_translation("float", "*", 2, [X, Y, Z],
- assign(Y, binary(float_divide, leaf(Z), leaf(X)))).
-builtin_translation("float", "builtin_float_divide", 0, [X, Y, Z],
- assign(Z, binary(float_divide, leaf(X), leaf(Y)))).
-builtin_translation("float", "builtin_float_divide", 1, [X, Y, Z],
- assign(X, binary(float_times, leaf(Y), leaf(Z)))).
-builtin_translation("float", "builtin_float_divide", 2, [X, Y, Z],
- assign(Y, binary(float_divide, leaf(X), leaf(Z)))).
-builtin_translation("float", "/", 0, [X, Y, Z],
+builtin_translation("float", "unchecked_quotient", 0, [X, Y, Z],
assign(Z, binary(float_divide, leaf(X), leaf(Y)))).
-builtin_translation("float", "/", 1, [X, Y, Z],
- assign(X, binary(float_times, leaf(Y), leaf(Z)))).
-builtin_translation("float", "/", 2, [X, Y, Z],
- assign(Y, binary(float_divide, leaf(X), leaf(Z)))).
builtin_translation("float", "+", 0, [X, Y],
assign(Y, leaf(X))).
builtin_translation("float", "-", 0, [X, Y],
assign(Y, binary(float_minus, float_const(0.0), leaf(X)))).
-builtin_translation("float", "builtin_float_gt", 0, [X, Y],
- test(binary(float_gt, leaf(X), leaf(Y)))).
builtin_translation("float", ">", 0, [X, Y],
test(binary(float_gt, leaf(X), leaf(Y)))).
-builtin_translation("float", "builtin_float_lt", 0, [X, Y],
- test(binary(float_lt, leaf(X), leaf(Y)))).
builtin_translation("float", "<", 0, [X, Y],
test(binary(float_lt, leaf(X), leaf(Y)))).
-builtin_translation("float", "builtin_float_ge", 0, [X, Y],
- test(binary(float_ge, leaf(X), leaf(Y)))).
builtin_translation("float", ">=", 0, [X, Y],
test(binary(float_ge, leaf(X), leaf(Y)))).
-builtin_translation("float", "builtin_float_le", 0, [X, Y],
- test(binary(float_le, leaf(X), leaf(Y)))).
builtin_translation("float", "=<", 0, [X, Y],
test(binary(float_le, leaf(X), leaf(Y)))).
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.97
diff -u -u -r1.97 array.m
--- library/array.m 2001/08/13 01:19:56 1.97
+++ library/array.m 2001/08/29 13:52:47
@@ -91,6 +91,11 @@
:- mode array_muo == out(mostly_uniq_array).
:- mode array_mui == in(mostly_uniq_array).
+ % An `array__error' is the exception thrown if any of the
+ % operations fail. The string is a description of the error.
+:- type array__error
+ ---> array__error(string).
+
%-----------------------------------------------------------------------------%
% array__make_empty_array(Array) creates an array of size zero
@@ -162,7 +167,7 @@
%-----------------------------------------------------------------------------%
% array__lookup returns the Nth element of an array.
- % It is an error if the index is out of bounds.
+ % Throws an exception if the index is out of bounds.
:- pred array__lookup(array(T), int, T).
:- mode array__lookup(array_ui, in, out) is det.
:- mode array__lookup(in, in, out) is det.
@@ -179,7 +184,7 @@
% array__set sets the nth element of an array, and returns the
% resulting array (good opportunity for destructive update ;-).
- % It is an error if the index is out of bounds.
+ % Throws an exception if the index is out of bounds.
:- pred array__set(array(T), int, T, array(T)).
:- mode array__set(array_di, in, in, array_uo) is det.
@@ -249,7 +254,7 @@
% array__shrink(Array0, Size, Array):
% The array is shrunk to make it fit the new size `Size'.
- % It is an error if `Size' is larger than the size of `Array0'.
+ % Throws an exception if `Size' is larger than the size of `Array0'.
:- pred array__shrink(array(T), int, array(T)).
:- mode array__shrink(array_di, in, array_uo) is det.
@@ -382,7 +387,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module int.
+:- import_module exception, int.
/****
lower bounds other than zero are not supported
@@ -693,18 +698,32 @@
%-----------------------------------------------------------------------------%
-:- pragma foreign_decl("C", "
-#include ""mercury_heap.h"" /* for MR_maybe_record_allocation() */
-#include ""mercury_library_types.h"" /* for MR_ArrayType */
+:- pred bounds_checks is semidet.
+:- pragma inline(bounds_checks/0).
+
+:- pragma foreign_proc("C", bounds_checks,
+ [will_not_call_mercury, thread_safe], "
+#ifdef ML_OMIT_ARRAY_BOUNDS_CHECKS
+ SUCCESS_INDICATOR = FALSE;
+#else
+ SUCCESS_INDICATOR = TRUE;
+#endif
+").
-#ifdef ML_ARRAY_THROW_EXCEPTIONS
- #include ""exception.h"" /* for ML_throw_string */
- /* shut up warnings about casting away const */
- #define ML_array_raise(s) ML_throw_string((char *) (void *) s)
+:- pragma foreign_proc("C#", bounds_checks,
+ [thread_safe], "
+#if ML_OMIT_ARRAY_BOUNDS_CHECKS
+ SUCCESS_INDICATOR = FALSE;
#else
- #include ""mercury_misc.h"" /* for MR_fatal_error() */
- #define ML_array_raise(s) MR_fatal_error(s)
+ SUCCESS_INDICATOR = TRUE;
#endif
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C", "
+#include ""mercury_heap.h"" /* for MR_maybe_record_allocation() */
+#include ""mercury_library_types.h"" /* for MR_ArrayType */
").
:- pragma foreign_decl("C", "
@@ -727,14 +746,19 @@
}
").
+array__init(Size, Item, Array) :-
+ ( Size < 0 ->
+ throw(array__error("array__init: negative size"))
+ ;
+ array__init_2(Size, Item, Array)
+ ).
+
+:- pred array__init_2(int, T, array(T)).
+:- mode array__init_2(in, in, array_uo) is det.
+
:- pragma foreign_proc("C",
- array__init(Size::in, Item::in, Array::array_uo),
+ array__init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
- if (Size < 0) {
- ML_array_raise(""array__init: negative size"");
- }
-#endif
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_make_array(Size, Item);
").
@@ -747,7 +771,7 @@
").
:- pragma foreign_proc("C#",
- array__init(Size::in, Item::in, Array::array_uo),
+ array__init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
Array = System.Array.CreateInstance(Item.GetType(), Size);
for (int i = 0; i < Size; i++) {
@@ -865,38 +889,37 @@
%-----------------------------------------------------------------------------%
+array__lookup(Array, Index, Item) :-
+ ( bounds_checks, \+ array__in_bounds(Array, Index) ->
+ throw(array__error("array__lookup: array index out of bounds"))
+ ;
+ array__unsafe_lookup(Array, Index, Item)
+ ).
+
+:- pred array__unsafe_lookup(array(T), int, T).
+:- mode array__unsafe_lookup(array_ui, in, out) is det.
+:- mode array__unsafe_lookup(in, in, out) is det.
+
:- pragma foreign_proc("C",
- array__lookup(Array::array_ui, Index::in, Item::out),
+ array__unsafe_lookup(Array::array_ui, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
-#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
- if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- ML_array_raise(
- ""array__lookup: array index out of bounds"");
- }
-#endif
Item = array->elements[Index];
}").
:- pragma foreign_proc("C",
- array__lookup(Array::in, Index::in, Item::out),
+ array__unsafe_lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
-#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
- if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- ML_array_raise(
- ""array__lookup: array index out of bounds"");
- }
-#endif
Item = array->elements[Index];
}").
:- pragma foreign_proc("C#",
- array__lookup(Array::array_ui, Index::in, Item::out),
+ array__unsafe_lookup(Array::array_ui, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
Item = Array.GetValue(Index);
}").
:- pragma foreign_proc("C#",
- array__lookup(Array::in, Index::in, Item::out),
+ array__unsafe_lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
Item = Array.GetValue(Index);
}").
@@ -904,23 +927,27 @@
%-----------------------------------------------------------------------------%
+array__set(Array0, Index, Item, Array) :-
+ ( bounds_checks, \+ array__in_bounds(Array0, Index) ->
+ throw(array__error("array__set: array index out of bounds"))
+ ;
+ array__unsafe_set(Array0, Index, Item, Array)
+ ).
+
+:- pred array__unsafe_set(array(T), int, T, array(T)).
+:- mode array__unsafe_set(array_di, in, in, array_uo) is det.
+
:- pragma foreign_proc("C",
- array__set(Array0::array_di, Index::in,
+ array__unsafe_set(Array0::array_di, Index::in,
Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array0;
-#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
- if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- ML_array_raise(
- ""array__set: array index out of bounds"");
- }
-#endif
array->elements[Index] = Item; /* destructive update! */
Array = Array0;
}").
:- pragma foreign_proc("C#",
- array__set(Array0::array_di, Index::in,
+ array__unsafe_set(Array0::array_di, Index::in,
Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "{
Array0.SetValue(Item, Index); /* destructive update! */
@@ -1000,10 +1027,6 @@
old_array_size = old_array->size;
if (old_array_size == array_size) return old_array;
- if (old_array_size < array_size) {
- ML_array_raise(
- ""array__shrink: can't shrink to a larger size"");
- }
array = (MR_ArrayType *) MR_GC_NEW_ARRAY(MR_Word, array_size + 1);
array->size = array_size;
@@ -1021,15 +1044,26 @@
}
").
+array__shrink(Array0, Size, Array) :-
+ ( Size > array__size(Array0) ->
+ throw(array__error(
+ "array__shrink: can't shrink to a larger size"))
+ ;
+ array__shrink_2(Array0, Size, Array)
+ ).
+
+:- pred array__shrink_2(array(T), int, array(T)).
+:- mode array__shrink_2(array_di, in, array_uo) is det.
+
:- pragma foreign_proc("C",
- array__shrink(Array0::array_di, Size::in, Array::array_uo),
+ array__shrink_2(Array0::array_di, Size::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_shrink_array(
(MR_ArrayType *) Array0, Size);
").
:- pragma foreign_proc("C#",
- array__shrink(_Array0::array_di, _Size::in, _Array::array_uo),
+ array__shrink_2(_Array0::array_di, _Size::in, _Array::array_uo),
[will_not_call_mercury, thread_safe], "
mercury.runtime.Errors.SORRY(""foreign code for this function"");
").
Index: library/float.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/float.m,v
retrieving revision 1.36
diff -u -u -r1.36 float.m
--- library/float.m 2001/08/14 10:18:45 1.36
+++ library/float.m 2001/08/29 15:33:53
@@ -49,27 +49,27 @@
% addition
:- func float + float = float.
:- mode in + in = uo is det.
-:- mode uo + in = in is det.
-:- mode in + uo = in is det.
% subtraction
:- func float - float = float.
:- mode in - in = uo is det.
-:- mode uo - in = in is det.
-:- mode in - uo = in is det.
% multiplication
:- func float * float = float.
:- mode in * in = uo is det.
-:- mode uo * in = in is det.
-:- mode in * uo = in is det.
% division
+ % Throws an `math__domain_error' exception if the right
+ % operand is zero. See the comments at the top of math.m
+ % to find out how to disable this check.
:- func float / float = float.
:- mode in / in = uo is det.
-:- mode uo / in = in is det.
-:- mode in / uo = in is det.
+ % unchecked_quotient(X, Y) is the same as X / Y, but the
+ % behaviour is undefined if the right operand is zero.
+:- func unchecked_quotient(float, float) = float.
+:- mode unchecked_quotient(in, in) = uo is det.
+
% unary plus
:- func + float = float.
:- mode + in = uo is det.
@@ -257,9 +257,9 @@
:- mode float__min(in, in, out) is det.
% float__pow(Base, Exponent, Answer) is true iff Answer is
- % Base raised to the power Exponent. The exponent must be an
- % integer greater or equal to 0. Currently this function runs
+ % Base raised to the power Exponent. Currently this function runs
% at O(n), where n is the value of the exponent.
+ % Throws a `math__domain_error' exception if the exponent is negative.
:- pragma obsolete(float__pow/3).
:- pred float__pow(float, int, float).
:- mode float__pow(in, in, out) is det.
@@ -308,47 +308,11 @@
:- pred float__max_exponent(int).
:- mode float__max_exponent(out) is det.
-%
-% Synonyms for the builtin arithmetic functions.
-%
-
-:- pragma obsolete(builtin_float_plus/3).
-:- pred builtin_float_plus(float, float, float).
-:- mode builtin_float_plus(in, in, uo) is det.
-
-:- pragma obsolete(builtin_float_minus/3).
-:- pred builtin_float_minus(float, float, float).
-:- mode builtin_float_minus(in, in, uo) is det.
-
-:- pragma obsolete(builtin_float_times/3).
-:- pred builtin_float_times(float, float, float).
-:- mode builtin_float_times(in, in, uo) is det.
-
-:- pragma obsolete(builtin_float_divide/3).
-:- pred builtin_float_divide(float, float, float).
-:- mode builtin_float_divide(in, in, uo) is det.
-
-:- pragma obsolete(builtin_float_gt/2).
-:- pred builtin_float_gt(float, float).
-:- mode builtin_float_gt(in, in) is semidet.
-
-:- pragma obsolete(builtin_float_lt/2).
-:- pred builtin_float_lt(float, float).
-:- mode builtin_float_lt(in, in) is semidet.
-
-:- pragma obsolete(builtin_float_ge/2).
-:- pred builtin_float_ge(float, float).
-:- mode builtin_float_ge(in, in) is semidet.
-
-:- pragma obsolete(builtin_float_le/2).
-:- pred builtin_float_le(float, float).
-:- mode builtin_float_le(in, in) is semidet.
-
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
-:- import_module int, require.
+:- import_module exception, int, math.
%
% Header files of mathematical significance.
@@ -363,9 +327,54 @@
%---------------------------------------------------------------------------%
-% The arithmetic and comparison operators are builtins,
+% The other arithmetic and comparison operators are builtins,
% which the compiler expands inline. We don't need to define them here.
+ % XXX This pragma declaration should be uncommented once the
+ % change to make `//'/2 a non-builtin is installed everywhere.
+%:- pragma inline('/'/2).
+X / Y = Z :-
+ ( domain_checks, Y = 0.0 ->
+ throw(math__domain_error("float:'/'"))
+ ;
+ Z = unchecked_quotient(X, Y)
+ ).
+
+ % implementation of int__unchecked_quotient.
+ % XXX Remove this clause once the change to make unchecked_quotient
+ % a builtin is installed everywhere. (Note that this clause doesn't
+ % cause an infinite loop because the compiler will ignore the
+ % clause for `/'/2 or unchecked_quotient/2 depending on how far
+ % it is through the bootstrapping process. When compiling the
+ % stage 1 compiler, `/' is builtin. During stages 2 and 3,
+ % unchecked_quotient is builtin.
+unchecked_quotient(X, Y) = X / Y.
+
+ % This code is included here rather than just calling
+ % the version in math.m because we currently don't do
+ % transitive inter-module inlining, so code which uses
+ % `/'/2 but doesn't import math.m couldn't have the
+ % domain check optimized away..
+:- pred domain_checks is semidet.
+:- pragma inline(domain_checks/0).
+
+:- pragma foreign_proc("C", domain_checks,
+ [will_not_call_mercury, thread_safe], "
+#ifdef ML_OMIT_MATH_DOMAIN_CHECKS
+ SUCCESS_INDICATOR = FALSE;
+#else
+ SUCCESS_INDICATOR = TRUE;
+#endif
+").
+
+:- pragma foreign_proc("C#", domain_checks,
+ [thread_safe], "
+#if ML_OMIT_MATH_DOMAIN_CHECKS
+ SUCCESS_INDICATOR = FALSE;
+#else
+ SUCCESS_INDICATOR = TRUE;
+#endif
+").
%---------------------------------------------------------------------------%
%
% Conversion functions
@@ -477,7 +486,7 @@
% reduce O(N) to O(logN) of the exponent.
float__pow(X, Exp) = Ans :-
( Exp < 0 ->
- error("float__pow taken with exponent < 0\n")
+ throw(math__domain_error("float__pow"))
; Exp = 1 ->
Ans = X
; Exp = 0 ->
Index: library/int.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/int.m,v
retrieving revision 1.75
diff -u -u -r1.75 int.m
--- library/int.m 2001/03/15 07:42:22 1.75
+++ library/int.m 2001/08/29 15:27:43
@@ -64,14 +64,15 @@
% expontiation
% int__pow(X, Y, Z): Z is X raised to the Yth power
- % Y must not be negative.
+ % Throws a `math__domain_error' exception if Y is negative.
:- func int__pow(int, int) = int.
:- pred int__pow(int, int, int).
:- mode int__pow(in, in, out) is det.
% base 2 logarithm
% int__log2(X) = N is the least integer such that 2 to the
- % power N is greater than or equal to X. X must be positive.
+ % power N is greater than or equal to X.
+ % Throws a `math__domain_error' exception if X is not positive.
:- func int__log2(int) = int.
:- pred int__log2(int, int).
:- mode int__log2(in, out) is det.
@@ -87,13 +88,6 @@
% multiplication
:- func int * int = int.
:- mode in * in = uo is det.
-/*
-% XXX need to change code_util.m before adding these modes
-:- mode in * in = in is semidet.
-:- mode in * in = uo is det.
-:- mode uo * in = in is semidet.
-:- mode in * uo = in is semidet.
-*/
:- func int__times(int, int) = int.
@@ -106,17 +100,30 @@
:- func int__minus(int, int) = int.
% flooring integer division
- % truncates towards minus infinity, e.g. (-10) // 3 = (-4).
+ % Truncates towards minus infinity, e.g. (-10) // 3 = (-4).
+ %
+ % Throws a `math__domain_error' exception if the right operand
+ % is zero. See the comments at the top of math.m to find out how to
+ % disable domain checks.
:- func div(int, int) = int.
:- mode div(in, in) = uo is det.
% truncating integer division
- % truncates towards zero, e.g. (-10) // 3 = (-3).
+ % Truncates towards zero, e.g. (-10) // 3 = (-3).
% `div' has nicer mathematical properties for negative operands,
% but `//' is typically more efficient.
+ %
+ % Throws a `math__domain_error' exception if the right operand
+ % is zero. See the comments at the top of math.m to find out how to
+ % disable domain checks.
:- func int // int = int.
:- mode in // in = uo is det.
+ % unchecked_quotient(X, Y) is the same as X // Y, but the
+ % behaviour is undefined if the right operand is zero.
+:- func unchecked_quotient(int, int) = int.
+:- mode unchecked_quotient(in, in) = uo is det.
+
% modulus
% X mod Y = X - (X div Y) * Y
:- func int mod int = int.
@@ -251,70 +258,10 @@
:- func int__rem_bits_per_int(int) = int.
%-----------------------------------------------------------------------------%
-
-%
-% The following routines are builtins that the compiler knows about.
-% Don't use them; use the functions above.
-% These will go away in some future release.
-%
-
-:- pragma obsolete(builtin_plus/3).
-:- pred builtin_plus(int, int, int).
-:- mode builtin_plus(in, in, uo) is det.
-
-:- pragma obsolete(builtin_unary_plus/2).
-:- pred builtin_unary_plus(int, int).
-:- mode builtin_unary_plus(in, uo) is det.
-
-:- pragma obsolete(builtin_minus/3).
-:- pred builtin_minus(int, int, int).
-:- mode builtin_minus(in, in, uo) is det.
-
-:- pragma obsolete(builtin_unary_minus/2).
-:- pred builtin_unary_minus(int, int).
-:- mode builtin_unary_minus(in, uo) is det.
-
-:- pragma obsolete(builtin_times/3).
-:- pred builtin_times(int, int, int).
-:- mode builtin_times(in, in, uo) is det.
-
-:- pragma obsolete(builtin_div/3).
-:- pred builtin_div(int, int, int).
-:- mode builtin_div(in, in, uo) is det.
-
-:- pragma obsolete(builtin_mod/3).
-:- pred builtin_mod(int, int, int).
-:- mode builtin_mod(in, in, uo) is det.
-
-:- pragma obsolete(builtin_left_shift/3).
-:- pred builtin_left_shift(int, int, int).
-:- mode builtin_left_shift(in, in, uo) is det.
-
-:- pragma obsolete(builtin_right_shift/3).
-:- pred builtin_right_shift(int, int, int).
-:- mode builtin_right_shift(in, in, uo) is det.
-
-:- pragma obsolete(builtin_bit_or/3).
-:- pred builtin_bit_or(int, int, int).
-:- mode builtin_bit_or(in, in, uo) is det.
-
-:- pragma obsolete(builtin_bit_and/3).
-:- pred builtin_bit_and(int, int, int).
-:- mode builtin_bit_and(in, in, uo) is det.
-
-:- pragma obsolete(builtin_bit_xor/3).
-:- pred builtin_bit_xor(int, int, int).
-:- mode builtin_bit_xor(in, in, uo) is det.
-
-:- pragma obsolete(builtin_bit_neg/2).
-:- pred builtin_bit_neg(int, int).
-:- mode builtin_bit_neg(in, uo) is det.
-
%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module require, std_util.
+:- import_module exception, math, std_util.
:- instance enum(int) where [
to_int(X) = X,
@@ -337,6 +284,51 @@
Div = Trunc - 1
).
+ % XXX This pragma declaration should be uncommented once the
+ % change to make `//'/2 a non-builtin is installed everywhere.
+%:- pragma inline('//'/2).
+X // Y = Div :-
+ ( domain_checks, Y = 0 ->
+ throw(math__domain_error("int:'//'"))
+ ;
+ Div = unchecked_quotient(X, Y)
+ ).
+
+ % This code is included here rather than just calling
+ % the version in math.m because we currently don't do
+ % transitive inter-module inlining, so code which uses
+ % `//'/2 but doesn't import math.m couldn't have the
+ % domain check optimized away..
+:- pred domain_checks is semidet.
+:- pragma inline(domain_checks/0).
+
+:- pragma foreign_proc("C", domain_checks,
+ [will_not_call_mercury, thread_safe], "
+#ifdef ML_OMIT_MATH_DOMAIN_CHECKS
+ SUCCESS_INDICATOR = FALSE;
+#else
+ SUCCESS_INDICATOR = TRUE;
+#endif
+").
+
+:- pragma foreign_proc("C#", domain_checks,
+ [thread_safe], "
+#if ML_OMIT_MATH_DOMAIN_CHECKS
+ SUCCESS_INDICATOR = FALSE;
+#else
+ SUCCESS_INDICATOR = TRUE;
+#endif
+").
+
+ % XXX Remove this clause once the change to make unchecked_quotient
+ % a builtin is installed everywhere. (Note that this clause doesn't
+ % cause an infinite loop because the compiler will ignore the
+ % clause for `//'/2 or unchecked_quotient/2 depending on how far
+ % it is through the bootstrapping process. When compiling the
+ % stage 1 compiler, `//' is builtin. During stages 2 and 3,
+ % unchecked_quotient is builtin.
+unchecked_quotient(X, Y) = X // Y.
+
:- pragma inline(floor_to_multiple_of_bits_per_int/1).
floor_to_multiple_of_bits_per_int(X) = Floor :-
Trunc = quot_bits_per_int(X),
@@ -423,8 +415,8 @@
int__pow(Val, Exp, Result).
int__pow(Val, Exp, Result) :-
- ( Exp < 0 ->
- error("int__pow: negative exponent")
+ ( domain_checks, Exp < 0 ->
+ throw(math__domain_error("int__pow"))
;
int__pow_2(Val, Exp, 1, Result)
).
@@ -445,10 +437,10 @@
int__log2(X, N).
int__log2(X, N) :-
- ( X > 0 ->
+ ( domain_checks, X > 0 ->
int__log2_2(X, 0, N)
;
- error("int__log2: cannot take log of a non-positive number")
+ throw(math__domain_error("int__log2"))
).
:- pred int__log2_2(int, int, int).
Index: library/math.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/math.m,v
retrieving revision 1.32
diff -u -u -r1.32 math.m
--- library/math.m 2001/08/27 16:02:02 1.32
+++ library/math.m 2001/08/29 14:29:39
@@ -10,8 +10,7 @@
%
% Higher mathematical operations. (The basics are in float.m.)
%
-% By default, domain errors are currently handled by a program abort.
-% This is because Mercury originally did not have exceptions built in.
+% By default, domain errors are currently handled by throwing an exception.
%
% For better performance, it is possible to disable the Mercury domain
% checking by compiling with `--intermodule-optimization' and the C macro
@@ -104,7 +103,8 @@
% math__pow(X, Y) = Res is true if Res is X raised to the
% power of Y.
%
- % Domain restriction: X >= 0 and (X = 0 implies Y > 0)
+ % Domain restriction: X >= 0 and (X = 0 implies Y >= 0)
+ % (math__pow(0.0, 0.0) = 1.0).
:- func math__pow(float, float) = float.
:- mode math__pow(in, in) = out is det.
@@ -202,9 +202,9 @@
% were outside the domain of the function. The string indicates
% where the error occured.
%
- % NOTE: not all backends will throw an exception in such an event,
- % they may abort instead. It is also possible to switch domain
- % checking off.
+ % It is possible to switch domain checking off, in which case,
+ % depending on the backend, a domain error may cause a program
+ % abort.
:- type domain_error ---> domain_error(string).
@@ -233,8 +233,6 @@
#define ML_FLOAT_PI 3.1415926535897932384
#define ML_FLOAT_LN2 0.69314718055994530941
- void ML_math_domain_error(const char *where);
-
"). % end pragma foreign_decl
:- pragma foreign_code("C#", "
@@ -246,37 +244,26 @@
").
-
-:- pragma foreign_code("C", "
-
- #include ""mercury_trace_base.h""
- #include <stdio.h>
-
- /*
- ** Handle domain errors.
- */
- void
- 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);
- #ifndef MR_HIGHLEVEL_CODE
- MR_dump_stack(MR_succip, MR_sp, MR_curfr, FALSE);
- #endif
- exit(1);
- }
-"). % end pragma foreign_code
+:- pred domain_checks is semidet.
-
-:- pred throw_math_domain_error(string::in) is erroneous.
-
-throw_math_domain_error(S) :- throw(domain_error(S)).
+:- pragma foreign_proc("C", domain_checks,
+ [will_not_call_mercury, thread_safe], "
+#ifdef ML_OMIT_MATH_DOMAIN_CHECKS
+ SUCCESS_INDICATOR = FALSE;
+#else
+ SUCCESS_INDICATOR = TRUE;
+#endif
+").
-:- pragma export(throw_math_domain_error(in), "ML_throw_math_domain_error").
+:- pragma foreign_proc("C#", domain_checks,
+ [thread_safe], "
+#if ML_OMIT_MATH_DOMAIN_CHECKS
+ SUCCESS_INDICATOR = FALSE;
+#else
+ SUCCESS_INDICATOR = TRUE;
+#endif
+").
%
% Mathematical constants from math.m
@@ -362,24 +349,21 @@
% Domain restrictions:
% X >= 0
%
-:- pragma foreign_proc("C", math__sqrt(X::in) = (SquareRoot::out),
+math__sqrt(X) = SquareRoot :-
+ ( domain_checks, X < 0.0 ->
+ throw(domain_error("math__sqrt"))
+ ;
+ SquareRoot = math__sqrt_2(X)
+ ).
+
+:- func math__sqrt_2(float) = float.
+
+:- pragma foreign_proc("C", math__sqrt_2(X::in) = (SquareRoot::out),
[will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X < 0.0) {
- ML_math_domain_error(""math__sqrt"");
- }
-#endif
SquareRoot = sqrt(X);
").
-:- pragma foreign_proc("C#", math__sqrt(X::in) = (SquareRoot::out),
+:- pragma foreign_proc("C#", math__sqrt_2(X::in) = (SquareRoot::out),
[thread_safe], "
-#if ML_OMIT_MATH_DOMAIN_CHECKS
-#else
- if (X < 0.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__sqrt"");
- }
-#endif
SquareRoot = System.Math.Sqrt(X);
").
@@ -433,46 +417,33 @@
%
% Domain restrictions:
% X >= 0
-% X = 0 implies Y > 0
+% X = 0 implies Y >= 0
%
-:- pragma foreign_proc("C", math__pow(X::in, Y::in) = (Res::out),
+math__pow(X, Y) = Res :-
+ ( domain_checks, X < 0.0 ->
+ throw(domain_error("math__pow"))
+ ; X = 0.0 ->
+ ( domain_checks, Y < 0.0 ->
+ throw(domain_error("math__pow"))
+ ; Y = 0.0 ->
+ Res = 1.0
+ ;
+ Res = 0.0
+ )
+ ;
+ Res = math__pow_2(X, Y)
+ ).
+
+:- func math__pow_2(float, float) = float.
+
+:- pragma foreign_proc("C", math__pow_2(X::in, Y::in) = (Res::out),
[will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X < 0.0) {
- ML_math_domain_error(""math__pow"");
- }
- if (X == 0.0) {
- if (Y <= 0.0) {
- ML_math_domain_error(""math__pow"");
- }
- Res = 0.0;
- } else {
- Res = pow(X, Y);
- }
-#else
Res = pow(X, Y);
-#endif
").
-:- pragma foreign_proc("C#", math__pow(X::in, Y::in) = (Res::out),
+:- pragma foreign_proc("C#", math__pow_2(X::in, Y::in) = (Res::out),
[thread_safe], "
-#if ML_OMIT_MATH_DOMAIN_CHECKS
Res = System.Math.Pow(X, Y);
-#else
- if (X < 0.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__pow"");
- }
- if (X == 0.0) {
- if (Y <= 0.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__pow"");
- }
- Res = 0.0;
- } else {
- Res = System.Math.Pow(X, Y);
- }
-#endif
").
@@ -496,24 +467,21 @@
% Domain restrictions:
% X > 0
%
-:- pragma foreign_proc("C", math__ln(X::in) = (Log::out),
+math__ln(X) = Log :-
+ ( domain_checks, X =< 0.0 ->
+ throw(domain_error("math__ln"))
+ ;
+ Log = math__ln_2(X)
+ ).
+
+:- func math__ln_2(float) = float.
+
+:- pragma foreign_proc("C", math__ln_2(X::in) = (Log::out),
[will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X <= 0.0) {
- ML_math_domain_error(""math__ln"");
- }
-#endif
Log = log(X);
").
-:- pragma foreign_proc("C#", math__ln(X::in) = (Log::out),
+:- pragma foreign_proc("C#", math__ln_2(X::in) = (Log::out),
[thread_safe], "
-#if ML_OMIT_MATH_DOMAIN_CHECKS
-#else
- if (X <= 0.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__ln"");
- }
-#endif
Log = System.Math.Log(X);
").
@@ -524,24 +492,21 @@
% Domain restrictions:
% X > 0
%
-:- pragma foreign_proc("C", math__log10(X::in) = (Log10::out),
+math__log10(X) = Log :-
+ ( domain_checks, X =< 0.0 ->
+ throw(domain_error("math__log10"))
+ ;
+ Log = math__log10_2(X)
+ ).
+
+:- func math__log10_2(float) = float.
+
+:- pragma foreign_proc("C", math__log10_2(X::in) = (Log10::out),
[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);
").
-:- pragma foreign_proc("C#", math__log10(X::in) = (Log10::out),
+:- pragma foreign_proc("C#", math__log10_2(X::in) = (Log10::out),
[thread_safe], "
-#if ML_OMIT_MATH_DOMAIN_CHECKS
-#else
- if (X <= 0.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__log10"");
- }
-#endif
Log10 = System.Math.Log10(X);
").
@@ -552,24 +517,21 @@
% Domain restrictions:
% X > 0
%
-:- pragma foreign_proc("C", math__log2(X::in) = (Log2::out),
+math__log2(X) = Log :-
+ ( domain_checks, X =< 0.0 ->
+ throw(domain_error("math__log2"))
+ ;
+ Log = math__log2_2(X)
+ ).
+
+:- func math__log2_2(float) = float.
+
+:- pragma foreign_proc("C", math__log2_2(X::in) = (Log2::out),
[will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X <= 0.0) {
- ML_math_domain_error(""math__log2"");
- }
-#endif
Log2 = log(X) / ML_FLOAT_LN2;
").
-:- pragma foreign_proc("C#", math__log2(X::in) = (Log2::out),
+:- pragma foreign_proc("C#", math__log2_2(X::in) = (Log2::out),
[thread_safe], "
-#if ML_OMIT_MATH_DOMAIN_CHECKS
-#else
- if (X <= 0.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__log2"");
- }
-#endif
Log2 = System.Math.Log(X) / ML_FLOAT_LN2;
").
@@ -582,31 +544,27 @@
% B > 0
% B \= 1
%
-:- pragma foreign_proc("C", math__log(B::in, X::in) = (Log::out),
+math__log(B, X) = Log :-
+ (
+ domain_checks,
+ ( X =< 0.0
+ ; B =< 0.0
+ ; B = 1.0
+ )
+ ->
+ throw(domain_error("math__log"))
+ ;
+ Log = math__log_2(B, X)
+ ).
+
+:- func math__log_2(float, float) = float.
+
+:- pragma foreign_proc("C", math__log_2(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) {
- ML_math_domain_error(""math__log"");
- }
- if (B == 1.0) {
- ML_math_domain_error(""math__log"");
- }
-#endif
Log = log(X)/log(B);
").
-:- pragma foreign_proc("C#", math__log(B::in, X::in) = (Log::out),
+:- pragma foreign_proc("C#", math__log_2(B::in, X::in) = (Log::out),
[thread_safe], "
-#if ML_OMIT_MATH_DOMAIN_CHECKS
-#else
- if (X <= 0.0 || B <= 0.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__log"");
- }
- if (B == 1.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__log"");
- }
-#endif
Log = System.Math.Log(X,B);
").
@@ -655,24 +613,26 @@
% Domain restrictions:
% X must be in the range [-1,1]
%
-:- pragma foreign_proc("C", math__asin(X::in) = (ASin::out),
+math__asin(X) = ASin :-
+ (
+ domain_checks,
+ ( X < -1.0
+ ; X > 1.0
+ )
+ ->
+ throw(domain_error("math__asin"))
+ ;
+ ASin = math__asin_2(X)
+ ).
+
+:- func math__asin_2(float) = float.
+
+:- pragma foreign_proc("C", math__asin_2(X::in) = (ASin::out),
[will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X < -1.0 || X > 1.0) {
- ML_math_domain_error(""math__asin"");
- }
-#endif
ASin = asin(X);
").
-:- pragma foreign_proc("C#", math__asin(X::in) = (ASin::out),
+:- pragma foreign_proc("C#", math__asin_2(X::in) = (ASin::out),
[thread_safe], "
-#if ML_OMIT_MATH_DOMAIN_CHECKS
-#else
- if (X < -1.0 || X > 1.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__asin"");
- }
-#endif
ASin = System.Math.Asin(X);
").
@@ -683,24 +643,26 @@
% Domain restrictions:
% X must be in the range [-1,1]
%
-:- pragma foreign_proc("C", math__acos(X::in) = (ACos::out),
+math__acos(X) = ACos :-
+ (
+ domain_checks,
+ ( X < -1.0
+ ; X > 1.0
+ )
+ ->
+ throw(domain_error("math__acos"))
+ ;
+ ACos = math__acos_2(X)
+ ).
+
+:- func math__acos_2(float) = float.
+
+:- pragma foreign_proc("C", math__acos_2(X::in) = (ACos::out),
[will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X < -1.0 || X > 1.0) {
- ML_math_domain_error(""math__acos"");
- }
-#endif
ACos = acos(X);
").
-:- pragma foreign_proc("C#", math__acos(X::in) = (ACos::out),
+:- pragma foreign_proc("C#", math__acos_2(X::in) = (ACos::out),
[thread_safe], "
-#if ML_OMIT_MATH_DOMAIN_CHECKS
-#else
- if (X < -1.0 || X > 1.0) {
- mercury.math.mercury_code.ML_throw_math_domain_error(
- ""math__acos"");
- }
-#endif
ACos = System.Math.Acos(X);
").
Index: tests/general/float_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/float_test.m,v
retrieving revision 1.5
diff -u -u -r1.5 float_test.m
--- tests/general/float_test.m 1996/11/24 14:30:23 1.5
+++ tests/general/float_test.m 2001/08/29 12:15:21
@@ -33,10 +33,10 @@
test(X, Y) -->
{
- builtin_float_plus(X, Y, Plus),
- builtin_float_times(X, Y, Times),
- builtin_float_minus(X, Y, Minus),
- builtin_float_divide(X, Y, Divide),
+ Plus = X + Y,
+ Times = X * Y,
+ Minus = X - Y,
+ Divide = X / Y,
% math__pow(X, Y, Pow)
true
},
Index: tests/general/string_format_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/string_format_test.m,v
retrieving revision 1.4
diff -u -u -r1.4 string_format_test.m
--- tests/general/string_format_test.m 2000/09/11 12:26:58 1.4
+++ tests/general/string_format_test.m 2001/08/29 12:14:33
@@ -21,7 +21,7 @@
[],
{ Num_nr_1 = 9.9999 } ,
% { builtin_float_times( 2.0, Num_nr_1, Num_nr_2) } ,
- { builtin_float_plus( Num_nr_1, Num_nr_1, Num_nr_2) } ,
+ { Num_nr_2 = Num_nr_1 + Num_nr_1 } ,
[],
{ string__format("First %#x characters of fig% 0.1f in MG are\n`%.*s'.\n", [ i(Numba_0), f(1.4232), i(Numba_0), Mg_poly], String_0) } ,
{ string__format("First %#x characters of fig% 0.1f in MG are\n`%.*s'.\n", [ i(Numba_1), f(1.4232), i(Numba_1), Mg_poly], String_1) } ,
Index: tests/hard_coded/ho_solns.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/ho_solns.m,v
retrieving revision 1.1
diff -u -u -r1.1 ho_solns.m
--- tests/hard_coded/ho_solns.m 1997/01/29 01:10:10 1.1
+++ tests/hard_coded/ho_solns.m 2001/08/29 12:13:09
@@ -52,7 +52,7 @@
:- pred foo(mypred).
:- mode foo(out(mypred)) is multi.
-foo(X) :- X = (pred(A::in, B::in, C::out) is det :- builtin_plus(A, B, C)).
-foo(X) :- X = (pred(A::in, B::in, C::out) is det :- builtin_times(A, B, C)).
-foo(X) :- X = (pred(A::in, B::in, C::out) is det :- builtin_minus(A, B, C)).
+foo(X) :- X = (pred(A::in, B::in, C::out) is det :- C = A + B).
+foo(X) :- X = (pred(A::in, B::in, C::out) is det :- C = A * B).
+foo(X) :- X = (pred(A::in, B::in, C::out) is det :- C = A - B).
Index: tests/hard_coded/ho_univ_to_type.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/ho_univ_to_type.m,v
retrieving revision 1.1
diff -u -u -r1.1 ho_univ_to_type.m
--- tests/hard_coded/ho_univ_to_type.m 1997/02/04 01:35:56 1.1
+++ tests/hard_coded/ho_univ_to_type.m 2001/08/29 12:41:50
@@ -45,7 +45,7 @@
:- pred foo(mypred).
:- mode foo(out(mypred)) is det.
-foo(X) :- X = (pred(A::in, B::in, C::out) is det :- builtin_plus(A, B, C)).
+foo(X) :- X = (pred(A::in, B::in, C::out) is det :- C = A + B).
% Some hacky pragma c_code to allow use to change an
% inst from `ground' to `pred(in, in, out) is det'.
Index: tests/hard_coded/qual_strang.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/qual_strang.m,v
retrieving revision 1.4
diff -u -u -r1.4 qual_strang.m
--- tests/hard_coded/qual_strang.m 1997/02/23 06:11:55 1.4
+++ tests/hard_coded/qual_strang.m 2001/08/29 12:09:04
@@ -123,8 +123,8 @@
int__pow(10, Precision, P),
int__to_float(P, Pe),
(
- builtin_float_gt(Ft, 0.0001),
- builtin_float_gt(Pe, Ft)
+ Ft > 0.0001,
+ Pe > Ft
->
Conv_c_out = 'f'
;
@@ -140,8 +140,8 @@
int__pow(10, Precision, P),
int__to_float(P, Pe),
(
- builtin_float_gt(Ft, 0.0001),
- builtin_float_gt(Pe, Ft)
+ Ft > 0.0001,
+ Pe > Ft
->
Conv_c_out = 'f'
;
@@ -333,18 +333,18 @@
Poly_t = f(F),
float_to_string(F, Fstring),
format_calc_prec(Fstring, Ostring, Precision),
- (builtin_float_lt(F, 0.0)-> Mv_width = 1 ; Mv_width = 0)
+ ( F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
;
Conv_c = 'e',
Poly_t = f(F),
format_calc_exp(F, Ostring, Precision, 0),
- (builtin_float_lt(F, 0.0)-> Mv_width = 1 ; Mv_width = 0)
+ ( F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
;
Conv_c = 'E' ,
Poly_t = f(F),
format_calc_exp(F, Otemp, Precision, 0),
to_upper(Otemp, Ostring),
- (builtin_float_lt(F, 0.0)-> Mv_width = 1 ; Mv_width = 0)
+ ( F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
;
Conv_c = 'p' ,
Poly_t = i(I),
@@ -399,19 +399,19 @@
:- pred format_calc_exp(float, string, int, int).
:- mode format_calc_exp(in, out, in, in) is det.
format_calc_exp(F, Fstring, Precision, Exp) :-
- ( builtin_float_lt(F, 0.0) ->
- builtin_float_minus( 0.0, F, Tf),
+ ( F < 0.0 ->
+ Tf = 0.0 - F,
format_calc_exp( Tf, Tst, Precision, Exp),
first_char(Fstring, '-', Tst)
;
- ( builtin_float_lt(F, 1.0) ->
+ ( F < 1.0 ->
Texp is Exp - 1,
- builtin_float_times(F, 10.0, FF),
+ FF = F * 10.0,
format_calc_exp( FF, Fstring, Precision, Texp)
;
- ( builtin_float_ge(F, 10.0) ->
+ ( F >= 10.0 ->
Texp is Exp + 1,
- builtin_float_divide(F, 10.0, FF),
+ FF = F / 10.0,
format_calc_exp( FF, Fstring, Precision, Texp)
;
float_to_string(F, Fs),
@@ -729,8 +729,8 @@
:- pred float_abs(float, float).
:- mode float_abs(in, out) is det.
float_abs(Fin, Fout) :-
- ( builtin_float_lt(Fin, 0.0) ->
- builtin_float_minus(0.0, Fin, Fout)
+ ( Fin < 0.0 ->
+ Fout = 0.0 - Fin
;
Fout = Fin
).
Index: tests/hard_coded/qual_strung.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/qual_strung.m,v
retrieving revision 1.4
diff -u -u -r1.4 qual_strung.m
--- tests/hard_coded/qual_strung.m 1997/02/23 06:11:57 1.4
+++ tests/hard_coded/qual_strung.m 2001/08/29 12:41:11
@@ -125,8 +125,8 @@
int__pow(10, Precision, P),
int__to_float(P, Pe),
(
- builtin_float_gt(Ft, 0.0001),
- builtin_float_gt(Pe, Ft)
+ Ft > 0.0001,
+ Pe > Ft
->
Conv_c_out = 'f'
;
@@ -142,8 +142,8 @@
int__pow(10, Precision, P),
int__to_float(P, Pe),
(
- builtin_float_gt(Ft, 0.0001),
- builtin_float_gt(Pe, Ft)
+ Ft > 0.0001,
+ Pe > Ft
->
Conv_c_out = 'f'
;
@@ -334,18 +334,18 @@
Poly_t = f(F),
float_to_string(F, Fstring),
format_calc_prec(Fstring, Ostring, Precision),
- (builtin_float_lt(F, 0.0)-> Mv_width = 1 ; Mv_width = 0)
+ (F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
;
Conv_c = 'e',
Poly_t = f(F),
format_calc_exp(F, Ostring, Precision, 0),
- (builtin_float_lt(F, 0.0)-> Mv_width = 1 ; Mv_width = 0)
+ (F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
;
Conv_c = 'E' ,
Poly_t = f(F),
format_calc_exp(F, Otemp, Precision, 0),
to_upper(Otemp, Ostring),
- (builtin_float_lt(F, 0.0)-> Mv_width = 1 ; Mv_width = 0)
+ (F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
;
Conv_c = 'p' ,
Poly_t = i(I),
@@ -400,19 +400,19 @@
:- pred format_calc_exp(float, string, int, int).
:- mode format_calc_exp(in, out, in, in) is det.
format_calc_exp(F, Fstring, Precision, Exp) :-
- ( builtin_float_lt(F, 0.0) ->
- builtin_float_minus( 0.0, F, Tf),
+ ( F < 0.0 ->
+ Tf = 0.0 - F,
format_calc_exp( Tf, Tst, Precision, Exp),
first_char(Fstring, '-', Tst)
;
- ( builtin_float_lt(F, 1.0) ->
+ ( F < 1.0 ->
Texp is Exp - 1,
- builtin_float_times(F, 10.0, FF),
+ FF = F * 10.0,
format_calc_exp( FF, Fstring, Precision, Texp)
;
- ( builtin_float_ge(F, 10.0) ->
+ ( F >= 10.0 ->
Texp is Exp + 1,
- builtin_float_divide(F, 10.0, FF),
+ FF = F / 10.0,
format_calc_exp( FF, Fstring, Precision, Texp)
;
float_to_string(F, Fs),
@@ -730,8 +730,8 @@
:- pred float_abs(float, float).
:- mode float_abs(in, out) is det.
float_abs(Fin, Fout) :-
- ( builtin_float_lt(Fin, 0.0) ->
- builtin_float_minus(0.0, Fin, Fout)
+ ( Fin < 0.0 ->
+ Fout = 0.0 - Fin
;
Fout = Fin
).
--------------------------------------------------------------------------
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