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

Compare commits

base: hyung-hwan:506b8fd9d72d6a2caa43fedf60ee8f54fbbd7b6a
Branches Tags
hyung-hwan:main
hyung-hwan:h2
..
compare: hyung-hwan:6896da6870fcaf9aaf32b53f32946a1e381b365e
Branches Tags
hyung-hwan:main
hyung-hwan:h2

5 Commits
506b8fd9d7 ... 6896da6870

Author SHA1 Message Date
hyung-hwan
6896da6870 changed the superclass marker from '::' to ':'
All checks were successful
continuous-integration/drone/push Build is passing
Details
2024-10-03 22:54:03 +09:00
hyung-hwan
0dbaa264f7 renamed the remaing SYNCODE stuffs to CONCODE something 2024-10-03 21:52:32 +09:00
hyung-hwan
1e97a324ec removed most of syncode stuffs 2024-10-03 21:41:59 +09:00
hyung-hwan
ed978e6f2d removed defclass 2024-10-03 17:21:08 +09:00
hyung-hwan
bcaae10bef updated compile_fun() to check attribute list after having found class_name, fun_name, arg_list 2024-10-02 19:14:10 +09:00
20 changed files with 401 additions and 552 deletions
Show Stats Expand all files Collapse all files

5
lib/cnode.c
View File

@ -124,10 +124,7 @@ hcl_cnode_t* hcl_makecnodebchrlit (hcl_t* hcl, int flags, const hcl_loc_t* loc,
hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok)
{
hcl_cnode_t* c = hcl_makecnode(hcl, HCL_CNODE_SYMBOL, flags, loc, tok);
if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.symbol.syncode = hcl_getsyncodebyoocs_noseterr(hcl, tok);
return c;
return hcl_makecnode(hcl, HCL_CNODE_SYMBOL, flags, loc, tok);
}
hcl_cnode_t* hcl_makecnodedsymbol (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok, int is_cla)

494
lib/comp.c
View File

