2016-02-18 07:11:59 -08:00
|
|
|
/**************************************************************************/
|
|
|
|
/* */
|
|
|
|
/* OCaml */
|
|
|
|
/* */
|
|
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
|
|
/* */
|
|
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
|
|
/* en Automatique. */
|
|
|
|
/* */
|
|
|
|
/* All rights reserved. This file is distributed under the terms of */
|
|
|
|
/* the GNU Lesser General Public License version 2.1, with the */
|
|
|
|
/* special exception on linking described in the file LICENSE. */
|
|
|
|
/* */
|
|
|
|
/**************************************************************************/
|
1995-08-09 08:06:35 -07:00
|
|
|
|
2016-07-04 10:00:57 -07:00
|
|
|
#define CAML_INTERNALS
|
|
|
|
|
2000-11-13 06:51:01 -08:00
|
|
|
#include <string.h>
|
|
|
|
#include <stdlib.h>
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/custom.h"
|
|
|
|
#include "caml/fail.h"
|
|
|
|
#include "caml/memory.h"
|
|
|
|
#include "caml/misc.h"
|
|
|
|
#include "caml/mlvalues.h"
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2000-11-13 06:51:01 -08:00
|
|
|
/* Structural comparison on trees. */
|
|
|
|
|
|
|
|
struct compare_item { value * v1, * v2; mlsize_t count; };
|
|
|
|
|
2017-03-15 01:51:00 -07:00
|
|
|
#define COMPARE_STACK_INIT_SIZE 8
|
|
|
|
#define COMPARE_STACK_MIN_ALLOC_SIZE 32
|
2001-08-13 06:53:51 -07:00
|
|
|
#define COMPARE_STACK_MAX_SIZE (1024*1024)
|
2003-11-21 07:55:47 -08:00
|
|
|
|
2017-03-15 01:51:00 -07:00
|
|
|
struct compare_stack {
|
|
|
|
struct compare_item init_stack[COMPARE_STACK_INIT_SIZE];
|
|
|
|
struct compare_item* stack;
|
|
|
|
struct compare_item* limit;
|
|
|
|
};
|
|
|
|
|
2000-11-13 06:51:01 -08:00
|
|
|
/* Free the compare stack if needed */
|
2017-03-15 01:51:00 -07:00
|
|
|
static void compare_free_stack(struct compare_stack* stk)
|
2000-11-13 06:51:01 -08:00
|
|
|
{
|
2017-03-15 01:51:00 -07:00
|
|
|
if (stk->stack != stk->init_stack) {
|
2014-05-28 16:11:47 -07:00
|
|
|
caml_stat_free(stk->stack);
|
2017-03-16 06:01:12 -07:00
|
|
|
stk->stack = NULL;
|
2000-11-13 06:51:01 -08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2001-02-13 01:29:08 -08:00
|
|
|
/* Same, then raise Out_of_memory */
|
Cleaning up the C code (#1812)
Running Clang 6.0 and GCC 8 with full warnings on suggests a few simple improvements and clean-ups to the C code of OCaml. This commit implements them.
* Remove old-style, unprototyped function declarations
It's `int f(void)`, not `int f()`. [-Wstrict-prototypes]
* Be more explicit about conversions involving `float` and `double`
byterun/bigarray.c, byterun/ints.c:
add explicit casts to clarify the intent
renamed float field of conversion union from `d` to `f`.
byterun/compact.c, byterun/gc_ctrl.c:
some local variables were of type `float` while all FP computations
here are done in double precision;
turned these variables into `double`.
[-Wdouble-promotion -Wfloat-conversion]
*Add explicit initialization of struct field `compare_ext`
[-Wmissing-field-initializers]
* Declare more functions "noreturn"
[-Wmissing-noreturn]
* Make CAMLassert compliant with ISO C
In `e1 ? e2 : e3`, expressions `e2` and `e3` must have the same type.
`e2` of type `void` and `e3` of type `int`, as in the original code,
is a GNU extension.
* Remove or conditionalize unused macros
Some macros were defined and never used.
Some other macros were always defined but conditionally used.
[-Wunused-macros]
* Replace some uses of `int` by more appropriate types like `intnat`
On a 64-bit platform, `int` is only 32 bits and may not represent correctly
the length of a string or the size of an OCaml heap block.
This commit replaces a number of uses of `int` by other types that
are 64-bit wide on 64-bit architectures, such as `intnat` or `uintnat`
or `size_t` or `mlsize_t`.
Sometimes an `intnat` was used as an `int` and is intended as a Boolean
(0 or 1); then it was replaced by an `int`.
There are many remaining cases where we assign a 64-bit quantity to a
32-bit `int` variable. Either I believe these cases are safe
(e.g. the 64-bit quantity is the difference between two pointers
within an I/O buffer, something that always fits in 32 bits), or
the code change was not obvious and too risky.
[-Wshorten-64-to-32]
* Put `inline` before return type
`static inline void f(void)` is cleaner than `static void inline f(void)`.
[-Wold-style-declaration]
* Unused assignment to unused parameter
Looks very useless. [-Wunused-but-set-parameter]
2018-06-07 03:55:09 -07:00
|
|
|
CAMLnoreturn_start
|
|
|
|
static void compare_stack_overflow(struct compare_stack* stk)
|
|
|
|
CAMLnoreturn_end;
|
|
|
|
|
2017-03-15 01:51:00 -07:00
|
|
|
static void compare_stack_overflow(struct compare_stack* stk)
|
2000-11-13 06:51:01 -08:00
|
|
|
{
|
2017-02-27 08:32:44 -08:00
|
|
|
caml_gc_message (0x04, "Stack overflow in structural comparison\n");
|
2017-03-15 01:51:00 -07:00
|
|
|
compare_free_stack(stk);
|
2004-01-01 08:42:43 -08:00
|
|
|
caml_raise_out_of_memory();
|
2000-11-13 06:51:01 -08:00
|
|
|
}
|
|
|
|
|
|
|
|
/* Grow the compare stack */
|
2017-03-15 01:51:00 -07:00
|
|
|
static struct compare_item * compare_resize_stack(struct compare_stack* stk,
|
|
|
|
struct compare_item * sp)
|
2000-11-13 06:51:01 -08:00
|
|
|
{
|
2017-03-15 01:51:00 -07:00
|
|
|
asize_t newsize;
|
|
|
|
asize_t sp_offset = sp - stk->stack;
|
2000-11-13 06:51:01 -08:00
|
|
|
struct compare_item * newstack;
|
|
|
|
|
2017-03-15 01:51:00 -07:00
|
|
|
if (stk->stack == stk->init_stack) {
|
|
|
|
newsize = COMPARE_STACK_MIN_ALLOC_SIZE;
|
2014-05-28 16:11:47 -07:00
|
|
|
newstack = caml_stat_alloc_noexc(sizeof(struct compare_item) * newsize);
|
2017-03-15 01:51:00 -07:00
|
|
|
if (newstack == NULL) compare_stack_overflow(stk);
|
|
|
|
memcpy(newstack, stk->init_stack,
|
2000-11-13 06:51:01 -08:00
|
|
|
sizeof(struct compare_item) * COMPARE_STACK_INIT_SIZE);
|
|
|
|
} else {
|
2017-03-15 01:51:00 -07:00
|
|
|
newsize = 2 * (stk->limit - stk->stack);
|
|
|
|
if (newsize >= COMPARE_STACK_MAX_SIZE) compare_stack_overflow(stk);
|
2014-05-28 16:11:47 -07:00
|
|
|
newstack = caml_stat_resize_noexc(stk->stack,
|
|
|
|
sizeof(struct compare_item) * newsize);
|
2017-03-15 01:51:00 -07:00
|
|
|
if (newstack == NULL) compare_stack_overflow(stk);
|
2000-11-13 06:51:01 -08:00
|
|
|
}
|
2017-03-15 01:51:00 -07:00
|
|
|
stk->stack = newstack;
|
|
|
|
stk->limit = newstack + newsize;
|
2000-11-13 06:51:01 -08:00
|
|
|
return newstack + sp_offset;
|
|
|
|
}
|
|
|
|
|
2017-03-15 01:51:00 -07:00
|
|
|
|
|
|
|
static intnat do_compare_val(struct compare_stack* stk,
|
|
|
|
value v1, value v2, int total);
|
|
|
|
|
|
|
|
static intnat compare_val(value v1, value v2, int total)
|
|
|
|
{
|
|
|
|
struct compare_stack stk;
|
|
|
|
intnat res;
|
|
|
|
stk.stack = stk.init_stack;
|
|
|
|
stk.limit = stk.stack + COMPARE_STACK_INIT_SIZE;
|
|
|
|
res = do_compare_val(&stk, v1, v2, total);
|
|
|
|
compare_free_stack(&stk);
|
|
|
|
return res;
|
|
|
|
}
|
|
|
|
|
2000-11-13 06:51:01 -08:00
|
|
|
/* Structural comparison */
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2017-03-15 01:51:00 -07:00
|
|
|
|
2003-11-21 07:55:47 -08:00
|
|
|
#define LESS -1
|
|
|
|
#define EQUAL 0
|
|
|
|
#define GREATER 1
|
2006-05-04 05:41:26 -07:00
|
|
|
#define UNORDERED ((intnat)1 << (8 * sizeof(value) - 1))
|
2003-11-21 07:55:47 -08:00
|
|
|
|
|
|
|
/* The return value of compare_val is as follows:
|
|
|
|
> 0 v1 is greater than v2
|
|
|
|
0 v1 is equal to v2
|
|
|
|
< 0 and > UNORDERED v1 is less than v2
|
|
|
|
UNORDERED v1 and v2 cannot be compared */
|
|
|
|
|
2017-03-15 01:51:00 -07:00
|
|
|
static intnat do_compare_val(struct compare_stack* stk,
|
|
|
|
value v1, value v2, int total)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2000-11-13 06:51:01 -08:00
|
|
|
struct compare_item * sp;
|
1995-05-04 03:15:53 -07:00
|
|
|
tag_t t1, t2;
|
|
|
|
|
2017-03-15 01:51:00 -07:00
|
|
|
sp = stk->stack;
|
2000-11-13 06:51:01 -08:00
|
|
|
while (1) {
|
2003-11-21 07:55:47 -08:00
|
|
|
if (v1 == v2 && total) goto next_item;
|
2000-11-13 06:51:01 -08:00
|
|
|
if (Is_long(v1)) {
|
2003-11-21 07:55:47 -08:00
|
|
|
if (v1 == v2) goto next_item;
|
2000-11-13 06:51:01 -08:00
|
|
|
if (Is_long(v2))
|
|
|
|
return Long_val(v1) - Long_val(v2);
|
2003-11-21 07:55:47 -08:00
|
|
|
/* Subtraction above cannot overflow and cannot result in UNORDERED */
|
2018-09-30 10:08:40 -07:00
|
|
|
if (!Is_in_value_area(v2))
|
|
|
|
return LESS;
|
2020-06-21 02:54:04 -07:00
|
|
|
switch (Tag_val(v2)) {
|
2012-01-26 06:13:51 -08:00
|
|
|
case Forward_tag:
|
2011-07-20 02:17:07 -07:00
|
|
|
v2 = Forward_val(v2);
|
|
|
|
continue;
|
|
|
|
case Custom_tag: {
|
|
|
|
int res;
|
|
|
|
int (*compare)(value v1, value v2) = Custom_ops_val(v2)->compare_ext;
|
|
|
|
if (compare == NULL) break; /* for backward compatibility */
|
2019-06-09 10:37:42 -07:00
|
|
|
Caml_state->compare_unordered = 0;
|
2011-07-20 02:17:07 -07:00
|
|
|
res = compare(v1, v2);
|
2019-06-09 10:37:42 -07:00
|
|
|
if (Caml_state->compare_unordered && !total) return UNORDERED;
|
2011-07-20 02:17:07 -07:00
|
|
|
if (res != 0) return res;
|
|
|
|
goto next_item;
|
|
|
|
}
|
|
|
|
default: /*fallthrough*/;
|
|
|
|
}
|
2003-11-21 07:55:47 -08:00
|
|
|
return LESS; /* v1 long < v2 block */
|
2002-03-07 05:46:07 -08:00
|
|
|
}
|
|
|
|
if (Is_long(v2)) {
|
2018-09-30 10:08:40 -07:00
|
|
|
if (!Is_in_value_area(v1))
|
|
|
|
return GREATER;
|
2020-06-21 02:54:04 -07:00
|
|
|
switch (Tag_val(v1)) {
|
2011-07-20 02:17:07 -07:00
|
|
|
case Forward_tag:
|
|
|
|
v1 = Forward_val(v1);
|
|
|
|
continue;
|
|
|
|
case Custom_tag: {
|
|
|
|
int res;
|
|
|
|
int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare_ext;
|
|
|
|
if (compare == NULL) break; /* for backward compatibility */
|
2019-06-09 10:37:42 -07:00
|
|
|
Caml_state->compare_unordered = 0;
|
2011-07-20 02:17:07 -07:00
|
|
|
res = compare(v1, v2);
|
2019-06-09 10:37:42 -07:00
|
|
|
if (Caml_state->compare_unordered && !total) return UNORDERED;
|
2011-07-20 02:17:07 -07:00
|
|
|
if (res != 0) return res;
|
|
|
|
goto next_item;
|
|
|
|
}
|
|
|
|
default: /*fallthrough*/;
|
|
|
|
}
|
2003-11-21 07:55:47 -08:00
|
|
|
return GREATER; /* v1 block > v2 long */
|
2000-11-13 06:51:01 -08:00
|
|
|
}
|
|
|
|
/* If one of the objects is outside the heap (but is not an atom),
|
|
|
|
use address comparison. Since both addresses are 2-aligned,
|
|
|
|
shift lsb off to avoid overflow in subtraction. */
|
2008-01-03 01:37:10 -08:00
|
|
|
if (! Is_in_value_area(v1) || ! Is_in_value_area(v2)) {
|
2003-11-21 07:55:47 -08:00
|
|
|
if (v1 == v2) goto next_item;
|
1996-10-09 04:14:11 -07:00
|
|
|
return (v1 >> 1) - (v2 >> 1);
|
2003-11-21 07:55:47 -08:00
|
|
|
/* Subtraction above cannot result in UNORDERED */
|
|
|
|
}
|
2000-11-13 06:51:01 -08:00
|
|
|
t1 = Tag_val(v1);
|
|
|
|
t2 = Tag_val(v2);
|
2020-05-02 23:32:48 -07:00
|
|
|
if (t1 != t2) {
|
|
|
|
/* Besides long/block comparisons, the only forms of
|
|
|
|
heterogeneous comparisons we support are:
|
|
|
|
- Forward_tag pointers, which may point to values of any type, and
|
|
|
|
- comparing Infix_tag and Closure_tag functions (#9521).
|
|
|
|
|
|
|
|
Other heterogeneous cases may still happen due to
|
|
|
|
existential types, and we just compare the tags.
|
|
|
|
*/
|
|
|
|
if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; }
|
|
|
|
if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; }
|
|
|
|
if (t1 == Infix_tag) t1 = Closure_tag;
|
|
|
|
if (t2 == Infix_tag) t2 = Closure_tag;
|
|
|
|
if (t1 != t2)
|
|
|
|
return (intnat)t1 - (intnat)t2;
|
|
|
|
}
|
2000-11-13 06:51:01 -08:00
|
|
|
switch(t1) {
|
2020-05-02 23:32:48 -07:00
|
|
|
case Forward_tag: {
|
|
|
|
v1 = Forward_val (v1);
|
|
|
|
v2 = Forward_val (v2);
|
|
|
|
continue;
|
|
|
|
}
|
2000-11-13 06:51:01 -08:00
|
|
|
case String_tag: {
|
2011-07-20 02:17:07 -07:00
|
|
|
mlsize_t len1, len2;
|
|
|
|
int res;
|
2003-11-21 07:55:47 -08:00
|
|
|
if (v1 == v2) break;
|
2003-12-16 10:09:44 -08:00
|
|
|
len1 = caml_string_length(v1);
|
|
|
|
len2 = caml_string_length(v2);
|
2011-07-20 02:17:07 -07:00
|
|
|
res = memcmp(String_val(v1), String_val(v2), len1 <= len2 ? len1 : len2);
|
|
|
|
if (res < 0) return LESS;
|
|
|
|
if (res > 0) return GREATER;
|
2000-11-13 06:51:01 -08:00
|
|
|
if (len1 != len2) return len1 - len2;
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
case Double_tag: {
|
|
|
|
double d1 = Double_val(v1);
|
|
|
|
double d2 = Double_val(v2);
|
2003-11-21 07:55:47 -08:00
|
|
|
if (d1 < d2) return LESS;
|
|
|
|
if (d1 > d2) return GREATER;
|
|
|
|
if (d1 != d2) {
|
|
|
|
if (! total) return UNORDERED;
|
|
|
|
/* One or both of d1 and d2 is NaN. Order according to the
|
|
|
|
convention NaN = NaN and NaN < f for all other floats f. */
|
|
|
|
if (d1 == d1) return GREATER; /* d1 is not NaN, d2 is NaN */
|
|
|
|
if (d2 == d2) return LESS; /* d2 is not NaN, d1 is NaN */
|
|
|
|
/* d1 and d2 are both NaN, thus equal: continue comparison */
|
|
|
|
}
|
2000-11-13 06:51:01 -08:00
|
|
|
break;
|
1995-07-27 10:41:09 -07:00
|
|
|
}
|
2000-11-13 06:51:01 -08:00
|
|
|
case Double_array_tag: {
|
|
|
|
mlsize_t sz1 = Wosize_val(v1) / Double_wosize;
|
|
|
|
mlsize_t sz2 = Wosize_val(v2) / Double_wosize;
|
|
|
|
mlsize_t i;
|
|
|
|
if (sz1 != sz2) return sz1 - sz2;
|
|
|
|
for (i = 0; i < sz1; i++) {
|
2017-08-31 06:25:15 -07:00
|
|
|
double d1 = Double_flat_field(v1, i);
|
|
|
|
double d2 = Double_flat_field(v2, i);
|
2003-11-21 07:55:47 -08:00
|
|
|
if (d1 < d2) return LESS;
|
|
|
|
if (d1 > d2) return GREATER;
|
|
|
|
if (d1 != d2) {
|
|
|
|
if (! total) return UNORDERED;
|
|
|
|
/* See comment for Double_tag case */
|
|
|
|
if (d1 == d1) return GREATER;
|
|
|
|
if (d2 == d2) return LESS;
|
|
|
|
}
|
2000-11-13 06:51:01 -08:00
|
|
|
}
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
case Abstract_tag:
|
2017-03-15 01:51:00 -07:00
|
|
|
compare_free_stack(stk);
|
2015-01-16 13:50:24 -08:00
|
|
|
caml_invalid_argument("compare: abstract value");
|
2000-11-13 06:51:01 -08:00
|
|
|
case Closure_tag:
|
2020-05-02 23:32:48 -07:00
|
|
|
case Infix_tag:
|
2017-03-15 01:51:00 -07:00
|
|
|
compare_free_stack(stk);
|
2015-01-16 13:50:24 -08:00
|
|
|
caml_invalid_argument("compare: functional value");
|
2000-11-13 06:51:01 -08:00
|
|
|
case Object_tag: {
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat oid1 = Oid_val(v1);
|
|
|
|
intnat oid2 = Oid_val(v2);
|
2000-11-13 06:51:01 -08:00
|
|
|
if (oid1 != oid2) return oid1 - oid2;
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
case Custom_tag: {
|
2002-06-07 02:49:45 -07:00
|
|
|
int res;
|
|
|
|
int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare;
|
2011-07-20 02:17:07 -07:00
|
|
|
/* Hardening against comparisons between different types */
|
|
|
|
if (compare != Custom_ops_val(v2)->compare) {
|
|
|
|
return strcmp(Custom_ops_val(v1)->identifier,
|
|
|
|
Custom_ops_val(v2)->identifier) < 0
|
|
|
|
? LESS : GREATER;
|
|
|
|
}
|
2007-02-09 05:31:15 -08:00
|
|
|
if (compare == NULL) {
|
2017-03-15 01:51:00 -07:00
|
|
|
compare_free_stack(stk);
|
2015-01-16 13:50:24 -08:00
|
|
|
caml_invalid_argument("compare: abstract value");
|
2007-02-09 05:31:15 -08:00
|
|
|
}
|
2019-06-09 10:37:42 -07:00
|
|
|
Caml_state->compare_unordered = 0;
|
2011-07-20 02:17:07 -07:00
|
|
|
res = compare(v1, v2);
|
2019-06-09 10:37:42 -07:00
|
|
|
if (Caml_state->compare_unordered && !total) return UNORDERED;
|
1995-05-04 03:15:53 -07:00
|
|
|
if (res != 0) return res;
|
2000-11-13 06:51:01 -08:00
|
|
|
break;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
2000-11-13 06:51:01 -08:00
|
|
|
default: {
|
|
|
|
mlsize_t sz1 = Wosize_val(v1);
|
|
|
|
mlsize_t sz2 = Wosize_val(v2);
|
|
|
|
/* Compare sizes first for speed */
|
|
|
|
if (sz1 != sz2) return sz1 - sz2;
|
|
|
|
if (sz1 == 0) break;
|
|
|
|
/* Remember that we still have to compare fields 1 ... sz - 1 */
|
|
|
|
if (sz1 > 1) {
|
|
|
|
sp++;
|
2017-03-15 01:51:00 -07:00
|
|
|
if (sp >= stk->limit) sp = compare_resize_stack(stk, sp);
|
2000-11-13 06:51:01 -08:00
|
|
|
sp->v1 = &Field(v1, 1);
|
|
|
|
sp->v2 = &Field(v2, 1);
|
|
|
|
sp->count = sz1 - 1;
|
|
|
|
}
|
|
|
|
/* Continue comparison with first field */
|
|
|
|
v1 = Field(v1, 0);
|
|
|
|
v2 = Field(v2, 0);
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
next_item:
|
|
|
|
/* Pop one more item to compare, if any */
|
2017-03-15 01:51:00 -07:00
|
|
|
if (sp == stk->stack) return EQUAL; /* we're done */
|
2003-11-21 07:55:47 -08:00
|
|
|
v1 = *((sp->v1)++);
|
|
|
|
v2 = *((sp->v2)++);
|
2000-11-13 06:51:01 -08:00
|
|
|
if (--(sp->count) == 0) sp--;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2003-12-31 06:20:40 -08:00
|
|
|
CAMLprim value caml_compare(value v1, value v2)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat res = compare_val(v1, v2, 1);
|
2000-11-13 06:51:01 -08:00
|
|
|
/* Free stack if needed */
|
2003-11-21 07:55:47 -08:00
|
|
|
if (res < 0)
|
|
|
|
return Val_int(LESS);
|
1996-10-09 04:14:11 -07:00
|
|
|
else if (res > 0)
|
2003-11-21 07:55:47 -08:00
|
|
|
return Val_int(GREATER);
|
1996-10-09 04:14:11 -07:00
|
|
|
else
|
2003-11-21 07:55:47 -08:00
|
|
|
return Val_int(EQUAL);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2003-12-31 06:20:40 -08:00
|
|
|
CAMLprim value caml_equal(value v1, value v2)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat res = compare_val(v1, v2, 0);
|
2000-11-13 06:51:01 -08:00
|
|
|
return Val_int(res == 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2003-12-31 06:20:40 -08:00
|
|
|
CAMLprim value caml_notequal(value v1, value v2)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat res = compare_val(v1, v2, 0);
|
2000-11-13 06:51:01 -08:00
|
|
|
return Val_int(res != 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2003-12-31 06:20:40 -08:00
|
|
|
CAMLprim value caml_lessthan(value v1, value v2)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat res = compare_val(v1, v2, 0);
|
2008-01-11 08:13:18 -08:00
|
|
|
return Val_int(res < 0 && res != UNORDERED);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2003-12-31 06:20:40 -08:00
|
|
|
CAMLprim value caml_lessequal(value v1, value v2)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat res = compare_val(v1, v2, 0);
|
2008-01-11 08:13:18 -08:00
|
|
|
return Val_int(res <= 0 && res != UNORDERED);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2003-12-31 06:20:40 -08:00
|
|
|
CAMLprim value caml_greaterthan(value v1, value v2)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat res = compare_val(v1, v2, 0);
|
2000-11-13 06:51:01 -08:00
|
|
|
return Val_int(res > 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2003-12-31 06:20:40 -08:00
|
|
|
CAMLprim value caml_greaterequal(value v1, value v2)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat res = compare_val(v1, v2, 0);
|
2000-11-13 06:51:01 -08:00
|
|
|
return Val_int(res >= 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|