qse/ase/lsp/prim_compar.c

142 lines
3.1 KiB
C
Raw Normal View History

2005-09-20 12:06:51 +00:00
/*
2007-02-23 10:57:09 +00:00
* $Id: prim_compar.c,v 1.14 2007-02-23 10:53:39 bacon Exp $
2007-02-03 10:52:36 +00:00
*
* {License}
2005-09-20 12:06:51 +00:00
*/
2006-10-26 08:17:38 +00:00
#include <ase/lsp/lsp_i.h>
2005-09-20 12:06:51 +00:00
2006-10-30 11:26:57 +00:00
#define PRIM_COMPAR(lsp,args,op) \
{ \
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; \
2007-02-10 13:52:41 +00:00
if (ase_lsp_pushtmp (lsp, p1) == ASE_NULL) return ASE_NULL; \
2006-10-30 11:26:57 +00:00
\
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); \
if (p2 == ASE_NULL) \
{ \
2007-02-10 13:52:41 +00:00
ase_lsp_poptmp (lsp); \
2006-10-30 11:26:57 +00:00
return ASE_NULL; \
} \
\
2007-02-10 13:52:41 +00:00
if (ase_lsp_pushtmp (lsp, p2) == ASE_NULL) \
{ \
ase_lsp_poptmp (lsp); \
return ASE_NULL; \
} \
2006-10-30 11:26:57 +00:00
\
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) \
{ \
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) \
{ \
res = ASE_LSP_IVAL(p1) op ASE_LSP_IVAL(p2); \
} \
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) \
{ \
res = ASE_LSP_IVAL(p1) op ASE_LSP_RVAL(p2); \
} \
else \
{ \
2007-02-10 13:52:41 +00:00
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
2006-10-30 11:26:57 +00:00
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) op ASE_LSP_IVAL(p2); \
} \
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) \
{ \
res = ASE_LSP_RVAL(p1) op ASE_LSP_RVAL(p2); \
} \
else \
{ \
2007-02-10 13:52:41 +00:00
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
2006-10-30 11:26:57 +00:00
return ASE_NULL; \
} \
} \
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM) \
{ \
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) \
{ \
2007-02-23 10:57:09 +00:00
res = ase_strxncmp ( \
2006-10-30 11:26:57 +00:00
ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1), \
ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) op 0; \
} \
else \
{ \
2007-02-10 13:52:41 +00:00
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
2006-10-30 11:26:57 +00:00
return ASE_NULL; \
} \
} \
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR) \
{ \
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) \
{ \
2007-02-23 10:57:09 +00:00
res = ase_strxncmp ( \
2006-10-30 11:26:57 +00:00
ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), \
ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) op 0; \
} \
else \
{ \
2007-02-10 13:52:41 +00:00
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
2006-10-30 11:26:57 +00:00
return ASE_NULL; \
} \
} \
else \
{ \
2007-02-10 13:52:41 +00:00
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
2007-02-11 07:36:55 +00:00
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
2006-10-30 11:26:57 +00:00
return ASE_NULL; \
} \
\
2007-02-10 13:52:41 +00:00
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
2006-10-30 11:26:57 +00:00
return (res)? lsp->mem->t: lsp->mem->nil; \
}
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-30 11:26:57 +00:00
PRIM_COMPAR (lsp, args, ==);
2005-09-20 12:06:51 +00:00
}
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-21 11:52:36 +00:00
{
2006-10-30 11:26:57 +00:00
PRIM_COMPAR (lsp, args, !=);
2005-09-21 11:52:36 +00:00
}
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-30 11:26:57 +00:00
PRIM_COMPAR (lsp, args, >);
2005-09-20 12:06:51 +00:00
}
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-20 12:06:51 +00:00
{
2006-10-30 11:26:57 +00:00
PRIM_COMPAR (lsp, args, <);
2005-09-20 12:06:51 +00:00
}
2005-09-21 11:52:36 +00:00
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-21 11:52:36 +00:00
{
2006-10-30 11:26:57 +00:00
PRIM_COMPAR (lsp, args, >=);
2005-09-21 11:52:36 +00:00
}
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-21 11:52:36 +00:00
{
2006-10-30 11:26:57 +00:00
PRIM_COMPAR (lsp, args, <=);
2005-09-21 11:52:36 +00:00
}