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

added hcl_genums(), hcl_gtnums(), hcl_lenums(), hcl_ltnums(), hcl_eqnums(), hcl_nenums()

Browse Source
This commit is contained in:
hyung-hwan
2018-04-02 12:28:09 +00:00
parent c382736be4
commit 1091c8f401
4 changed files with 108 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
hcl/lib/bigint.c
View File

@ -3819,7 +3819,7 @@ hcl_oop_t hcl_eqints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
} }
oops_einval: oops_einval:
hcl_seterrnum (hcl, HCL_EINVAL); hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O, %O", x, y);
return HCL_NULL; return HCL_NULL;
} }
@ -3840,7 +3840,7 @@ hcl_oop_t hcl_neints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
} }
oops_einval: oops_einval:
hcl_seterrnum (hcl, HCL_EINVAL); hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O, %O", x, y);
return HCL_NULL; return HCL_NULL;
} }
@ -3867,7 +3867,7 @@ hcl_oop_t hcl_gtints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
} }
oops_einval: oops_einval:
hcl_seterrnum (hcl, HCL_EINVAL); hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O, %O", x, y);
return HCL_NULL; return HCL_NULL;
} }
@ -3894,7 +3894,7 @@ hcl_oop_t hcl_geints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
} }
oops_einval: oops_einval:
hcl_seterrnum (hcl, HCL_EINVAL); hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O, %O", x, y);
return HCL_NULL; return HCL_NULL;
} }
@ -3948,7 +3948,7 @@ hcl_oop_t hcl_leints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
} }
oops_einval: oops_einval:
hcl_seterrnum (hcl, HCL_EINVAL); hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O, %O", x, y);
return HCL_NULL; return HCL_NULL;
} }
@ -3983,7 +3983,11 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int radix, int ngc)
} }
HCL_ASSERT (hcl, radix >= 2 && radix <= 36); HCL_ASSERT (hcl, radix >= 2 && radix <= 36);
if (!hcl_isint(hcl,num)) goto oops_einval; if (!hcl_isint(hcl,num))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O", num);
return HCL_NULL;
}
v = integer_to_oow(hcl, num, &w); v = integer_to_oow(hcl, num, &w);
if (v) if (v)
@ -4195,8 +4199,4 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int radix, int ngc)
} }
return hcl_makestring(hcl, xbuf, xlen, ngc); return hcl_makestring(hcl, xbuf, xlen, ngc);
oops_einval:
hcl_seterrnum (hcl, HCL_EINVAL);
return HCL_NULL;
} }

35
hcl/lib/hcl-prv.h
View File

@ -997,6 +997,41 @@ hcl_oop_t hcl_truncfpdecval (
hcl_ooi_t ns /* new scale */ hcl_ooi_t ns /* new scale */
); );
hcl_oop_t hcl_gtnums (
hcl_t* hcl,
hcl_oop_t x,
hcl_oop_t y
);
hcl_oop_t hcl_genums (
hcl_t* hcl,
hcl_oop_t x,
hcl_oop_t y
);
hcl_oop_t hcl_ltnums (
hcl_t* hcl,
hcl_oop_t x,
hcl_oop_t y
);
hcl_oop_t hcl_lenums (
hcl_t* hcl,
hcl_oop_t x,
hcl_oop_t y
);
hcl_oop_t hcl_eqnums (
hcl_t* hcl,
hcl_oop_t x,
hcl_oop_t y
);
hcl_oop_t hcl_nenums (
hcl_t* hcl,
hcl_oop_t x,
hcl_oop_t y
);
/* ========================================================================= */ /* ========================================================================= */
/* comp.c */ /* comp.c */
/* ========================================================================= */ /* ========================================================================= */

57
hcl/lib/number.c
View File

