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

added the str.atPut primitive
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-04-10 19:23:15 +09:00
parent 27459c7010
commit 7634df5449
4 changed files with 105 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
lib/exec.c
View File

@ -2239,7 +2239,7 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
{
hcl_oop_lambda_t mth_blk;
hcl_oop_context_t newctx;
hcl_oop_class_t class_, owner;
hcl_oop_class_t _class, owner;
hcl_ooi_t ivaroff;
int x;
@ -2251,8 +2251,8 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
/* ============================= */
if (HCL_IS_CLASS(hcl, rcv))
{
class_ = (hcl_oop_class_t)rcv;
mth_blk = find_cmethod_noseterr(hcl, class_, msg, to_super, &ivaroff, &owner);
_class = (hcl_oop_class_t)rcv;
mth_blk = find_cmethod_noseterr(hcl, _class, msg, to_super, &ivaroff, &owner);
if (!mth_blk) goto msg_not_found;
@ -2263,7 +2263,7 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
hcl_pushvolat (hcl, (hcl_oop_t*)&mth_blk);
hcl_pushvolat (hcl, &msg);
hcl_pushvolat (hcl, &rcv);
newrcv = hcl_instantiate(hcl, (hcl_oop_class_t)class_, HCL_NULL, 0);
newrcv = hcl_instantiate(hcl, (hcl_oop_class_t)_class, HCL_NULL, 0);
hcl_popvolats (hcl, 3);
if (HCL_UNLIKELY(!newrcv)) return -1;
@ -2273,13 +2273,14 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
else
{
/*HCL_ASSERT (hcl, HCL_IS_INSTANCE(hcl, rcv));*/
HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, rcv->_class));
class_ = (hcl_oop_class_t)rcv->_class;
mth_blk = find_imethod_noseterr(hcl, class_, msg, to_super, &ivaroff, &owner);
_class = (hcl_oop_class_t)HCL_CLASSOF(hcl, rcv);
HCL_ASSERT (hcl, _class != HCL_NULL);
HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, _class));
mth_blk = find_imethod_noseterr(hcl, _class, msg, to_super, &ivaroff, &owner);
if (!mth_blk)
{
msg_not_found:
hcl_seterrbfmt (hcl, HCL_ENOENT, "'%.*js' not found in %O", HCL_OBJ_GET_SIZE(msg), HCL_OBJ_GET_CHAR_SLOT(msg), class_);
hcl_seterrbfmt (hcl, HCL_ENOENT, "'%.*js' not found in %O", HCL_OBJ_GET_SIZE(msg), HCL_OBJ_GET_CHAR_SLOT(msg), _class);
return -1;
}
}
@ -3737,10 +3738,8 @@ static int execute (hcl_t* hcl)
case HCL_BRAND_PRIM:
if (call_primitive(hcl, b1) <= -1)
{
/*
TODO: translate a certain primitive failure to a catchable exception. this seems to work . i need to capture the throw value instead of hcl->_nil .
if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
*/
/* TODO: do i have tell a catchable exception from a fatal error? */
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
goto call_failed;
}
break;

10
lib/read.c
View File

@ -2211,11 +2211,11 @@ not_consumed:
static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c)
{
/*
* #xXXXX hexadecimal
* #oOOOO octal
* #bBBBB binary
* #eDDD error
* #pHHH smptr
* #xXXXX hexadecimal
* #oOOOO octal
* #bBBBB binary
* #eDDD error
* #pHHH smptr
* #\C character
* #\xHHHH unicode character
* #\UHHHH unicode character

83
mod/str.c
View File

@ -27,6 +27,83 @@
#include "_str.h"
static hcl_pfrc_t pf_str_at (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t str, pos;
hcl_ooch_t cv;
hcl_ooi_t size;
hcl_ooi_t idx;
str = HCL_STACK_GETARG(hcl, nargs, 0);
pos = HCL_STACK_GETARG(hcl, nargs, 1);
if (!HCL_IS_STRING(hcl, str))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not string - %O", str);
return HCL_PF_FAILURE;
}
if (!HCL_OOP_IS_SMOOI(pos))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not smooi - %O", pos);
return HCL_PF_FAILURE;
}
idx = HCL_OOP_TO_SMOOI(pos);
size = HCL_OBJ_GET_SIZE(str);
if (idx <= -1 || idx >= size)
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter out of range - %O", pos);
return HCL_PF_FAILURE;
}
cv = HCL_OBJ_GET_CHAR_VAL(str, idx);
HCL_STACK_SETRET (hcl, nargs, HCL_CHAR_TO_OOP(cv));
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_str_at_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t str, pos, val;
hcl_ooch_t cv;
hcl_ooi_t size;
hcl_ooi_t idx;
str = HCL_STACK_GETARG(hcl, nargs, 0);
pos = HCL_STACK_GETARG(hcl, nargs, 1);
val = HCL_STACK_GETARG(hcl, nargs, 2);
if (!HCL_IS_STRING(hcl, str))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not string - %O", str);
return HCL_PF_FAILURE;
}
if (!HCL_OOP_IS_SMOOI(pos))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O", pos);
return HCL_PF_FAILURE;
}
if (!HCL_OOP_IS_CHAR(val))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not character - %O", pos);
return HCL_PF_FAILURE;
}
idx = HCL_OOP_TO_SMOOI(pos);
size = HCL_OBJ_GET_SIZE(str);
if (idx <= -1 || idx >= size)
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter out of range - %O", pos);
return HCL_PF_FAILURE;
}
cv = HCL_OOP_TO_CHAR(val);
HCL_OBJ_SET_CHAR_VAL(str, idx, cv);
HCL_STACK_SETRET (hcl, nargs, val);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t str;
@ -34,9 +111,9 @@ static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
str = HCL_STACK_GETARG(hcl, nargs, 0);
if (!HCL_IS_STRING(hcl,str))
if (!HCL_IS_STRING(hcl, str))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not a string - %O", str);
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not string - %O", str);
return HCL_PF_FAILURE;
}
@ -48,6 +125,8 @@ static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfinfo_t pfinfos[] =
{
/*{ { 'V','A','R','\0' }, { HCL_PFBASE_VAR, HCL_NULL, 0, 0 } },*/
{ { 'a','t','\0' }, { HCL_PFBASE_FUNC, pf_str_at, 2, 2 } },
{ { 'a','t','P','u','t','\0' }, { HCL_PFBASE_FUNC, pf_str_at_put, 3, 3 } },
{ { 'l','e','n','g','t','h','\0' }, { HCL_PFBASE_FUNC, pf_str_length, 1, 1 } }
};

8
t/call-5001.err
View File

@ -1,3 +1,11 @@
## the expression begins with a dictionary expression.
## it is not a function name and can'be be invoked.
#{100:1, 200: 3}; ##ERROR: syntax error - invalid callable
---
try {
throw "excetion message"
} catch (e a) { ##ERROR: syntax error - not proper exception variable
printf "EXCEPTION - %s\n" e
}