hyung-hwan/qse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
3b10af5547
qse/ase/lsp/prim_compar.c

501 lines
10 KiB
C
Raw Blame History

/*
* $Id: prim_compar.c,v 1.9 2006-10-30 03:49:05 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) == ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) == ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) == ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) == ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) == 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) == 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) != ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) != ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) != ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) != ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) != 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) != 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) > ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) > ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) > ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) > ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) > 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) > 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) < ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) < ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) < ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) < ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) < 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) < 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) >= ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) >= ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) >= ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) >= ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) >= 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) >= 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
ase_lsp_obj_t* p1, * p2;
int res;
ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1....
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVAL(p1) <= ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVAL(p1) <= ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVAL(p1) <= ASE_LSP_IVAL(p2);
}
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVAL(p1) <= ASE_LSP_RVAL(p2);
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
res = ase_lsp_strxncmp (
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) <= 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) <= 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
Reference in New Issue View Git Blame Copy Permalink