@ -495,13 +495,6 @@ static int check_block_expression_as_body (hcl_t* hcl, hcl_cnode_t* c, const hcl
goto no_block;
}
if (HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_ELIF) ||
HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_ELSE) ||
HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_CATCH))
{
goto no_block;
}
cdr = HCL_CNODE_CONS_CDR(c);
if (cdr)
{
@ -516,20 +509,10 @@ static int check_block_expression_as_body (hcl_t* hcl, hcl_cnode_t* c, const hcl
/* after the body for `if` or `elif`, there can come `elif` or `else` */
if (HCL_CNODE_IS_TYPED(nxt, HCL_CNODE_ELIF) ||
HCL_CNODE_IS_TYPED(nxt, HCL_CNODE_ELSE)) goto ok;
if (HCL_CNODE_IS_SYMBOL(nxt))
{
int syncode = HCL_CNODE_SYMBOL_SYNCODE(nxt);
if (syncode == HCL_SYNCODE_ELIF || syncode == HCL_SYNCODE_ELSE) goto ok;
}
}
else if (for_what == FOR_TRY)
{
if (HCL_CNODE_IS_TYPED(nxt, HCL_CNODE_CATCH)) goto ok;
if (HCL_CNODE_IS_SYMBOL(nxt))
{
int syncode = HCL_CNODE_SYMBOL_SYNCODE(nxt);
if (syncode == HCL_SYNCODE_CATCH) goto ok;
}
}
}
@ -1542,15 +1525,12 @@ static int collect_vardcl (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t** nextobj,
{
var = HCL_CNODE_CONS_CAR(dcl);
#if 0
if (!HCL_CNODE_IS_SYMBOL(var))
if (!HCL_CNODE_IS_SYMBOL_PLAIN(var))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "local variable not symbol");
return -1;
}
if (HCL_CNODE_IS_SYMBOL(var) && HCL_CNODE_SYMBOL_SYNCODE(var) /* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2 */)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "special symbol not to be declared as local variable");
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_ARGNAME, HCL_CNODE_GET_LOC(var), HCL_NULL,
"invalid local variable name '%.*js'",
HCL_CNODE_GET_TOKLEN(var), HCL_CNODE_GET_TOKPTR(var));
return -1;
}
#else
@ -1723,7 +1703,7 @@ static int compile_and (hcl_t* hcl, hcl_cnode_t* src)
hcl_cnode_t* obj, * expr;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_AND));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_AND));
obj = HCL_CNODE_CONS_CDR(src);
@ -1817,7 +1797,7 @@ static int compile_or (hcl_t* hcl, hcl_cnode_t* src)
hcl_cnode_t* obj, * expr;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_OR));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_OR));
obj = HCL_CNODE_CONS_CDR(src);
@ -1913,7 +1893,7 @@ static int compile_plus (hcl_t* hcl, hcl_cnode_t* src)
hcl_cnode_t* obj, * expr;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_PLUS));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_PLUS));
obj = HCL_CNODE_CONS_CDR(src);
if (!obj)
@ -1981,7 +1961,7 @@ static int compile_break (hcl_t* hcl, hcl_cnode_t* src)
hcl_ooi_t i;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_BREAK) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_BREAK));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_BREAK));
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
@ -2096,7 +2076,7 @@ static int compile_continue (hcl_t* hcl, hcl_cnode_t* src)
hcl_ooi_t i;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_CONTINUE) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_CONTINUE));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_CONTINUE));
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
@ -2285,7 +2265,7 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* xlist)
*/
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(xlist));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(xlist), HCL_SYNCODE_DO) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(xlist), HCL_CNODE_DO));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(xlist), HCL_CNODE_DO));
#if 0
cmd = HCL_CNODE_CONS_CAR(xlist); /* do itself */
@ -2313,7 +2293,7 @@ static int compile_if (hcl_t* hcl, hcl_cnode_t* src)
hcl_cframe_t* cf;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_IF) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_IF));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_IF));
/* (if (< 20 30)
* (perform this)
@ -2423,7 +2403,7 @@ static HCL_INLINE int compile_elif (hcl_t* hcl)
src = cf->operand;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_ELIF) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_ELIF));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_ELIF));
cmd = HCL_CNODE_CONS_CAR(src); /* elif itself */
obj = HCL_CNODE_CONS_CDR(src);
@ -2464,7 +2444,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
src = cf->operand;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_ELSE) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_ELSE));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_ELSE));
cmd = HCL_CNODE_CONS_CAR(src); /* else itself */
obj = HCL_CNODE_CONS_CDR(src);
@ -2486,11 +2466,11 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
/*
(class A
| x y | ; instance variables
:: | x y z | ; class variables <--- how to initialize the class variables???
[ x y ] ## instance variables
:: | x y z | ## class variables <--- how to initialize the class variables???
; everything inside defclass after the variable declarations are normal expressions.
; however, the resolution of some variables will fall under the enclosing class.
## everything inside class after the variable declarations are normal expressions.
## however, the resolution of some variables will fall under the enclosing class.
(set x 20)
(printf "normal statement ....\n");
@ -2511,7 +2491,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
*/
static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
static int compile_class (hcl_t* hcl, hcl_cnode_t* src)
{
hcl_cframe_t* cf;
hcl_cnode_t* cmd, * obj, * tmp;
@ -2521,68 +2501,54 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
if (defclass)
{
/* defclass must be followed by an explicit class name */
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_DEFCLASS));
class_name = HCL_NULL;
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(cmd, HCL_CNODE_CLASS));
/* TODO: attribute lsit */
if (obj /*&& HCL_CNODE_IS_CONS(obj)*/)
{
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(obj));
tmp = HCL_CNODE_CONS_CAR(obj);
if (HCL_CNODE_IS_FOR_DATA_SIMPLE(tmp) || HCL_CNODE_IS_FOR_LANG(tmp))
{
if (!HCL_CNODE_IS_SYMBOL_PLAIN_IDENT(tmp))
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(tmp), HCL_NULL,
"invalid class name '%.*js' for '%.*js'",
HCL_CNODE_GET_TOKLEN(tmp), HCL_CNODE_GET_TOKPTR(tmp),
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
class_name = tmp;
obj = HCL_CNODE_CONS_CDR(obj);
}
}
class_as_defclass:
if (!obj)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_NAME, HCL_CNODE_GET_LOC(src), HCL_NULL, "no class name in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
else if (!HCL_CNODE_IS_CONS(obj))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
class_name = HCL_CNODE_CONS_CAR(obj);
if (!HCL_CNODE_IS_SYMBOL(class_name))
if (class_name)
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name),
"class name not symbol in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
if (HCL_CNODE_SYMBOL_SYNCODE(class_name)) /*|| HCL_OBJ_GET_FLAGS_KERNEL(class_name) >= 1) */
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name),
"special symbol not to be used as class name");
return -1;
}
obj = HCL_CNODE_CONS_CDR(obj);
hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(src), HCL_NULL,
"no class body defined for '%.*js'",
HCL_CNODE_GET_TOKLEN(class_name), HCL_CNODE_GET_TOKPTR(class_name));
}
else
{
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_CLASS) || HCL_CNODE_IS_TYPED(cmd, HCL_CNODE_CLASS));
if (obj && HCL_CNODE_IS_CONS(obj))
{
class_name = HCL_CNODE_CONS_CAR(obj);
if (HCL_CNODE_IS_SYMBOL_PLAIN(class_name))
{
/* to handle 'class' in place of 'defclass' */
defclass = 1;
goto class_as_defclass;
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(src), HCL_NULL,
"no class body defined for unnamed class");
}
}
class_name = HCL_NULL;
}
if (!obj)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(src), HCL_NULL, "no class body", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
tmp = HCL_CNODE_CONS_CAR(obj);
if (/*HCL_CNODE_IS_COLON(tmp) || */HCL_CNODE_IS_DBLCOLONS(tmp))
if (HCL_CNODE_IS_COLON(tmp)) /* check for superclass marker */
{
hcl_cnode_t* marker;
@ -2590,8 +2556,10 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
obj = HCL_CNODE_CONS_CDR(obj);
if (!obj || !HCL_CNODE_IS_CONS(obj))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_EOX, HCL_CNODE_GET_LOC(marker), HCL_NULL,
"no expression or declaration after %.*js", HCL_CNODE_GET_TOKLEN(marker), HCL_CNODE_GET_TOKPTR(marker));
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_EOX, HCL_CNODE_GET_LOC(marker), HCL_NULL,
"no expression or declaration after %.*js",
HCL_CNODE_GET_TOKLEN(marker), HCL_CNODE_GET_TOKPTR(marker));
return -1;
}
@ -2599,8 +2567,23 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
superclass = HCL_CNODE_CONS_CAR(obj);
if (!HCL_CNODE_IS_SYMBOL_PLAIN(superclass))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_NAME, HCL_CNODE_GET_LOC(marker), HCL_NULL,
"no valid superclass name found after %.*js", HCL_CNODE_GET_TOKLEN(marker), HCL_CNODE_GET_TOKPTR(marker));
if (HCL_CNODE_IS_FOR_DATA_SIMPLE(superclass) || HCL_CNODE_IS_FOR_LANG(superclass))
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_NAME, HCL_CNODE_GET_LOC(marker), HCL_NULL,
"invalid superclass name '%.*js' after '%.*js' for '%.*js'",
HCL_CNODE_GET_TOKLEN(superclass), HCL_CNODE_GET_TOKPTR(superclass),
HCL_CNODE_GET_TOKLEN(marker), HCL_CNODE_GET_TOKPTR(marker),
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
}
else
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_NAME, HCL_CNODE_GET_LOC(marker), HCL_NULL,
"no valid superclass name after '%.*js' for '%.*js'",
HCL_CNODE_GET_TOKLEN(marker), HCL_CNODE_GET_TOKPTR(marker),
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
}
return -1;
}
@ -2613,7 +2596,6 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
superclass = HCL_NULL;
}
if (class_name)
{
#if 0
@ -2817,7 +2799,9 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl)
/* ========================================================================= */
static int check_fun_attr_list (hcl_t* hcl, hcl_cnode_t* attr_list, unsigned int* fun_type)
static int check_fun_attr_list (
hcl_t* hcl, hcl_cnode_t* attr_list, unsigned int* fun_type,
hcl_cnode_t* cmd, hcl_cnode_t* class_name, hcl_cnode_t* fun_name)
{
unsigned int ft;
@ -2827,7 +2811,37 @@ static int check_fun_attr_list (hcl_t* hcl, hcl_cnode_t* attr_list, unsigned int
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(attr_list, HCL_CONCODE_XLIST) ||
HCL_CNODE_IS_ELIST_CONCODED(attr_list, HCL_CONCODE_XLIST));
if (HCL_CNODE_IS_CONS(attr_list))
if (HCL_CNODE_IS_ELIST_CONCODED(attr_list, HCL_CONCODE_XLIST))
{
/* don't allow empty attribute list */
if (class_name && fun_name)
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_FUN, HCL_CNODE_GET_LOC(attr_list), HCL_NULL,
"empty attribute list on '%.*js:%.*js' for '%.*js'",
HCL_CNODE_GET_TOKLEN(class_name), HCL_CNODE_GET_TOKPTR(class_name),
HCL_CNODE_GET_TOKLEN(fun_name), HCL_CNODE_GET_TOKPTR(fun_name),
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
}
else if (fun_name)
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_FUN, HCL_CNODE_GET_LOC(attr_list), HCL_NULL,
"empty attribute list on '%.*js' for '%.*js'",
HCL_CNODE_GET_TOKLEN(fun_name), HCL_CNODE_GET_TOKPTR(fun_name),
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
}
else
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_FUN, HCL_CNODE_GET_LOC(attr_list), HCL_NULL,
"empty attribute list on unamed function for '%.*js'",
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
}
return -1;
}
if (HCL_CNODE_IS_CONS_CONCODED(attr_list, HCL_CONCODE_XLIST))
{
hcl_cnode_t* c, * a;
const hcl_ooch_t* tokptr;
@ -2892,6 +2906,7 @@ static int compile_fun (hcl_t* hcl, hcl_cnode_t* src)
hcl_oow_t saved_tv_wcount, tv_dup_start;
hcl_cnode_t* fun_name;
hcl_cnode_t* class_name;
hcl_cnode_t* attr_list;
hcl_cnode_t* arg_list;
hcl_cnode_t* fun_body;
hcl_cframe_t* cf;
@ -2904,27 +2919,25 @@ static int compile_fun (hcl_t* hcl, hcl_cnode_t* src)
next = HCL_CNODE_CONS_CDR(src);
fun_name = HCL_NULL;
class_name = HCL_NULL;
attr_list = HCL_NULL;
arg_list = HCL_NULL;
fun_body = HCL_NULL;
fun_type = FUN_PLAIN;
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_FUN) ||
HCL_CNODE_IS_TYPED(cmd, HCL_CNODE_FUN));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(cmd, HCL_CNODE_FUN));
if (next)
{
hcl_cnode_t* tmp;
hcl_cnode_t* attr_list;
/* the reader ensures that the cdr field of a cons cell points to the next cell.
* and only the field of the last cons cell is NULL. */
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(next));
attr_list = HCL_NULL;
/* fun (arg..)
* fun name (arg..)
* fun(#attr..) name(arg..)
* fun(#attr..) (arg..)
* fun name(arg..)
* fun(#attr..) name(arg..) ## valid as class method, not valid as plain function
* fun(#attr..) (arg..) ## not valid. not attribute list for unamed functions
* fun(#attr..) class:name(arg..)
*/
@ -2977,9 +2990,6 @@ static int compile_fun (hcl_t* hcl, hcl_cnode_t* src)
return -1;
}
fun_name = tmp;
fun_type = FUN_IM;
if (attr_list && check_fun_attr_list(hcl, attr_list, &fun_type) <= -1) return -1;
fun_type |= 0x100; /* indicate that the function was defined in 'fun class:name()' style */
next = HCL_CNODE_CONS_CDR(next);
if (!next)
@ -3005,32 +3015,6 @@ static int compile_fun (hcl_t* hcl, hcl_cnode_t* src)
return -1;
}
}
else
{
/* no 'class:' part after 'fun' */
if (is_in_class_init_scope(hcl))
{
/* TODO:THIS IS ALSO WRONG.
* class X {
* a := (fun x(){}) ## this context is also class_init_scope. so the check above isn't good enough
* } */
fun_type = FUN_IM;
if (attr_list && check_fun_attr_list(hcl, attr_list, &fun_type) <= -1) return -1;
}
else
{
/* as of now, the plain function doesn't support attribute list.
* this can change in the future. */
if (attr_list)
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_FUN, HCL_CNODE_GET_LOC(attr_list), HCL_NULL,
"unsupported attribute list for plain function '%.*js'",
HCL_CNODE_GET_TOKLEN(fun_name), HCL_CNODE_GET_TOKPTR(fun_name));
return -1;
}
}
}
}
if (HCL_CNODE_IS_CONS_CONCODED(tmp, HCL_CONCODE_XLIST) ||
@ -3157,6 +3141,47 @@ static int compile_fun (hcl_t* hcl, hcl_cnode_t* src)
return -1;
}
if (attr_list)
{
if (is_in_class_init_scope(hcl) || class_name)
{
/* TODO: */
/* TODO: THIS IS ALSO WRONG.
* class X {
* a := (fun x(){}) ## this context is also class_init_scope. so the check above isn't good enough
* } */
fun_type = FUN_IM;
if (check_fun_attr_list(hcl, attr_list, &fun_type, cmd, class_name, fun_name) <= -1) return -1;
if (class_name) fun_type |= 0x100; /* defined in `fun class:xxx` style outside class */
}
else
{
if (fun_name)
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_FUN, HCL_CNODE_GET_LOC(attr_list), HCL_NULL,
"attribute list prohibited on plain function '%.*js'",
HCL_CNODE_GET_TOKLEN(fun_name), HCL_CNODE_GET_TOKPTR(fun_name));
}
else
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_FUN, HCL_CNODE_GET_LOC(attr_list), HCL_NULL,
"attribute list prohibited on unamed function for '%.*js'",
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
}
return -1;
}
}
else
{
if (is_in_class_init_scope(hcl) || class_name)
{
fun_type = FUN_IM;
if (class_name) fun_type |= 0x100;
}
}
/* process the argument list */
va = 0;
nargs = 0;
@ -3194,17 +3219,6 @@ static int compile_fun (hcl_t* hcl, hcl_cnode_t* src)
return -1;
}
/* TODO: delete this error check once SYNCODE stuffs are all deleted */
if (HCL_CNODE_IS_SYMBOL(arg) && HCL_CNODE_SYMBOL_SYNCODE(arg) /* || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2 */)
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(arg), HCL_NULL,
"special symbol '%.*js' used as return variable for '%.*js'",
HCL_CNODE_GET_TOKLEN(arg), HCL_CNODE_GET_TOKPTR(arg),
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1)
{
if (hcl->errnum == HCL_EEXIST)
@ -3259,17 +3273,6 @@ static int compile_fun (hcl_t* hcl, hcl_cnode_t* src)
}
else
{
/* TODO: delete this error check once SYNCODE stuffs are all deleted */
if (HCL_CNODE_IS_SYMBOL(arg) && HCL_CNODE_SYMBOL_SYNCODE(arg) /* || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2 */)
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_BANNEDARGNAME, HCL_CNODE_GET_LOC(arg), HCL_NULL,
"special symbol '%.*js' used as argument name for '%.*js'",
HCL_CNODE_GET_TOKLEN(arg), HCL_CNODE_GET_TOKPTR(arg),
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1)
{
if (hcl->errnum == HCL_EEXIST)
@ -3388,9 +3391,7 @@ static int compile_return (hcl_t* hcl, hcl_cnode_t* src, int ret_from_home)
hcl_ooi_t i;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN) ||
HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_REVERT) ||
HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_RETURN) ||
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_RETURN) ||
HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_REVERT));
fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth];
@ -3480,7 +3481,7 @@ static int compile_set (hcl_t* hcl, hcl_cnode_t* src)
int x;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_SET));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_SET));
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
@ -3503,12 +3504,6 @@ static int compile_set (hcl_t* hcl, hcl_cnode_t* src)
return -1;
}
if (HCL_CNODE_IS_SYMBOL(var) && HCL_CNODE_SYMBOL_SYNCODE(var)/* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2*/)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "special symbol not to be used as variable name in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
obj = HCL_CNODE_CONS_CDR(obj);
if (!obj)
{
@ -3568,7 +3563,7 @@ static int compile_set_r (hcl_t* hcl, hcl_cnode_t* src)
hcl_var_info_t vi;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_SET_R));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_SET_R));
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
@ -3589,19 +3584,13 @@ static int compile_set_r (hcl_t* hcl, hcl_cnode_t* src)
do
{
var = HCL_CNODE_CONS_CAR(obj);
if (!HCL_CNODE_IS_SYMBOL(var))
if (!HCL_CNODE_IS_SYMBOL(var)) /* TODO: should this be HCL_CNODE_IS_SYMBOL_PLAIN(var)?? */
{
if (nvars > 0) break;
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "variable name not symbol in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
if (HCL_CNODE_SYMBOL_SYNCODE(var)/* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2*/)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "special symbol not to be used as variable name in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
nvars++;
obj = HCL_CNODE_CONS_CDR(obj);
}
@ -3694,7 +3683,7 @@ static int compile_try (hcl_t* hcl, hcl_cnode_t* src)
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_TRY) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_TRY));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_TRY));
/* (try
* (perform this)
@ -3792,7 +3781,7 @@ static HCL_INLINE int compile_catch (hcl_t* hcl)
src = cf->operand;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_CATCH) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_CATCH));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_CATCH));
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
@ -3812,14 +3801,21 @@ static HCL_INLINE int compile_catch (hcl_t* hcl)
exarg = HCL_CNODE_CONS_CAR(obj);
if (!HCL_CNODE_IS_CONS_CONCODED(exarg, HCL_CONCODE_XLIST) || hcl_countcnodecons(hcl, exarg) != 1)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(exarg), HCL_NULL, "not proper exception variable in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(exarg), HCL_NULL,
"improper exception variable for '%.*js'",
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
exarg = HCL_CNODE_CONS_CAR(exarg);
if (!HCL_CNODE_IS_SYMBOL(exarg) || HCL_CNODE_SYMBOL_SYNCODE(exarg))
if (!HCL_CNODE_IS_SYMBOL_PLAIN(exarg))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(exarg), HCL_CNODE_GET_TOK(exarg), "invalid exception variable name in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(exarg), HCL_NULL,
"invalid exception variable name '%.*js' for '%.*js'",
HCL_CNODE_GET_TOKLEN(exarg), HCL_CNODE_GET_TOKPTR(exarg),
HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
@ -3925,7 +3921,7 @@ static int compile_throw (hcl_t* hcl, hcl_cnode_t* src)
/*hcl_cframe_t* cf;*/
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_THROW) || HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_THROW));
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_THROW));
obj = HCL_CNODE_CONS_CDR(src);
@ -3974,9 +3970,7 @@ static int compile_while (hcl_t* hcl, hcl_cnode_t* src, int next_cop)
hcl_cframe_t* cf;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_UNTIL) ||
HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_WHILE) ||
HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_UNTIL) ||
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_UNTIL) ||
HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_WHILE));
HCL_ASSERT (hcl, next_cop == COP_POST_UNTIL_COND || next_cop == COP_POST_WHILE_COND);
@ -4237,7 +4231,6 @@ static int compile_cons_alist_expression (hcl_t* hcl, hcl_cnode_t* cmd)
static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nrets)
{
hcl_cnode_t* car;
int syncode; /* syntax code of the first element */
/* a valid function call
* (function-name argument-list)
@ -4253,7 +4246,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
switch (HCL_CNODE_GET_TYPE(car))
{
case HCL_CNODE_CLASS:
if (compile_class(hcl, obj, 0) <= -1) return -1;
if (compile_class(hcl, obj) <= -1) return -1;
goto done;
case HCL_CNODE_FUN:
@ -4313,117 +4306,29 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
case HCL_CNODE_REVERT:
if (compile_return(hcl, obj, 1) <= -1) return -1;
goto done;
}
if (HCL_CNODE_IS_SYMBOL(car) && (syncode = HCL_CNODE_SYMBOL_SYNCODE(car)))
{
if (nrets > 0)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_CALLABLE, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "not a function with return-variables");
return -1;
}
switch (syncode)
{
case HCL_SYNCODE_AND:
case HCL_CNODE_AND:
if (compile_and(hcl, obj) <= -1) return -1;
break;
goto done;
case HCL_SYNCODE_BREAK:
/* (break) */
if (compile_break(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_CATCH:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_CATCH, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "catch without try");
return -1;
case HCL_SYNCODE_CLASS:
if (compile_class(hcl, obj, 0) <= -1) return -1;
break;
case HCL_SYNCODE_CONTINUE:
/* (continue)*/
if (compile_continue(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_DEFCLASS:
if (compile_class(hcl, obj, 1) <= -1) return -1;
break;
case HCL_SYNCODE_DO:
if (compile_do(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_ELSE:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELSE, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "else without if");
return -1;
case HCL_SYNCODE_ELIF:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELIF, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "elif without if");
return -1;
case HCL_SYNCODE_IF:
if (compile_if(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_FUN:
/* (fun (x y) (+ x y)) */
if (compile_fun(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_OR:
case HCL_CNODE_OR:
if (compile_or(hcl, obj) <= -1) return -1;
break;
goto done;
case HCL_SYNCODE_PLUS:
case HCL_CNODE_PLUS:
if (compile_plus(hcl, obj) <= -1) return -1;
break;
goto done;
case HCL_SYNCODE_RETURN:
/* (return 10)
* (return (+ 10 20)) */
if (compile_return(hcl, obj, 0) <= -1) return -1;
break;
case HCL_SYNCODE_REVERT:
if (compile_return(hcl, obj, 1) <= -1) return -1;
break;
case HCL_SYNCODE_SET:
/* (set x 10)
* (set x (fun (x y) (+ x y)) */
case HCL_CNODE_SET:
if (compile_set(hcl, obj) <= -1) return -1;
break;
goto done;
case HCL_SYNCODE_SET_R:
/* (set-r a b (func 10 20)) */
case HCL_CNODE_SET_R:
if (compile_set_r(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_THROW:
if (compile_throw(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_TRY:
if (compile_try(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_UNTIL:
if (compile_while(hcl, obj, COP_POST_UNTIL_COND) <= -1) return -1;
break;
case HCL_SYNCODE_WHILE:
if (compile_while(hcl, obj, COP_POST_WHILE_COND) <= -1) return -1;
break;
default:
HCL_DEBUG3 (hcl, "Internal error - unknown syncode %d at %s:%d\n", syncode, __FILE__, __LINE__);
hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(car), HCL_NULL, "internal error - unknown syncode %d", syncode);
return -1;
goto done;
}
}
else if (HCL_CNODE_IS_SYMBOL(car) || HCL_CNODE_IS_DSYMBOL(car) ||
if (HCL_CNODE_IS_SYMBOL(car) || HCL_CNODE_IS_DSYMBOL(car) ||
HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_XLIST) ||
HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_MLIST) ||
HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_BLIST) ||
@ -4530,7 +4435,6 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
hcl_ooi_t nargs;
hcl_ooi_t oldtop;
hcl_cframe_t* cf;
int syncode; /* syntax code of the first element */
/* message sending
* (:<receiver> <operator> <operand1> ...)
@ -4541,12 +4445,6 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST));
car = HCL_CNODE_CONS_CAR(obj);
if (HCL_CNODE_IS_SYMBOL(car) && (syncode = HCL_CNODE_SYMBOL_SYNCODE(car)))
{
/* special symbols such as 'if' is not permitted here */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "unpermitted message receiver");
return -1;
}
/* store the position of COP_EMIT_CALL to be produced with
* SWITCH_TOP_CFRAME() in oldtop for argument count patching
@ -4656,12 +4554,6 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj)
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(obj));
if (HCL_CNODE_SYMBOL_SYNCODE(obj))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "special symbol not to be used as variable name");
return -1;
}
/* check if a symbol is a local variable */
x = find_variable_backward_with_token(hcl, obj, &vi);
if (x <= -1) return -1;
@ -5417,20 +5309,10 @@ static int compile_object_list (hcl_t* hcl)
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_ELSE, oprnd);
goto done;
}
else if (HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_ELIF))
{
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_ELIF, oprnd);
goto done;
}
else if (HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_ELSE))
{
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_ELSE, oprnd);
goto done;
}
}
else if (cop == COP_COMPILE_TRY_OBJECT_LIST || cop == COP_COMPILE_TRY_OBJECT_LIST_TAIL)
{
if (HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_CATCH) || HCL_CNODE_IS_TYPED(car, HCL_CNODE_CATCH))
if (HCL_CNODE_IS_TYPED(car, HCL_CNODE_CATCH))
{
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_CATCH, oprnd);
goto done;

14
lib/exec.c
View File

@ -2406,7 +2406,7 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
/* discard unfinished class definitions for the exception thrown.
*
* (try
* (defclass X
* (class X
* (throw "exception")
* catch (x)
* (printf "exception %O\n" x)
@ -3016,7 +3016,7 @@ static HCL_INLINE int do_return_from_block (hcl_t* hcl)
* respectively.
[CASE 1]
(defclass X
(class X
; ....
(return 20) ; the class defintion isn't over, but return is executed,
; ....
@ -3024,7 +3024,7 @@ static HCL_INLINE int do_return_from_block (hcl_t* hcl)
[CASE 2]
(try
(defclass C
(class C
(return 200)
(printf "============================\n"))
catch (e)
@ -3032,7 +3032,7 @@ static HCL_INLINE int do_return_from_block (hcl_t* hcl)
)
[CASE 3]
(defclass C
(class C
(try
(return 99)
catch (e)
@ -3043,7 +3043,7 @@ static HCL_INLINE int do_return_from_block (hcl_t* hcl)
[CASE 4]
(try
(defclass C
(class C
(try
(return 99)
catch (e)
@ -3057,8 +3057,8 @@ static HCL_INLINE int do_return_from_block (hcl_t* hcl)
[CASE 5]
(try
(defclass D
(defclass C
(class D
(class C
(try
(return 99)
catch (e)

87
lib/gc.c
View File

@ -29,37 +29,6 @@
#include <sys/resource.h> /* getrusage */
#endif
static struct
{
hcl_oow_t len;
hcl_ooch_t ptr[20];
hcl_syncode_t syncode;
hcl_oow_t offset;
} syminfo[] =
{
{ 3, { 'a','n','d' }, HCL_SYNCODE_AND, HCL_OFFSETOF(hcl_t,s_and) },
{ 5, { 'b','r','e','a','k' }, HCL_SYNCODE_BREAK, HCL_OFFSETOF(hcl_t,s_break) },
{ 5, { 'c','a','t','c','h' }, HCL_SYNCODE_CATCH, HCL_OFFSETOF(hcl_t,s_catch) },
{ 5, { 'c','l','a','s','s' }, HCL_SYNCODE_CLASS, HCL_OFFSETOF(hcl_t,s_class) },
{ 8, { 'c','o','n','t','i','n','u','e' }, HCL_SYNCODE_CONTINUE, HCL_OFFSETOF(hcl_t,s_continue) },
{ 8, { 'd','e','f','c','l','a','s','s' }, HCL_SYNCODE_DEFCLASS, HCL_OFFSETOF(hcl_t,s_defclass) },
{ 2, { 'd','o' }, HCL_SYNCODE_DO, HCL_OFFSETOF(hcl_t,s_do) },
{ 4, { 'e','l','i','f' }, HCL_SYNCODE_ELIF, HCL_OFFSETOF(hcl_t,s_elif) },
{ 4, { 'e','l','s','e' }, HCL_SYNCODE_ELSE, HCL_OFFSETOF(hcl_t,s_else) },
{ 3, { 'f','u','n' }, HCL_SYNCODE_FUN, HCL_OFFSETOF(hcl_t,s_fun) },
{ 2, { 'i','f' }, HCL_SYNCODE_IF, HCL_OFFSETOF(hcl_t,s_if) },
{ 2, { 'o','r' }, HCL_SYNCODE_OR, HCL_OFFSETOF(hcl_t,s_or) },
{ 4, { 'p','l','u','s' }, HCL_SYNCODE_PLUS, HCL_OFFSETOF(hcl_t,s_plus) },
{ 6, { 'r','e','t','u','r','n'}, HCL_SYNCODE_RETURN, HCL_OFFSETOF(hcl_t,s_return) },
{ 6, { 'r','e','v','e','r','t'}, HCL_SYNCODE_REVERT, HCL_OFFSETOF(hcl_t,s_revert) },
{ 3, { 's','e','t' }, HCL_SYNCODE_SET, HCL_OFFSETOF(hcl_t,s_set) },
{ 5, { 's','e','t','-','r' }, HCL_SYNCODE_SET_R, HCL_OFFSETOF(hcl_t,s_set_r) },
{ 5, { 't','h','r','o','w' }, HCL_SYNCODE_THROW, HCL_OFFSETOF(hcl_t,s_throw) },
{ 3, { 't','r','y' }, HCL_SYNCODE_TRY, HCL_OFFSETOF(hcl_t,s_try) },
{ 5, { 'u','n','t','i','l' }, HCL_SYNCODE_UNTIL, HCL_OFFSETOF(hcl_t,s_until) },
{ 5, { 'w','h','i','l','e' }, HCL_SYNCODE_WHILE, HCL_OFFSETOF(hcl_t,s_while) }
};
/* ========================================================================= */
/*
@ -957,11 +926,6 @@ static HCL_INLINE void gc_ms_mark_roots (hcl_t* hcl)
gc_ms_mark (hcl, hcl->_true);
gc_ms_mark (hcl, hcl->_false);
for (i = 0; i < HCL_COUNTOF(syminfo); i++)
{
gc_ms_mark (hcl, *(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset));
}
for (i = 0; i < HCL_COUNTOF(kernel_classes); i++)
{
gc_ms_mark (hcl, *(hcl_oop_t*)((hcl_uint8_t*)hcl + kernel_classes[i].offset));
@ -1236,14 +1200,6 @@ void hcl_gc (hcl_t* hcl)
hcl->_true = hcl_moveoop(hcl, hcl->_true);
hcl->_false = hcl_moveoop(hcl, hcl->_false);
for (i = 0; i < HCL_COUNTOF(syminfo); i++)
{
hcl_oop_t tmp;
tmp = *(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset);
tmp = hcl_moveoop(hcl, tmp);
*(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset) = tmp;
}
for (i = 0; i < HCL_COUNTOF(kernel_classes); i++)
{
hcl_oop_t tmp;
@ -1815,18 +1771,6 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
if (HCL_UNLIKELY(!hcl->sysdic)) goto oops;
}
/* symbol table available now. symbols can be created */
for (i = 0; i < HCL_COUNTOF(syminfo); i++)
{
hcl_oop_t tmp;
tmp = hcl_makesymbol(hcl, syminfo[i].ptr, syminfo[i].len);
if (HCL_UNLIKELY(!tmp)) goto oops;
HCL_OBJ_SET_FLAGS_SYNCODE (tmp, syminfo[i].syncode);
*(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset) = tmp;
}
if (!hcl->nil_process)
{
/* Create a nil process used to simplify nil check in GC.
@ -1883,34 +1827,3 @@ oops:
return -1;
}
hcl_syncode_t hcl_getsyncodebyoocs_noseterr (hcl_t* hcl, const hcl_oocs_t* name)
{
hcl_oow_t i;
for (i = 0; i < HCL_COUNTOF(syminfo); i++)
{
if (hcl_comp_oochars(syminfo[i].ptr, syminfo[i].len, name->ptr, name->len) == 0)
return syminfo[i].syncode;
}
return HCL_SYNCODE_NONE; /* indicates no syntax code found */
}
hcl_syncode_t hcl_getsyncode_noseterr (hcl_t* hcl, const hcl_ooch_t* ptr, const hcl_oow_t len)
{
hcl_oow_t i;
for (i = 0; i < HCL_COUNTOF(syminfo); i++)
{
if (hcl_comp_oochars(syminfo[i].ptr, syminfo[i].len, ptr, len) == 0)
return syminfo[i].syncode;
}
return HCL_SYNCODE_NONE; /* indicates no syntax code found */
}
const hcl_ooch_t* hcl_getsyncodename_noseterr (hcl_t* hcl, hcl_syncode_t syncode)
{
hcl_oow_t i;
for (i = 0; i < HCL_COUNTOF(syminfo); i++)
{
if (syncode == syminfo[i].syncode) return syminfo[i].ptr;
}
return HCL_NULL;
}

47
lib/hcl-prv.h
View File

@ -317,6 +317,11 @@ enum hcl_tok_type_t
HCL_TOK_WHILE,
HCL_TOK_RETURN,
HCL_TOK_REVERT,
HCL_TOK_AND,
HCL_TOK_OR,
HCL_TOK_PLUS,
HCL_TOK_SET,
HCL_TOK_SET_R,
HCL_TOK_BINOP,
HCL_TOK_IDENT,
@ -391,13 +396,13 @@ enum hcl_cnode_type_t
HCL_CNODE_RADNUMLIT,
HCL_CNODE_FPDECLIT,
HCL_CNODE_SMPTRLIT,
HCL_CNODE_ERRLIT,
HCL_CNODE_ERRLIT, /* last item for HCL_CNODE_IS_FOR_DATA_LITERAL */
HCL_CNODE_NIL,
HCL_CNODE_TRUE,
HCL_CNODE_FALSE,
HCL_CNODE_SELF,
HCL_CNODE_SUPER,
HCL_CNODE_SUPER, /* last item for HCL_CNODE_IS_FOR_DATA_SIMPLE */
HCL_CNODE_CONS,
HCL_CNODE_ELIST, /* empty list */
@ -409,7 +414,7 @@ enum hcl_cnode_type_t
/* the cnode types from here don't represent actual data.
* these represent syntactical elements of the language only. */
HCL_CNODE_CLASS,
HCL_CNODE_CLASS, /* first item for HCL_CNODE_IS_FOR_LANG */
HCL_CNODE_FUN,
HCL_CNODE_DO,
HCL_CNODE_IF,
@ -424,6 +429,11 @@ enum hcl_cnode_type_t
HCL_CNODE_WHILE,
HCL_CNODE_RETURN,
HCL_CNODE_REVERT,
HCL_CNODE_AND,
HCL_CNODE_OR,
HCL_CNODE_PLUS,
HCL_CNODE_SET,
HCL_CNODE_SET_R, /* language item for HCL_CODE_IS_FOR_LANG */
HCL_CNODE_ELLIPSIS, /* ... */
HCL_CNODE_TRPCOLONS, /* ::: */
@ -449,6 +459,12 @@ typedef enum hcl_cnode_flag_t hcl_cnode_flag_t;
#define HCL_CNODE_IS_TYPED(x, _type) ((x)->cn_type == _type)
#define HCL_CNODE_IS_FOR_DATA(x) ((x)->cn_type <= HCL_CNODE_SHELL)
#define HCL_CNODE_IS_FOR_DATA_SIMPLE(x) ((x)->cn_type <= HCL_CNODE_SUPER)
#define HCL_CNODE_IS_FOR_DATA_LITERAL(x) ((x)->cn_type <= HCL_CNODE_ERRLIT)
/* words to compose the language itself.
* the words pointing to data items(e.g. super, self, nil, true, false) are excluded */
#define HCL_CNODE_IS_FOR_LANG(x)((x)->cn_type >= HCL_CNODE_CLASS && (x)->cn_type <= HCL_CNODE_SET_R)
#define HCL_CNODE_IS_ELLIPSIS(x) ((x)->cn_type == HCL_CNODE_ELLIPSIS)
#define HCL_CNODE_IS_TRPCOLONS(x) ((x)->cn_type == HCL_CNODE_TRPCOLONS)
@ -458,11 +474,9 @@ typedef enum hcl_cnode_flag_t hcl_cnode_flag_t;
#define HCL_CNODE_IS_COLONLT(x) ((x)->cn_type == HCL_CNODE_COLONLT)
#define HCL_CNODE_IS_SYMBOL(x) ((x)->cn_type == HCL_CNODE_SYMBOL)
#define HCL_CNODE_IS_SYMBOL_PLAIN(x) ((x)->cn_type == HCL_CNODE_SYMBOL && (x)->u.symbol.syncode == 0)
#define HCL_CNODE_IS_SYMBOL_PLAIN(x) ((x)->cn_type == HCL_CNODE_SYMBOL)
#define HCL_CNODE_IS_SYMBOL_PLAIN_IDENT(x) (HCL_CNODE_IS_SYMBOL_PLAIN(x) && !hcl_is_binop_char((x)->cn_tok.ptr[0]))
#define HCL_CNODE_IS_SYMBOL_PLAIN_BINOP(x) (HCL_CNODE_IS_SYMBOL_PLAIN(x) && hcl_is_binop_char((x)->cn_tok.ptr[0]))
#define HCL_CNODE_IS_SYMBOL_SYNCODED(x, code) ((x)->cn_type == HCL_CNODE_SYMBOL && (x)->u.symbol.syncode == (code))
#define HCL_CNODE_SYMBOL_SYNCODE(x) ((x)->u.symbol.syncode)
#define HCL_CNODE_IS_DSYMBOL(x) ((x)->cn_type == HCL_CNODE_DSYMBOL)
#define HCL_CNODE_IS_DSYMBOL_CLA(x) ((x)->cn_type == HCL_CNODE_DSYMBOL && (x)->u.dsymbol.is_cla)
@ -496,10 +510,6 @@ struct hcl_cnode_t
hcl_oob_t v;
} bchrlit;
struct
{
hcl_syncode_t syncode; /* special if non-zero */
} symbol;
struct
{
int is_cla; /* class-level accessor. prefixed with self or super */
} dsymbol;
@ -1613,23 +1623,6 @@ void hcl_gc_ms_sweep_lazy (
hcl_oow_t allocsize
);
hcl_syncode_t hcl_getsyncodebyoocs_noseterr (
hcl_t* hcl,
const hcl_oocs_t* name
);
hcl_syncode_t hcl_getsyncode_noseterr (
hcl_t* hcl,
const hcl_ooch_t* ptr,
const hcl_oow_t len
);
const hcl_ooch_t* hcl_getsyncodename_noseterr (
hcl_t* hcl,
hcl_syncode_t syncode
);
/* ========================================================================= */
/* utf8.c */
/* ========================================================================= */

