diff --git a/lib/bigint.c b/lib/bigint.c index 75ef5d0..5b829fb 100644 --- a/lib/bigint.c +++ b/lib/bigint.c @@ -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; diff --git a/lib/hcl.h b/lib/hcl.h index bc991cd..da9e6b0 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -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, diff --git a/lib/prim.c b/lib/prim.c index 3c80a61..e96bfde 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -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, { '-' } },