added many type checking predicates

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;

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,

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,  { '-' } },