This is num_comp.c in view mode; [Download] [Up]
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
/*
Comparisons on numbers
*/
#include "include.h"
#include "num_include.h"
#include "mp.h"
/*
The value of number_compare(x, y) is
-1 if x < y
0 if x = y
1 if x > y.
If x or y is complex, 0 or 1 is returned.
*/
int
number_compare(x, y)
object x, y;
{
int i;
double dx, dy;
vs_mark;
switch (type_of(x)) {
case t_fixnum:
switch (type_of(y)) {
case t_fixnum:
if (fix(x) < fix(y))
return(-1);
else if (fix(x) == fix(y))
return(0);
else
return(1);
case t_bignum:
i = big_sign(y);
if (i < 0)
return(1);
else
return(-1);
case t_ratio:
x = number_times(x, y->rat.rat_den);
y = y->rat.rat_num;
vs_push(x);
i = number_compare(x, y);
vs_reset;
return(i);
case t_shortfloat:
dx = (double)(fix(x));
dy = (double)(sf(y));
goto LONGFLOAT;
case t_longfloat:
dx = (double)(fix(x));
dy = lf(y);
goto LONGFLOAT;
case t_complex:
goto Y_COMPLEX;
default:
wrong_type_argument(Snumber, y);
}
case t_bignum:
switch (type_of(y)) {
case t_fixnum:
i = big_sign(x);
if (i < 0)
return(-1);
else
return(1);
case t_bignum:
return cmpii(MP(x),MP(y));
case t_ratio:
x = number_times(x, y->rat.rat_den);
y = y->rat.rat_num;
vs_push(x);
i = number_compare(x, y);
vs_reset;
return(i);
case t_shortfloat:
dx = number_to_double(x);
dy = (double)(sf(y));
goto LONGFLOAT;
case t_longfloat:
dx = number_to_double(x);
dy = lf(y);
goto LONGFLOAT;
case t_complex:
goto Y_COMPLEX;
default:
wrong_type_argument(Snumber, y);
}
case t_ratio:
switch (type_of(y)) {
case t_fixnum:
case t_bignum:
y = number_times(y, x->rat.rat_den);
x = x->rat.rat_num;
vs_push(y);
i = number_compare(x, y);
vs_reset;
return(i);
case t_ratio:
vs_push(number_times(x->rat.rat_num,y->rat.rat_den));
vs_push(number_times(y->rat.rat_num,x->rat.rat_den));
i = number_compare(vs_top[-2], vs_top[-1]);
vs_reset;
return(i);
case t_shortfloat:
dx = number_to_double(x);
dy = (double)(sf(y));
goto LONGFLOAT;
case t_longfloat:
dx = number_to_double(x);
dy = lf(y);
goto LONGFLOAT;
case t_complex:
goto Y_COMPLEX;
default:
wrong_type_argument(Snumber, y);
}
case t_shortfloat:
dx = (double)(sf(x));
goto LONGFLOAT0;
case t_longfloat:
dx = lf(x);
LONGFLOAT0:
switch (type_of(y)) {
case t_fixnum:
dy = (double)(fix(y));
goto LONGFLOAT;
case t_bignum:
case t_ratio:
dy = number_to_double(y);
goto LONGFLOAT;
case t_shortfloat:
dy = (double)(sf(y));
goto LONGFLOAT;
case t_longfloat:
dy = lf(y);
goto LONGFLOAT;
case t_complex:
goto Y_COMPLEX;
}
LONGFLOAT:
if (dx == dy)
return(0);
else if (dx < dy)
return(-1);
else
return(1);
Y_COMPLEX:
if (number_zerop(y->cmp.cmp_imag))
if (number_compare(x, y->cmp.cmp_real) == 0)
return(0);
else
return(1);
else
return(1);
case t_complex:
if (type_of(y) != t_complex)
if (number_zerop(x->cmp.cmp_imag))
if (number_compare(x->cmp.cmp_real, y) == 0)
return(0);
else
return(1);
else
return(1);
if (number_compare(x->cmp.cmp_real, y->cmp.cmp_real) == 0 &&
number_compare(x->cmp.cmp_imag, y->cmp.cmp_imag) == 0 )
return(0);
else
return(1);
default:
FEwrong_type_argument(Snumber, x);
}
}
Lall_the_same()
{
int narg, i;
narg = vs_top - vs_base;
if (narg == 0)
too_few_arguments();
for (i = 0; i < narg; i++)
check_type_number(&vs_base[i]);
for (i = 1; i < narg; i++)
if (number_compare(vs_base[i-1], vs_base[i]) != 0) {
vs_top = vs_base+1;
vs_base[0] = Cnil;
return;
}
vs_top = vs_base+1;
vs_base[0] = Ct;
}
Lall_different()
{
int narg, i, j;
narg = vs_top - vs_base;
if (narg == 0)
too_few_arguments();
else if (narg == 1) {
vs_base[0] = Ct;
return;
}
for (i = 0; i < narg; i++)
check_type_number(&vs_base[i]);
for(i = 1; i < narg; i++)
for(j = 0; j < i; j++)
if (number_compare(vs_base[j], vs_base[i]) == 0) {
vs_top = vs_base+1;
vs_base[0] = Cnil;
return;
}
vs_top = vs_base+1;
vs_base[0] = Ct;
}
Lnumber_compare(s, t)
int s, t;
{
int narg, i;
narg = vs_top - vs_base;
if (narg == 0)
too_few_arguments();
for (i = 0; i < narg; i++)
check_type_or_rational_float(&vs_base[i]);
for (i = 1; i < narg; i++)
if (s*number_compare(vs_base[i], vs_base[i-1]) < t) {
vs_top = vs_base+1;
vs_base[0] = Cnil;
return;
}
vs_top = vs_base+1;
vs_base[0] = Ct;
}
Lmonotonically_increasing() { Lnumber_compare( 1, 1); }
Lmonotonically_decreasing() { Lnumber_compare(-1, 1); }
Lmonotonically_nondecreasing() { Lnumber_compare( 1, 0); }
Lmonotonically_nonincreasing() { Lnumber_compare(-1, 0); }
Lmax()
{
object max;
int narg, i;
narg = vs_top - vs_base;
if (narg == 0)
too_few_arguments();
for (i = 0; i < narg; i++)
check_type_or_rational_float(&vs_base[i]);
for (i = 1, max = vs_base[0]; i < narg; i++)
if (number_compare(max, vs_base[i]) < 0)
max = vs_base[i];
vs_top = vs_base+1;
vs_base[0] = max;
}
Lmin()
{
object min;
int narg, i;
narg = vs_top - vs_base;
if (narg == 0)
too_few_arguments();
for (i = 0; i < narg; i++)
check_type_or_rational_float(&vs_base[i]);
for (i = 1, min = vs_base[0]; i < narg; i++)
if (number_compare(min, vs_base[i]) > 0)
min = vs_base[i];
vs_top = vs_base+1;
vs_base[0] = min;
}
init_num_comp()
{
make_function("=", Lall_the_same);
make_function("/=", Lall_different);
make_function("<", Lmonotonically_increasing);
make_function(">", Lmonotonically_decreasing);
make_function("<=", Lmonotonically_nondecreasing);
make_function(">=", Lmonotonically_nonincreasing);
make_function("MAX", Lmax);
make_function("MIN", Lmin);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.