hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added many type checking predicates

Browse Source
This commit is contained in:
hyung-hwan 2018-04-07 04:43:56 +00:00
parent 726b8026b3
commit 54015185ab
3 changed files with 127 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lib/bigint.c
View File

@ -4048,7 +4048,12 @@ hcl_oop_t hcl_absint (hcl_t* hcl, hcl_oop_t x)
{
x = _clone_bigint(hcl, x, HCL_OBJ_GET_SIZE(x), HCL_BRAND_PBIGINT);
}
else if (!HCL_IS_PBIGINT(hcl, x))
else if (HCL_IS_PBIGINT(hcl, x))
{
/* do nothing. return x without change.
* [THINK] but do i need to clone a positive bigint? */
}
else
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O", x);
return HCL_NULL;

11
lib/hcl.h
View File

@ -1437,6 +1437,7 @@ typedef enum hcl_concode_t hcl_concode_t;
#define HCL_IS_CONS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONS)
#define HCL_IS_CONS_XLIST(hcl,v) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == HCL_CONCODE_XLIST)
#define HCL_IS_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_ARRAY)
#define HCL_IS_BYTEARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BYTE_ARRAY)
#define HCL_IS_DIC(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_DIC)
#define HCL_IS_PRIM(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PRIM)
#define HCL_IS_PBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT)
@ -1459,8 +1460,6 @@ typedef int (*hcl_dic_walker_t) (
extern "C" {
#endif
#define hcl_switchprocess(hcl) ((hcl)->switch_proc = 1)
HCL_EXPORT hcl_t* hcl_open (
hcl_mmgr_t* mmgr,
hcl_oow_t xtnsize,
@ -1666,6 +1665,14 @@ HCL_EXPORT void hcl_abort (
hcl_t* hcl
);
#if defined(HCL_HAVE_INLINE)
static HCL_INLINE void hcl_switchprocess (hcl_t* hcl) { hcl->switch_proc = 1; }
#else
# define hcl_switchprocess(hcl) ((hcl)->switch_proc = 1)
#endif
HCL_EXPORT int hcl_attachio (
hcl_t* hcl,
hcl_ioimpl_t reader,

114
lib/prim.c
View File

@ -225,6 +225,7 @@ static hcl_pfrc_t pf_gc (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
}
/* ------------------------------------------------------------------------- */
static hcl_pfrc_t pf_eqv (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t a0, a1, rv;
@ -299,6 +300,108 @@ static hcl_pfrc_t pf_nqk (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
return HCL_PF_SUCCESS;
}
/* ------------------------------------------------------------------------- */
static hcl_pfrc_t pf_is_null (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv;
rv = (HCL_STACK_GETARG(hcl, nargs, 0) == hcl->_nil)? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_boolean (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_IS_TRUE(hcl, x) || HCL_IS_FALSE(hcl, x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_character (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_OOP_IS_CHAR(x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_error (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_OOP_IS_ERROR(x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_smptr (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_OOP_IS_SMPTR(x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_integer (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (hcl_isint(hcl, x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_numeric(hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (hcl_isint(hcl, x) || HCL_IS_FPDEC(hcl, x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_string (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_IS_STRING(hcl, x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_array (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_IS_ARRAY(hcl, x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_bytearray (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_IS_BYTEARRAY(hcl, x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_is_dictionary (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_IS_DIC(hcl, x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
/* ------------------------------------------------------------------------- */
static hcl_pfrc_t pf_not (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t arg, rv;
@ -650,11 +753,18 @@ static pf_t builtin_prims[] =
{ 2, 2, pf_nql, 4, { 'n','q','l','?' } },
{ 2, 2, pf_nqk, 4, { 'n','q','k','?' } },
/*
{ 1, 1, pf_is_null, 4, { 'n','u','l','l','?' } },
{ 1, 1, pf_is_boolean, 8, { 'b','o','o','l','e','a','n','?' } },
{ 1, 1, pf_is_character, 10, { 'c','h','a','r','a','c','t','e','r','?' } },
{ 1, 1, pf_is_error, 6, { 'e','r','r','o','r','?' } },
{ 1, 1, pf_is_smptr, 6, { 's','m','p','t','r','?' } },
{ 1, 1, pf_is_integer, 8, { 'i','n','t','e','g','e','r','?' } },
{ 1, 1, pf_is_numeric, 8, { 'n','u','m','e','r','i','c','?' } },
{ 1, 1, pf_is_string, 7, { 's','t','r','i','n','g','?' } },
*/
{ 1, 1, pf_is_array, 6, { 'a','r','r','a','y','?' } },
{ 1, 1, pf_is_bytearray, 10, { 'b','y','t','e','a','r','r','a','y','?' } },
{ 1, 1, pf_is_dictionary, 11, { 'd','i','c','t','i','o','n','a','r','y','?' } },
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_number_add, 1, { '+' } },
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_number_sub, 1, { '-' } },