diff --git a/lib/hcl.h b/lib/hcl.h index 952388c..34a4d98 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -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) diff --git a/lib/print.c b/lib/print.c index aa0be5e..d0bf3a5 100644 --- a/lib/print.c +++ b/lib/print.c @@ -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; diff --git a/lib/read.c b/lib/read.c index 80db364..24cff37 100644 --- a/lib/read.c +++ b/lib/read.c @@ -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) */ diff --git a/t/fun-01.hcl b/t/fun-01.hcl index 61658fc..b2dbb56 100644 --- a/t/fun-01.hcl +++ b/t/fun-01.hcl @@ -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