qse/ase/lsp/prim_math.c

352 lines
6.7 KiB
C
Raw Normal View History

2005-09-20 08:05:32 +00:00
/*
2007-02-13 06:00:20 +00:00
* $Id: prim_math.c,v 1.19 2007-02-13 06:00:20 bacon Exp $
2007-02-03 10:52:36 +00:00
*
* {License}
2005-09-20 08:05:32 +00:00
*/
2006-10-26 08:17:38 +00:00
#include <ase/lsp/lsp_i.h>
2005-09-20 08:05:32 +00:00
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 08:05:32 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
ase_real_t rval = .0;
2006-10-24 04:22:40 +00:00
ase_bool_t realnum = ase_false;
2005-09-20 08:05:32 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 08:05:32 +00:00
body = args;
2006-10-29 13:40:33 +00:00
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
2007-02-10 13:52:41 +00:00
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 08:05:32 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2005-09-20 12:06:51 +00:00
if (!realnum)
2006-10-30 03:49:06 +00:00
ival = ival + ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
else
2006-10-30 03:49:06 +00:00
rval = rval + ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2005-09-20 11:19:15 +00:00
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = (ase_real_t)ival;
2005-09-20 12:06:51 +00:00
}
2006-10-30 03:49:06 +00:00
rval = rval + ASE_LSP_RVAL(tmp);
2005-09-20 11:19:15 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 08:05:32 +00:00
}
2005-09-20 12:06:51 +00:00
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 08:05:32 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 09:17:06 +00:00
2005-09-20 11:19:15 +00:00
tmp = (realnum)?
2006-10-30 03:49:06 +00:00
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
2007-02-10 13:52:41 +00:00
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 08:05:32 +00:00
return tmp;
}
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 08:05:32 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
ase_real_t rval = .0;
2006-10-24 04:22:40 +00:00
ase_bool_t realnum = ase_false;
2005-09-20 08:05:32 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 08:05:32 +00:00
body = args;
2006-10-29 13:40:33 +00:00
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 08:05:32 +00:00
2005-09-20 11:19:15 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 11:19:15 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2005-09-20 11:19:15 +00:00
if (!realnum)
2006-10-30 03:49:06 +00:00
ival = ival - ASE_LSP_IVAL(tmp);
2005-09-20 11:19:15 +00:00
else
2006-10-30 03:49:06 +00:00
rval = rval - ASE_LSP_IVAL(tmp);
2005-09-20 11:19:15 +00:00
}
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = ASE_LSP_RVAL(tmp);
2005-09-20 11:19:15 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = (ase_real_t)ival;
2005-09-20 11:19:15 +00:00
}
2006-10-30 03:49:06 +00:00
rval = rval - ASE_LSP_RVAL(tmp);
2005-09-20 11:19:15 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 08:05:32 +00:00
}
2005-09-20 09:17:06 +00:00
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 08:05:32 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 09:17:06 +00:00
2005-09-20 11:19:15 +00:00
tmp = (realnum)?
2006-10-30 03:49:06 +00:00
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
2007-02-10 13:52:41 +00:00
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 08:05:32 +00:00
return tmp;
}
2005-09-20 11:19:15 +00:00
2006-10-29 13:00:39 +00:00
ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
ase_real_t rval = .0;
2006-10-24 04:22:40 +00:00
ase_bool_t realnum = ase_false;
2005-09-20 12:06:51 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 12:06:51 +00:00
body = args;
2006-10-29 13:40:33 +00:00
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2005-09-20 12:06:51 +00:00
if (!realnum)
2006-10-30 03:49:06 +00:00
ival = ival * ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
else
2006-10-30 03:49:06 +00:00
rval = rval * ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = (ase_real_t)ival;
2005-09-20 12:06:51 +00:00
}
2006-10-30 03:49:06 +00:00
rval = rval * ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 12:06:51 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 12:06:51 +00:00
tmp = (realnum)?
2006-10-30 03:49:06 +00:00
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
2007-02-10 13:52:41 +00:00
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
return tmp;
}
2006-10-29 13:00:39 +00:00
ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
ase_real_t rval = .0;
2006-10-24 04:22:40 +00:00
ase_bool_t realnum = ase_false;
2005-09-20 12:06:51 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 12:06:51 +00:00
body = args;
2006-10-29 13:40:33 +00:00
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-30 03:49:06 +00:00
if (ASE_LSP_IVAL(tmp) == 0)
2006-10-29 13:40:33 +00:00
{
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EDIVBY0, ASE_NULL, 0);
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-21 12:04:05 +00:00
}
2006-10-30 03:49:06 +00:00
ival = ival / ASE_LSP_IVAL(tmp);
2005-09-21 12:04:05 +00:00
}
2005-09-20 12:06:51 +00:00
else
2006-10-30 03:49:06 +00:00
rval = rval / ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, realnum == ase_false);
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
if (!realnum)
{
2006-10-24 04:22:40 +00:00
realnum = ase_true;
2006-10-30 03:49:06 +00:00
rval = (ase_real_t)ival;
2005-09-20 12:06:51 +00:00
}
2006-10-30 03:49:06 +00:00
rval = rval / ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 12:06:51 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 12:06:51 +00:00
tmp = (realnum)?
2006-10-30 03:49:06 +00:00
ase_lsp_makerealobj (lsp->mem, rval):
ase_lsp_makeintobj (lsp->mem, ival);
2007-02-10 13:52:41 +00:00
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
return tmp;
}
2006-10-29 13:00:39 +00:00
ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* body, * tmp;
2006-10-30 03:49:06 +00:00
ase_long_t ival = 0;
2005-09-20 12:06:51 +00:00
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
2005-09-20 12:06:51 +00:00
body = args;
2006-10-29 13:40:33 +00:00
while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
2006-10-29 13:40:33 +00:00
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT)
{
if (body == args)
{
2006-10-30 03:49:06 +00:00
ival = ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 03:49:06 +00:00
if (ASE_LSP_IVAL(tmp) == 0)
2006-10-29 13:40:33 +00:00
{
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EDIVBY0, ASE_NULL, 0);
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-21 12:04:05 +00:00
}
2006-10-30 03:49:06 +00:00
ival = ival % ASE_LSP_IVAL(tmp);
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL)
{
if (body == args)
{
2006-10-30 03:49:06 +00:00
ival = (ase_long_t)ASE_LSP_RVAL(tmp);
2005-09-20 12:06:51 +00:00
}
2006-10-29 13:40:33 +00:00
else
{
2006-10-30 03:49:06 +00:00
ase_long_t tmpi = (ase_long_t)ASE_LSP_RVAL(tmp);
2006-10-29 13:40:33 +00:00
if (tmpi == 0)
{
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EDIVBY0, ASE_NULL, 0);
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-21 12:04:05 +00:00
}
2006-10-30 03:49:06 +00:00
ival = ival % tmpi;
2005-09-20 12:06:51 +00:00
}
}
2006-10-29 13:40:33 +00:00
else
{
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
2006-10-24 04:22:40 +00:00
return ASE_NULL;
2005-09-20 12:06:51 +00:00
}
2006-10-24 04:22:40 +00:00
body = ASE_LSP_CDR(body);
2005-09-20 12:06:51 +00:00
}
2006-10-26 09:31:28 +00:00
ASE_LSP_ASSERT (lsp, body == lsp->mem->nil);
2005-09-20 12:06:51 +00:00
2006-10-30 03:49:06 +00:00
tmp = ase_lsp_makeintobj (lsp->mem, ival);
2007-02-10 13:52:41 +00:00
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-20 12:06:51 +00:00
return tmp;
}