@ -275,3 +275,60 @@ hcl_oop_t hcl_divnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
return hcl_makefpdec(hcl, nv, xs); return hcl_makefpdec(hcl, nv, xs);
} }
static hcl_oop_t comp_nums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, hcl_oop_t (*comper) (hcl_t*, hcl_oop_t, hcl_oop_t))
{
if (!HCL_IS_FPDEC(hcl, x) && !HCL_IS_FPDEC(hcl, y))
{
/* both are probably integers */
return comper(hcl, x, y);
}
else
{
hcl_oop_t v;
hcl_ooi_t scale;
hcl_pushtmp (hcl, &x);
hcl_pushtmp (hcl, &y);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
{
hcl_poptmps (hcl, 2);
return HCL_NULL;
}
v = comper(hcl, ((hcl_oop_fpdec_t)x)->value, ((hcl_oop_fpdec_t)y)->value);
hcl_poptmps (hcl, 2);
return v;
}
}
hcl_oop_t hcl_gtnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
return comp_nums(hcl, x, y, hcl_gtints);
}
hcl_oop_t hcl_genums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
return comp_nums(hcl, x, y, hcl_geints);
}
hcl_oop_t hcl_ltnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
return comp_nums(hcl, x, y, hcl_ltints);
}
hcl_oop_t hcl_lenums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
return comp_nums(hcl, x, y, hcl_leints);
}
hcl_oop_t hcl_eqnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
return comp_nums(hcl, x, y, hcl_eqints);
}
hcl_oop_t hcl_nenums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y)
{
return comp_nums(hcl, x, y, hcl_neints);
}

12
hcl/lib/prim.c
View File

@ -485,7 +485,7 @@ static hcl_pfrc_t pf_integer_rem (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_integer_gt (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfrc_t pf_integer_gt (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{ {
hcl_oop_t ret; hcl_oop_t ret;
ret = hcl_gtints(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1)); ret = hcl_gtnums(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1));
if (!ret) return HCL_PF_FAILURE; if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret); HCL_STACK_SETRET (hcl, nargs, ret);
@ -496,7 +496,7 @@ static hcl_pfrc_t pf_integer_gt (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_integer_ge (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfrc_t pf_integer_ge (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{ {
hcl_oop_t ret; hcl_oop_t ret;
ret = hcl_geints(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1)); ret = hcl_genums(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1));
if (!ret) return HCL_PF_FAILURE; if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret); HCL_STACK_SETRET (hcl, nargs, ret);
@ -506,7 +506,7 @@ static hcl_pfrc_t pf_integer_ge (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_integer_lt (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfrc_t pf_integer_lt (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{ {
hcl_oop_t ret; hcl_oop_t ret;
ret = hcl_ltints(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1)); ret = hcl_ltnums(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1));
if (!ret) return HCL_PF_FAILURE; if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret); HCL_STACK_SETRET (hcl, nargs, ret);
@ -515,7 +515,7 @@ static hcl_pfrc_t pf_integer_lt (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_integer_le (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfrc_t pf_integer_le (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{ {
hcl_oop_t ret; hcl_oop_t ret;
ret = hcl_leints(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1)); ret = hcl_lenums(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1));
if (!ret) return HCL_PF_FAILURE; if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret); HCL_STACK_SETRET (hcl, nargs, ret);
@ -524,7 +524,7 @@ static hcl_pfrc_t pf_integer_le (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_integer_eq (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfrc_t pf_integer_eq (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{ {
hcl_oop_t ret; hcl_oop_t ret;
ret = hcl_eqints(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1)); ret = hcl_eqnums(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1));
if (!ret) return HCL_PF_FAILURE; if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret); HCL_STACK_SETRET (hcl, nargs, ret);
@ -533,7 +533,7 @@ static hcl_pfrc_t pf_integer_eq (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_integer_ne (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfrc_t pf_integer_ne (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{ {
hcl_oop_t ret; hcl_oop_t ret;
ret = hcl_neints(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1)); ret = hcl_nenums(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1));
if (!ret) return HCL_PF_FAILURE; if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret); HCL_STACK_SETRET (hcl, nargs, ret);