enhanced the reader to check lvalue for assignment in advance
All checks were successful
continuous-integration/drone/push Build is passing

This commit is contained in:
hyung-hwan 2024-03-10 12:09:56 +09:00
parent 00ad4dd779
commit f6f4d0f259
4 changed files with 47 additions and 26 deletions

View File

@ -1967,7 +1967,6 @@ enum hcl_brand_t
HCL_BRAND_CONS,
HCL_BRAND_ARRAY,
HCL_BRAND_BYTE_ARRAY,
HCL_BRAND_SYMBOL_ARRAY, /* special. internal use only */
HCL_BRAND_SYMBOL,
HCL_BRAND_STRING,
HCL_BRAND_DIC,
@ -2042,7 +2041,6 @@ typedef enum hcl_concode_t hcl_concode_t;
#define HCL_IS_TRUE(hcl,v) (v == (hcl)->_true)
#define HCL_IS_FALSE(hcl,v) (v == (hcl)->_false)
#define HCL_IS_SYMBOL(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL)
#define HCL_IS_SYMBOL_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL_ARRAY)
#define HCL_IS_CONTEXT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONTEXT)
#define HCL_IS_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION)
#define HCL_IS_LAMBDA(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_LAMBDA)

View File

@ -657,22 +657,6 @@ next:
break;
}
case HCL_BRAND_SYMBOL_ARRAY:
{
hcl_oow_t i;
if (hcl_bfmt_out(fmtout, "|") <= -1) return -1;
for (i = 0; i < HCL_OBJ_GET_SIZE(obj); i++)
{
hcl_oop_t s;
s = ((hcl_oop_oop_t)obj)->slot[i];
if (hcl_bfmt_out(fmtout, " %.*js", HCL_OBJ_GET_SIZE(s), HCL_OBJ_GET_CHAR_SLOT(s)) <= -1) return -1;
}
if (hcl_bfmt_out(fmtout, " |") <= -1) return -1;
break;
}
case HCL_BRAND_PRIM:
word_index = WORD_PRIM;
goto print_word;

View File

@ -607,7 +607,8 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, hcl_loc_t* list_loc, int*
/* HACK */
if (concode == HCL_CONCODE_ALIST)
{
/* tranform (var := val) to (set var val) - note ALIST doesn't contain the := symbol */
/* tranform (var := val) to (set var val)
* - note ALIST doesn't contain the := symbol */
hcl_cnode_t* sym, * newhead, * lval;
hcl_oocs_t fake_tok, * fake_tok_ptr = HCL_NULL;
@ -615,25 +616,36 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, hcl_loc_t* list_loc, int*
if (lval && HCL_CNODE_IS_ELIST(lval))
{
/* invalid lvalue */
invalid_lvalue:
hcl_setsynerr (hcl, HCL_SYNERR_LVALUE, HCL_CNODE_GET_LOC(lval), HCL_CNODE_GET_TOK(lval));
if (head) hcl_freecnode (hcl, head);
return HCL_NULL;
}
else if (lval && HCL_CNODE_IS_CONS(lval) && HCL_CNODE_CONS_CONCODE(lval) == HCL_CONCODE_ARRAY)
{
/*
* defun f(a :: b c) { b := (a + 10); c := (a + 20) }
* [x, y] := (f 9) ## this kind of expression - translate to set-r x y (f 9)
*/
hcl_cnode_t* tmp, * rval;
fake_tok.ptr = vocas[VOCA_SYM_SET_R].str;
fake_tok.len = vocas[VOCA_SYM_SET_R].len;
fake_tok_ptr = &fake_tok;
/* move the array item up to the main list and join the original lval to the end of it */
for (tmp = lval; tmp && HCL_CNODE_IS_CONS(tmp); tmp = HCL_CNODE_CONS_CDR(tmp))
{
/* check in avance if the array members are all plain symbols */
hcl_cnode_t* lcar;
lcar = HCL_CNODE_CONS_CAR(tmp);
if (!HCL_CNODE_IS_SYMBOL_PLAIN(lcar)) goto invalid_lvalue;
}
/* move the array item up to the main list and join the original lval to the end of it
* For [x, y] := (f 9), x and y must be in the same level as set-r after translation.
* so make it 'x y (f 9)' first and place set-r in front of it later. */
rval = HCL_CNODE_CONS_CDR(head);
hcl_freesinglecnode (hcl, head);
head = lval;
/* TODO: check in advance if array items are all symbols... */
for (tmp = lval; tmp && HCL_CNODE_IS_CONS(tmp); tmp = HCL_CNODE_CONS_CDR(tmp))
{
if (!HCL_CNODE_CONS_CDR(tmp))
@ -645,6 +657,7 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, hcl_loc_t* list_loc, int*
}
else
{
if (!HCL_CNODE_IS_SYMBOL_PLAIN(lval)) goto invalid_lvalue;
fake_tok.ptr = vocas[VOCA_SYM_SET].str;
fake_tok.len = vocas[VOCA_SYM_SET].len;
fake_tok_ptr = &fake_tok;
@ -776,11 +789,13 @@ static HCL_INLINE int can_comma_list (hcl_t* hcl)
if (rstl->count == 1) rstl->flagv |= JSON;
else if (!(rstl->flagv & JSON)) return 0;
if (rstl->flagv & (COMMAED | COLONED | COLONEQED)) return 0;
if (rstl->flagv & (COMMAED | COLONED | COLONEQED | BINOPED)) return 0;
cc = LIST_FLAG_GET_CONCODE(rstl->flagv);
if (cc == HCL_CONCODE_XLIST)
{
/* defun f(a :: b c) { b := (a + 10); c := (a + 20) }
* (x, y) := (f 9) */
LIST_FLAG_SET_CONCODE(rstl->flagv, HCL_CONCODE_ALIST);
}
else if (cc == HCL_CONCODE_DIC)
@ -808,14 +823,22 @@ static HCL_INLINE int can_colon_list (hcl_t* hcl)
/* mark the state that a colon has appeared in the list */
if (rstl->count == 1) rstl->flagv |= JSON; /* mark that the first key is colon-delimited */
else if (!(rstl->flagv & JSON)) return 0; /* the first key is not colon-delimited. so not allowed to colon-delimit other keys */
else if (!(rstl->flagv & JSON))
{
/* TODO: handling for out-of-class method definition.
* e.g. defun String:length() { ... } */
return 0; /* the first key is not colon-delimited. so not allowed to colon-delimit other keys */
}
/* multiple single-colons - e.g. #{ "abc": : 20 } */
if (rstl->flagv & (COMMAED | COLONED | COLONEQED)) return 0;
if (rstl->flagv & (COMMAED | COLONED | COLONEQED | BINOPED)) return 0;
cc = LIST_FLAG_GET_CONCODE(rstl->flagv);
if (cc == HCL_CONCODE_XLIST)
{
/* method defintion with defun - e.g. defun String:length()
* ugly that this reader must know about the meaning of defun */
if (rstl->count > 1) return 0;
/* ugly dual use of a colon sign. switch to MLIST if the first element
* is delimited by a colon. e.g. (obj:new 10 20 30) */

View File

@ -63,6 +63,22 @@ if (k = 80) {
};
## --------------------------------------
## multiple return values
defun f(a :: b c) { b := (a + 10); c := (a + 20) }
[x, y] := (f 9)
if (x = 19) {
printf "OK - %d\n" x
} else {
printf "ERROR - %d\n" x
}
if (y = 29) {
printf "OK - %d\n" y
} else {
printf "ERROR - %d\n" y
}
## --------------------------------------
defclass A | a b c | {
defun :* newInstance(x y z) {
set a x