ftp.nice.ch/pub/next/developer/languages/lisp/AKCL.1.599.s.tar.gz#/akcl-1-599/c/num_pred.c

This is num_pred.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.
*/

/*
	Predicates on numbers
*/
#include "include.h"
#include "num_include.h"
#include "mp.h"

number_zerop(x)
object	x;
{
	switch (type_of(x)) {

	case t_fixnum:
		if (fix(x) == 0)
			return(1);
		else
			return(0);

	case t_bignum:
	case t_ratio:
		return(0);

	case t_shortfloat:
		if (sf(x) == 0.0)
			return(1);
		else
			return(0);

	case t_longfloat:
		if (lf(x) == 0.0)
			return(1);
		else
			return(0);

	case t_complex:
		return(number_zerop(x->cmp.cmp_real) &&
		       number_zerop(x->cmp.cmp_imag));

	default:
		FEwrong_type_argument(Snumber, x);
	}
}

number_plusp(x)
object	x;
{
	switch (type_of(x)) {

	case t_fixnum:
		if (fix(x) > 0)
			return(1);
		else
			return(0);

	case t_bignum:
		if (big_sign(x) > 0)
			return(1);
		else
			return(0);

	case t_ratio:
		if (number_plusp(x->rat.rat_num))
			return(1);
		else
			return(0);

	case t_shortfloat:
		if (sf(x) > 0.0)
			return(1);
		else
			return(0);

	case t_longfloat:
		if (lf(x) > 0.0)
			return(1);
		else
			return(0);

	default:
		FEwrong_type_argument(TSor_rational_float);
	}
}

number_minusp(x)
object	x;
{
	switch (type_of(x)) {

	case t_fixnum:
		if (fix(x) < 0)
			return(1);
		else
			return(0);

	case t_bignum:
		if (big_sign(x) < 0)
			return(1);
		else
			return(0);

	case t_ratio:
		if (number_minusp(x->rat.rat_num))
			return(1);
		else
			return(0);

	case t_shortfloat:
		if (sf(x) < 0.0)
			return(1);
		else
			return(0);

	case t_longfloat:
		if (lf(x) < 0.0)
			return(1);
		else
			return(0);

	default:
		FEwrong_type_argument(TSor_rational_float);
	}
}

number_oddp(x)
object x;
{
	int	i;

	if (type_of(x) == t_fixnum)
		i = fix(x);
	else if (type_of(x) == t_bignum)
	   i = MP_LOW(MP(x),lgef(MP(x)));
	else
		FEwrong_type_argument(Sinteger, x);
	return(i & 1);
}

number_evenp(x)
object x;
{
	int	i;

	if (type_of(x) == t_fixnum)
		i = fix(x);
	else if (type_of(x) == t_bignum)
	  i = MP_LOW(MP(x),lgef(MP(x)));
	else
		FEwrong_type_argument(Sinteger, x);
	return(~i & 1);
}

Lzerop()
{
	check_arg(1);
	check_type_number(&vs_base[0]);
	if (number_zerop(vs_base[0]))
		vs_base[0] = Ct;
	else
		vs_base[0] = Cnil;
}

Lplusp()
{
	check_arg(1);
	check_type_or_rational_float(&vs_base[0]);
	if (number_plusp(vs_base[0]))
		vs_base[0] = Ct;
	else
		vs_base[0] = Cnil;
}

Lminusp()
{
	check_arg(1);
	check_type_or_rational_float(&vs_base[0]);
	if (number_minusp(vs_base[0]))
		vs_base[0] = Ct;
	else
		vs_base[0] = Cnil;
}

Loddp()
{
	check_arg(1);
	check_type_integer(&vs_base[0]);
	if (number_oddp(vs_base[0]))
		vs_base[0] = Ct;
	else
		vs_base[0] = Cnil;
}

Levenp()
{
	check_arg(1);
	check_type_integer(&vs_base[0]);
	if (number_evenp(vs_base[0]))
		vs_base[0] = Ct;
	else
		vs_base[0] = Cnil;
}

init_num_pred()
{
       	big_register_1 = alloc_object(t_bignum);
	ZERO_BIG(big_register_1);
 
	enter_mark_origin(&big_register_1);
	make_function("ZEROP", Lzerop);
	make_function("PLUSP", Lplusp);
	make_function("MINUSP", Lminusp);
	make_function("ODDP", Loddp);
	make_function("EVENP", Levenp);
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.