76
lib/hcl.h
View File

@ -366,10 +366,10 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_FLAGS_MOVED_BITS (2) /* 16 */
#define HCL_OBJ_FLAGS_NGC_BITS (1) /* 17 */
#define HCL_OBJ_FLAGS_TRAILER_BITS (1) /* 18 */
#define HCL_OBJ_FLAGS_SYNCODE_BITS (5) /* 23 - syncode for symbol, concode for cons */
#define HCL_OBJ_FLAGS_FLEXI_BITS (1) /* 24 */
#define HCL_OBJ_FLAGS_RDONLY_BITS (1) /* 25 */
#define HCL_OBJ_FLAGS_PROC_BITS (1) /* 26 */
#define HCL_OBJ_FLAGS_CONCODE_BITS (4) /* 22 - concode for cons */
#define HCL_OBJ_FLAGS_FLEXI_BITS (1) /* 23 */
#define HCL_OBJ_FLAGS_RDONLY_BITS (1) /* 24 */
#define HCL_OBJ_FLAGS_PROC_BITS (1) /* 25 */
/*
#define HCL_OBJ_FLAGS_PERM_BITS 1
@ -386,8 +386,8 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_FLAGS_KERNEL_SHIFT (HCL_OBJ_FLAGS_MOVED_BITS + HCL_OBJ_FLAGS_MOVED_SHIFT)
#define HCL_OBJ_FLAGS_MOVED_SHIFT (HCL_OBJ_FLAGS_NGC_BITS + HCL_OBJ_FLAGS_NGC_SHIFT)
#define HCL_OBJ_FLAGS_NGC_SHIFT (HCL_OBJ_FLAGS_TRAILER_BITS + HCL_OBJ_FLAGS_TRAILER_SHIFT)
#define HCL_OBJ_FLAGS_TRAILER_SHIFT (HCL_OBJ_FLAGS_SYNCODE_BITS + HCL_OBJ_FLAGS_SYNCODE_SHIFT)
#define HCL_OBJ_FLAGS_SYNCODE_SHIFT (HCL_OBJ_FLAGS_FLEXI_BITS + HCL_OBJ_FLAGS_FLEXI_SHIFT)
#define HCL_OBJ_FLAGS_TRAILER_SHIFT (HCL_OBJ_FLAGS_CONCODE_BITS + HCL_OBJ_FLAGS_CONCODE_SHIFT)
#define HCL_OBJ_FLAGS_CONCODE_SHIFT (HCL_OBJ_FLAGS_FLEXI_BITS + HCL_OBJ_FLAGS_FLEXI_SHIFT)
#define HCL_OBJ_FLAGS_FLEXI_SHIFT (HCL_OBJ_FLAGS_RDONLY_BITS + HCL_OBJ_FLAGS_RDONLY_SHIFT)
#define HCL_OBJ_FLAGS_RDONLY_SHIFT (HCL_OBJ_FLAGS_PROC_BITS + HCL_OBJ_FLAGS_PROC_SHIFT)
#define HCL_OBJ_FLAGS_PROC_SHIFT (0)
@ -399,7 +399,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_GET_FLAGS_MOVED(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_MOVED_SHIFT, HCL_OBJ_FLAGS_MOVED_BITS)
#define HCL_OBJ_GET_FLAGS_NGC(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_NGC_SHIFT, HCL_OBJ_FLAGS_NGC_BITS)
#define HCL_OBJ_GET_FLAGS_TRAILER(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TRAILER_SHIFT, HCL_OBJ_FLAGS_TRAILER_BITS)
#define HCL_OBJ_GET_FLAGS_SYNCODE(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_SYNCODE_SHIFT, HCL_OBJ_FLAGS_SYNCODE_BITS)
#define HCL_OBJ_GET_FLAGS_CONCODE(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_CONCODE_SHIFT, HCL_OBJ_FLAGS_CONCODE_BITS)
#define HCL_OBJ_GET_FLAGS_FLEXI(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_FLEXI_SHIFT, HCL_OBJ_FLAGS_FLEXI_BITS)
#define HCL_OBJ_GET_FLAGS_RDONLY(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_RDONLY_SHIFT, HCL_OBJ_FLAGS_RDONLY_BITS)
#define HCL_OBJ_GET_FLAGS_PROC(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_PROC_SHIFT, HCL_OBJ_FLAGS_PROC_BITS)
@ -411,7 +411,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
#define HCL_OBJ_SET_FLAGS_MOVED(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_MOVED_SHIFT, HCL_OBJ_FLAGS_MOVED_BITS, v)
#define HCL_OBJ_SET_FLAGS_NGC(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_NGC_SHIFT, HCL_OBJ_FLAGS_NGC_BITS, v)
#define HCL_OBJ_SET_FLAGS_TRAILER(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TRAILER_SHIFT, HCL_OBJ_FLAGS_TRAILER_BITS, v)
#define HCL_OBJ_SET_FLAGS_SYNCODE(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_SYNCODE_SHIFT, HCL_OBJ_FLAGS_SYNCODE_BITS, v)
#define HCL_OBJ_SET_FLAGS_CONCODE(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_CONCODE_SHIFT, HCL_OBJ_FLAGS_CONCODE_BITS, v)
#define HCL_OBJ_SET_FLAGS_FLEXI(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_FLEXI_SHIFT, HCL_OBJ_FLAGS_FLEXI_BITS, v)
#define HCL_OBJ_SET_FLAGS_RDONLY(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_RDONLY_SHIFT, HCL_OBJ_FLAGS_RDONLY_BITS, v)
#define HCL_OBJ_SET_FLAGS_PROC(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_PROC_SHIFT, HCL_OBJ_FLAGS_PROC_BITS, v)
@ -1680,29 +1680,6 @@ struct hcl_t
hcl_oop_t _true;
hcl_oop_t _false;
hcl_oop_t s_and; /* symbol */
hcl_oop_t s_break; /* symbol */
hcl_oop_t s_catch; /* symbol */
hcl_oop_t s_class; /* symbol */
hcl_oop_t s_continue; /* symbol */
hcl_oop_t s_defclass; /* symbol */
hcl_oop_t s_defun; /* symbol */
hcl_oop_t s_do; /* symbol */
hcl_oop_t s_elif; /* symbol */
hcl_oop_t s_else; /* symbol */
hcl_oop_t s_fun; /* symbol */
hcl_oop_t s_if; /* symbol */
hcl_oop_t s_or; /* symbol */
hcl_oop_t s_plus; /* symbol */
hcl_oop_t s_return; /* symbol */
hcl_oop_t s_revert; /* symbol */
hcl_oop_t s_set; /* symbol */
hcl_oop_t s_set_r; /* symbol */
hcl_oop_t s_throw; /* symbol */
hcl_oop_t s_try; /* symbol */ /* _try is special in MSVC. */
hcl_oop_t s_until; /* symbol */
hcl_oop_t s_while; /* symbol */
hcl_oop_dic_t symtab; /* system-wide symbol table. */
hcl_oop_dic_t sysdic; /* system dictionary. */
hcl_oop_process_scheduler_t processor; /* instance of ProcessScheduler */
@ -2044,39 +2021,12 @@ enum hcl_brand_t
};
typedef enum hcl_brand_t hcl_brand_t;
enum hcl_syncode_t
{
HCL_SYNCODE_NONE = 0,
/* SYNCODE 0 means it's not a syncode object. so the actual code begins with 1 */
/* these enumerators can be set in the SYNCODE flags for a symbol */
HCL_SYNCODE_AND = 1,
HCL_SYNCODE_BREAK,
HCL_SYNCODE_CATCH,
HCL_SYNCODE_CLASS,
HCL_SYNCODE_CONTINUE,
HCL_SYNCODE_DEFCLASS,
HCL_SYNCODE_DO,
HCL_SYNCODE_ELIF,
HCL_SYNCODE_ELSE,
HCL_SYNCODE_IF,
HCL_SYNCODE_FUN,
HCL_SYNCODE_OR,
HCL_SYNCODE_PLUS,
HCL_SYNCODE_RETURN, /* local return. return from the current context. */
HCL_SYNCODE_REVERT, /* non-local return. return from home context */
HCL_SYNCODE_SET,
HCL_SYNCODE_SET_R,
HCL_SYNCODE_THROW,
HCL_SYNCODE_TRY,
HCL_SYNCODE_UNTIL,
HCL_SYNCODE_WHILE
};
typedef enum hcl_syncode_t hcl_syncode_t;
/* TODO: this concode stuff has become mostly useless as the bits are never set as of now */
enum hcl_concode_t
{
/* these can be set in the SYNCODE flags for a cons cell */
/* these can be set in the CONCODE flags for a cons cell */
/* if you have more than 16 elements, increase HCL_OBJ_FLAGS_CONCODE_BITS */
HCL_CONCODE_XLIST = 0, /* ( ) - executable list */
HCL_CONCODE_MLIST, /* (obj:message) - message send list */
HCL_CONCODE_ALIST, /* (a := 20) assignment list */
@ -2105,7 +2055,7 @@ typedef enum hcl_concode_t hcl_concode_t;
#define HCL_IS_CLASS(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_class)
#define HCL_IS_INSTANCE(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_INSTANCE)
#define HCL_IS_CONS(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_cons)
#define HCL_IS_CONS_CONCODED(hcl,v,concode) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == (concode))
#define HCL_IS_CONS_CONCODED(hcl,v,concode) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_CONCODE(v) == (concode))
#define HCL_IS_ARRAY(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_array)
#define HCL_IS_BYTEARRAY(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_byte_array)
#define HCL_IS_DIC(hcl,v) (HCL_CLASSOF(hcl,v) == (hcl_oop_t)(hcl)->c_dictionary)

8
lib/print.c
View File

@ -25,6 +25,7 @@
#include "hcl-prv.h"
#include <stdio.h>
#define PRINT_STACK_ALIGN 128
enum
@ -529,7 +530,7 @@ next:
/* this part is to print a linked list of cells. ignore the
* request to output in the json format */
concode = HCL_OBJ_GET_FLAGS_SYNCODE(obj);
concode = HCL_OBJ_GET_FLAGS_CONCODE(obj);
if (hcl_bfmt_out(hcl, fmtout, opening_parens[concode][0]) <= -1) return -1;
cur = obj;
@ -938,6 +939,11 @@ void hcl_dumpcnode (hcl_t* hcl, hcl_cnode_t* cnode, int newline)
case HCL_CNODE_WHILE:
case HCL_CNODE_RETURN:
case HCL_CNODE_REVERT:
case HCL_CNODE_AND:
case HCL_CNODE_OR:
case HCL_CNODE_PLUS:
case HCL_CNODE_SET:
case HCL_CNODE_SET_R:
case HCL_CNODE_ELLIPSIS:
case HCL_CNODE_TRPCOLONS:

51
lib/read.c
View File

@ -73,7 +73,9 @@ static struct voca_t
{ 5, { 'w','h','i','l','e' } },
{ 6, { 'r','e','t','u','r','n' } },
{ 6, { 'r','e','v','e','r','t' } },
{ 3, { 'a','n','d' } },
{ 2, { 'o','r', } },
{ 4, { 'p','l','u','s' } },
{ 3, { 's','e','t' } },
{ 5, { 's','e','t','-','r' } },
@ -131,9 +133,11 @@ enum voca_id_t
VOCA_KW_WHILE,
VOCA_KW_RETURN,
VOCA_KW_REVERT,
VOCA_SYM_SET,
VOCA_SYM_SET_R,
VOCA_KW_AND,
VOCA_KW_OR,
VOCA_KW_PLUS,
VOCA_KW_SET,
VOCA_KW_SET_R,
VOCA_XLIST,
VOCA_MLIST,
@ -478,7 +482,12 @@ static hcl_tok_type_t classify_ident_token (hcl_t* hcl, const hcl_oocs_t* v)
{ VOCA_KW_UNTIL, HCL_TOK_UNTIL },
{ VOCA_KW_WHILE, HCL_TOK_WHILE },
{ VOCA_KW_RETURN, HCL_TOK_RETURN },
{ VOCA_KW_REVERT, HCL_TOK_REVERT }
{ VOCA_KW_REVERT, HCL_TOK_REVERT },
{ VOCA_KW_AND, HCL_TOK_AND },
{ VOCA_KW_OR, HCL_TOK_OR },
{ VOCA_KW_PLUS, HCL_TOK_PLUS },
{ VOCA_KW_SET, HCL_TOK_SET },
{ VOCA_KW_SET_R, HCL_TOK_SET_R }
};
for (i = 0; i < HCL_COUNTOF(tab); i++)
@ -884,6 +893,13 @@ static HCL_INLINE int can_colon_list (hcl_t* hcl)
if (rstl->count <= 0) return 0; /* not allowed at the list beginning */
/* mark the state that a colon has appeared in the list */
if (HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(rstl->head), HCL_CNODE_CLASS))
{
/* class :superclassame ...
* class name:superclassname ... */
return 2;
}
if (rstl->count == 1) rstl->flagv |= JSON; /* mark that the first key is colon-delimited */
else if (!(rstl->flagv & JSON))
{
@ -893,8 +909,7 @@ static HCL_INLINE int can_colon_list (hcl_t* hcl)
* these class methods and class instantiation methods are supposed to be
* implemented elsewhere because ':' has dual use while '::' or ':*' are
* independent tokens */
if (HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(rstl->head), HCL_SYNCODE_FUN) ||
HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(rstl->head), HCL_CNODE_FUN))
if (HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(rstl->head), HCL_CNODE_FUN))
{
hcl_cnode_t* tmp, * next;
next = HCL_CNODE_CONS_CDR(rstl->head);
@ -937,7 +952,14 @@ static HCL_INLINE int can_colon_list (hcl_t* hcl)
/* 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) */
tmp = HCL_CNODE_CONS_CAR(rstl->head);
if (!HCL_CNODE_IS_FOR_DATA(tmp)) return 0;
if (!HCL_CNODE_IS_FOR_DATA(tmp))
{
/* check if the first element can refer to or represent an object.
* for example, '#[1 2 3]:at 1' is proper message send.
* while 'class:xxx {}' is not a method call. it is unamed class
* that inherits from xxx */
return 0;
}
LIST_FLAG_SET_CONCODE(rstl->flagv, HCL_CONCODE_MLIST);
rstl->flagv &= ~JSON;
@ -1428,7 +1450,12 @@ static hcl_cnode_type_t kw_to_cnode_type (int tok_type)
HCL_CNODE_UNTIL,
HCL_CNODE_WHILE,
HCL_CNODE_RETURN,
HCL_CNODE_REVERT
HCL_CNODE_REVERT,
HCL_CNODE_AND,
HCL_CNODE_OR,
HCL_CNODE_PLUS,
HCL_CNODE_SET,
HCL_CNODE_SET_R
};
return mapping[tok_type - HCL_TOK_NIL];
@ -1863,10 +1890,14 @@ static int feed_process_token (hcl_t* hcl)
case HCL_TOK_WHILE:
case HCL_TOK_RETURN:
case HCL_TOK_REVERT:
case HCL_TOK_AND:
case HCL_TOK_OR:
case HCL_TOK_PLUS:
case HCL_TOK_SET:
case HCL_TOK_SET_R:
frd->obj = hcl_makecnode(hcl, kw_to_cnode_type(TOKEN_TYPE(hcl)), 0, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
goto auto_xlist;
case HCL_TOK_ELLIPSIS:
frd->obj = hcl_makecnodeellipsis(hcl, 0, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
goto auto_xlist;

1
t/Makefile.am
View File

@ -21,7 +21,6 @@ check_ERRORS = \
mlist-5001.err \
var-5001.err \
var-5002.err \
var-5003.err \
var-5004.err
##noinst_SCRIPTS = $(check_SCRIPTS)

1
t/Makefile.in
View File

@ -493,7 +493,6 @@ check_ERRORS = \
mlist-5001.err \
var-5001.err \
var-5002.err \
var-5003.err \
var-5004.err
EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)

2
t/call-5001.err
View File

@ -64,7 +64,7 @@ try {} catch ##ERROR: syntax error - no exception variable for 'catch'
try {
throw "excetion message"
} catch (e a) { ##ERROR: syntax error - not proper exception variable
} catch (e a) { ##ERROR: syntax error - improper exception variable for 'catch'
printf "EXCEPTION - %s\n" e
}

52
t/class-5001.err
View File

@ -15,6 +15,43 @@ class B + ##ERROR: syntax error - prohibited binary selector '+'
---
class A [ a ] {
| j | ##ERROR: syntax error - variable declaration disallowed in class init scope
}
---
class 10 [ a ] { ##ERROR: syntax error - invalid class name '10' for 'class'
}
---
class class { ##ERROR: syntax error - invalid class name 'class' for 'class'
}
---
class super.a [ a ] { ##ERROR: syntax error - invalid class name 'super.a' for 'class'
}
---
class a: 20 { ##ERROR: syntax error - invalid superclass name '20' after ':' for 'class'
}
---
class a: class { ##ERROR: syntax error - invalid superclass name 'class' after ':' for 'class'
}
---
class a: #(1 2) { ##ERROR: syntax error - no valid superclass name after ':' for 'class'
}
---
J := 11
class B {
if (== J 10) {
@ -44,7 +81,7 @@ class B [ x y ] {
};
class X :: B [ a b ] {
class X: B [ a b ] {
fun(#ci) new(t) {
| a |
set self.a t;
@ -194,3 +231,16 @@ class a {
fun() { ##ERROR: syntax error - unnamed function defined with 'fun' prohibited in class initialziation context
}
}
---
class X10 [ x ] {
fun(#ci) make() { x := 1234; return self; };
fun get-x() { return x };
}
X11 := (class:X10 {
})
class X11 { ##ERROR: exception not handled - "prohibited redefintion of X11"
}

17
t/feed-5001.err
View File

@ -134,23 +134,6 @@ printf if; ##ERROR: syntax error - 'if' prohibited in this context
---
fun :: fun1() { ##ERROR: syntax error - invalid function name '::' for 'fun'
return 10;
};
---
fun fun fun1() { ##ERROR: syntax error - invalid function name 'fun' for 'fun'
return 10;
};
---
fun(#ci) fun1() { ##ERROR: syntax error - unsupported attribute list for plain function 'fun1'
}
---
(10 + 20 30) ##ERROR: syntax error - redundant operand '30'
---

2
t/fun-01.hcl
View File

@ -96,7 +96,7 @@ if (== y 29) {
## --------------------------------------
defclass A [ a b c ] {
class A [ a b c ] {
fun(#ci) newInstance(x y z) {
set a x
set b y

2
t/insta-01.hcl
View File

@ -26,7 +26,7 @@ class A [ a b c ] {
fun get-c() { return self.c; };
};
class B :: A [ d e f ] {
class B: A [ d e f ] {
fun(#ci) newInstance(x y z) {
super:newInstance (* x 2) (* y 2) (* z 2);

15
t/insta-02.hcl
View File

@ -37,6 +37,7 @@ v := (dic.get j 4512);
if (nqv? v 1234) { printf "ERROR: v is not 1234\n" } \
else { printf "OK: value is %d\n" v };
## --------------------------------------------------------------
class X0 [ a b c d ] {
@ -175,3 +176,17 @@ else { printf "OK: value is %d\n" v }
v := { X5:t; (X6:t) + 10 }
if (nqv? v 50) { printf "ERROR: v is not 50 - %d\n" v } \
else { printf "OK: value is %d\n" v }
## --------------------------------------------------------------
class X10 [ x ] {
fun(#ci) make() { x := 1234; return self; };
fun get-x() { return x };
}
X11 := (class:X10 {
})
v := (X11:make)
v := (v:get-x)
if (== v 1234) { printf "OK: v is %d\n" v } \
else {printf "ERROR: v is %d, not 1234\n" v }

2
t/retvar-01.hcl
View File

@ -31,7 +31,7 @@
## test return variables in message sends
defclass B [ [X1 X2] ] {
class B [ [X1 X2] ] {
set X1 999;
set X2 888;

2
t/var-5001.err
View File

@ -1,4 +1,4 @@
defclass A [ a ] {
class A [ a ] {
fun(#ci) init1() {
| b |
set b (+ 1 2);

3
t/var-5003.err
View File

@ -1,3 +0,0 @@
defclass A [ a ] {
| j | ##ERROR: syntax error - variable declaration disallowed in class init scope
};

34
t/var-5004.err
View File

@ -64,3 +64,37 @@ fun x (... a) { ##ERROR: syntax error - unexpected token 'a' after '...' for 'fu
fun x (... : a) { ##ERROR: syntax error - : disallowed
}
---
fun :: fun1() { ##ERROR: syntax error - invalid function name '::' for 'fun'
return 10;
};
---
fun fun fun1() { ##ERROR: syntax error - invalid function name 'fun' for 'fun'
return 10;
};
---
fun(#ci) fun1() { ##ERROR: syntax error - attribute list prohibited on plain function 'fun1'
}
---
fun() () { ##ERROR: syntax error - attribute list prohibited on unamed function for 'fun'
}
---
fun() X:y() { ##ERROR: syntax error - empty attribute list on 'X:y' for 'fun'
}
---
class X {
fun() y() { ##ERROR: syntax error - empty attribute list on 'y' for 'fun'
}
}