This is num_comp.c in view mode; [Download] [Up]
/*
Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
This file is part of GNU Common Lisp, herein referred to as GCL
GCL is free software; you can redistribute it and/or modify it under
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GCL is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
License for more details.
You should have received a copy of the GNU Library General Public License
along with GCL; see the file COPYING. If not, write to the Free Software
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/*
Comparisons on numbers
*/
#define NEED_MP_H
#include "include.h"
#include "num_include.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(sLnumber, 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(sLnumber, 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(sLnumber, 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(sLnumber, 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.