qse/ase/lsp/prim_math.c

/*
 * $Id: prim_math.c,v 1.10 2006-10-26 08:17:38 bacon Exp $
 */

#include <ase/lsp/lsp_i.h>

ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
	ase_lsp_obj_t* body, * tmp;
	ase_long_t ivalue = 0;
	ase_real_t rvalue = .0;
	ase_bool_t realnum = ase_false;

	ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
	ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);

	body = args;
	//while (body != lsp->mem->nil) {
	while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
		tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
		if (tmp == ASE_NULL) {
			/*lsp->errnum = ASE_LSP_ERR_BAD_VALUE; */
			return ASE_NULL;
		}

		if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
			if (body == args) {
				ase_lsp_assert (lsp, realnum == ase_false);
				ivalue = ASE_LSP_IVALUE(tmp);
			}
			else {
				if (!realnum) 
					ivalue = ivalue + ASE_LSP_IVALUE(tmp);
				else
					rvalue = rvalue + ASE_LSP_IVALUE(tmp);
			}
		}
		else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
			if (body == args) {
				ase_lsp_assert (lsp, realnum == ase_false);
				realnum = ase_true;
				rvalue = ASE_LSP_RVALUE(tmp);
			}
			else {
				if (!realnum) {
					realnum = ase_true;
					rvalue = (ase_real_t)ivalue;
				}
				rvalue = rvalue + ASE_LSP_RVALUE(tmp);
			}
		}
		else {
			lsp->errnum = ASE_LSP_ERR_BAD_VALUE;	
			return ASE_NULL;
		}


		body = ASE_LSP_CDR(body);
	}

	ase_lsp_assert (lsp, body == lsp->mem->nil);

	tmp = (realnum)?
		ase_lsp_makerealobj (lsp->mem, rvalue):
		ase_lsp_makeintobj (lsp->mem, ivalue);
	if (tmp == ASE_NULL) {
		lsp->errnum = ASE_LSP_ENOMEM;
		return ASE_NULL;
	}

	return tmp;
}

ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
	ase_lsp_obj_t* body, * tmp;
	ase_long_t ivalue = 0;
	ase_real_t rvalue = .0;
	ase_bool_t realnum = ase_false;

	ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
	ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);

	body = args;
	//while (body != lsp->mem->nil) {
	while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
		tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
		if (tmp == ASE_NULL) return ASE_NULL;


		if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
			if (body == args) {
				ase_lsp_assert (lsp, realnum == ase_false);
				ivalue = ASE_LSP_IVALUE(tmp);
			}
			else {
				if (!realnum) 
					ivalue = ivalue - ASE_LSP_IVALUE(tmp);
				else
					rvalue = rvalue - ASE_LSP_IVALUE(tmp);
			}
		}
		else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
			if (body == args) {
				ase_lsp_assert (lsp, realnum == ase_false);
				realnum = ase_true;
				rvalue = ASE_LSP_RVALUE(tmp);
			}
			else {
				if (!realnum) {
					realnum = ase_true;
					rvalue = (ase_real_t)ivalue;
				}
				rvalue = rvalue - ASE_LSP_RVALUE(tmp);
			}
		}
		else {
			lsp->errnum = ASE_LSP_ERR_BAD_VALUE;	
			return ASE_NULL;
		}


		body = ASE_LSP_CDR(body);
	}

	ase_lsp_assert (lsp, body == lsp->mem->nil);

	tmp = (realnum)?
		ase_lsp_makerealobj (lsp->mem, rvalue):
		ase_lsp_makeintobj (lsp->mem, ivalue);
	if (tmp == ASE_NULL) {
		lsp->errnum = ASE_LSP_ENOMEM;
		return ASE_NULL;
	}

	return tmp;
}

ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
	ase_lsp_obj_t* body, * tmp;
	ase_long_t ivalue = 0;
	ase_real_t rvalue = .0;
	ase_bool_t realnum = ase_false;

	ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
	ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);

	body = args;
	//while (body != lsp->mem->nil) {
	while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
		tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
		if (tmp == ASE_NULL) return ASE_NULL;


		if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
			if (body == args) {
				ase_lsp_assert (lsp, realnum == ase_false);
				ivalue = ASE_LSP_IVALUE(tmp);
			}
			else {
				if (!realnum) 
					ivalue = ivalue * ASE_LSP_IVALUE(tmp);
				else
					rvalue = rvalue * ASE_LSP_IVALUE(tmp);
			}
		}
		else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
			if (body == args) {
				ase_lsp_assert (lsp, realnum == ase_false);
				realnum = ase_true;
				rvalue = ASE_LSP_RVALUE(tmp);
			}
			else {
				if (!realnum) {
					realnum = ase_true;
					rvalue = (ase_real_t)ivalue;
				}
				rvalue = rvalue * ASE_LSP_RVALUE(tmp);
			}
		}
		else {
			lsp->errnum = ASE_LSP_ERR_BAD_VALUE;	
			return ASE_NULL;
		}


		body = ASE_LSP_CDR(body);
	}

	ase_lsp_assert (lsp, body == lsp->mem->nil);

	tmp = (realnum)?
		ase_lsp_makerealobj (lsp->mem, rvalue):
		ase_lsp_makeintobj (lsp->mem, ivalue);
	if (tmp == ASE_NULL) {
		lsp->errnum = ASE_LSP_ENOMEM;
		return ASE_NULL;
	}

	return tmp;
}

ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
	ase_lsp_obj_t* body, * tmp;
	ase_long_t ivalue = 0;
	ase_real_t rvalue = .0;
	ase_bool_t realnum = ase_false;

	ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
	ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);

	body = args;
	//while (body != lsp->mem->nil) {
	while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
		tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
		if (tmp == ASE_NULL) return ASE_NULL;


		if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
			if (body == args) {
				ase_lsp_assert (lsp, realnum == ase_false);
				ivalue = ASE_LSP_IVALUE(tmp);
			}
			else {
				if (!realnum) {
					if (ASE_LSP_IVALUE(tmp) == 0) {
						lsp->errnum = ASE_LSP_EDIVBYZERO;
						return ASE_NULL;
					}
					ivalue = ivalue / ASE_LSP_IVALUE(tmp);
				}
				else
					rvalue = rvalue / ASE_LSP_IVALUE(tmp);
			}
		}
		else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
			if (body == args) {
				ase_lsp_assert (lsp, realnum == ase_false);
				realnum = ase_true;
				rvalue = ASE_LSP_RVALUE(tmp);
			}
			else {
				if (!realnum) {
					realnum = ase_true;
					rvalue = (ase_real_t)ivalue;
				}
				rvalue = rvalue / ASE_LSP_RVALUE(tmp);
			}
		}
		else {
			lsp->errnum = ASE_LSP_ERR_BAD_VALUE;	
			return ASE_NULL;
		}


		body = ASE_LSP_CDR(body);
	}

	ase_lsp_assert (lsp, body == lsp->mem->nil);

	tmp = (realnum)?
		ase_lsp_makerealobj (lsp->mem, rvalue):
		ase_lsp_makeintobj (lsp->mem, ivalue);
	if (tmp == ASE_NULL) 
	{
		lsp->errnum = ASE_LSP_ENOMEM;
		return ASE_NULL;
	}

	return tmp;
}

ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
	ase_lsp_obj_t* body, * tmp;
	ase_long_t ivalue = 0;

	ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
	ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);

	body = args;
	//while (body != lsp->mem->nil) {
	while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
		tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
		if (tmp == ASE_NULL) return ASE_NULL;

		if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
			if (body == args) {
				ivalue = ASE_LSP_IVALUE(tmp);
			}
			else {
				if (ASE_LSP_IVALUE(tmp) == 0) {
					lsp->errnum = ASE_LSP_EDIVBYZERO;
					return ASE_NULL;
				}
				ivalue = ivalue % ASE_LSP_IVALUE(tmp);
			}
		}
		else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
			if (body == args) {
				ivalue = (ase_long_t)ASE_LSP_RVALUE(tmp);
			}
			else {
				ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp);
				if (tmpi == 0) {
					lsp->errnum = ASE_LSP_EDIVBYZERO;
					return ASE_NULL;
				}
				ivalue = ivalue % tmpi;
			}
		}
		else {
			lsp->errnum = ASE_LSP_ERR_BAD_VALUE;	
			return ASE_NULL;
		}


		body = ASE_LSP_CDR(body);
	}

	ase_lsp_assert (lsp, body == lsp->mem->nil);

	tmp = ase_lsp_makeintobj (lsp->mem, ivalue);
	if (tmp == ASE_NULL) 
	{
		lsp->errnum = ASE_LSP_ENOMEM;
		return ASE_NULL;
	}

	return tmp;
}