added some code to handle defclass

This commit is contained in:
hyung-hwan 2021-05-29 05:44:29 +00:00
parent 6cf198dbc5
commit b41be3e5c4
4 changed files with 105 additions and 2 deletions

View File

@ -1587,6 +1587,90 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
return patch_nearest_post_if_body(hcl, cmd); return patch_nearest_post_if_body(hcl, cmd);
} }
/* ========================================================================= */
static int compile_defclass (hcl_t* hcl, hcl_cnode_t* src)
{
/*
(defclass A
| x y | ; instance variables
| ::: x y z | ; class variables <--- how to initialize the class variables???
(defcmethod new (a b c)
(printf "%O\n" self) ; self is A
(set obj super.new)
(obj.init a b c)
;(obj.x 10)
;(obj.y 20)
(return obj)
)
)
(defclass B ::: A ; A is a parent class
| p q |
....
)
*/
hcl_cnode_t* cmd, * obj, * args;
hcl_cnode_t* defun_name;
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_DEFUN));
if (!obj)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(src), HCL_NULL, "no 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))
{
/* defclass followed by a class name */
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 a defun name");
return -1;
}
obj = HCL_CNODE_CONS_CDR(obj);
}
else
{
/* no class name specified */
class_name = HCL_NULL;
}
if (HCL_CNODE_IS_ELLIPSIS(arg))
{
/* superclass */
}
if (!obj)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(src), HCL_NULL, "no argument list 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 argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
HCL_CNODE_CONS_CAR(obj);
return 0;
}
/* ========================================================================= */ /* ========================================================================= */
static int collect_local_vardcl (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t** nextobj, hcl_oow_t tv_dup_check_start, hcl_oow_t* nvardcls) static int collect_local_vardcl (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t** nextobj, hcl_oow_t tv_dup_check_start, hcl_oow_t* nvardcls)
@ -2573,6 +2657,10 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
if (compile_continue(hcl, obj) <= -1) return -1; if (compile_continue(hcl, obj) <= -1) return -1;
break; break;
case HCL_SYNCODE_DEFCLASS:
if (compile_defclass(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_DEFUN: case HCL_SYNCODE_DEFUN:
if (compile_lambda(hcl, obj, 1) <= -1) return -1; if (compile_lambda(hcl, obj, 1) <= -1) return -1;
break; break;

View File

@ -3729,15 +3729,22 @@ static int execute (hcl_t* hcl)
case HCL_CODE_MAKE_CLASS: case HCL_CODE_MAKE_CLASS:
{ {
/* push nivars
push ncvars
push superclass
//push ivarnames
//push cvarnames
make_classs
*/
hcl_oop_t t, sc, nivars, ncvars; hcl_oop_t t, sc, nivars, ncvars;
LOG_INST_0 (hcl, "make_class"); LOG_INST_0 (hcl, "make_class");
sc = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl); sc = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
nivars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
ncvars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl); ncvars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(nivars)); nivars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(ncvars)); HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(ncvars));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(nivars));
t = hcl_makeclass(hcl, sc, HCL_OOP_TO_SMOOI(nivars), HCL_OOP_TO_SMOOI(ncvars)); t = hcl_makeclass(hcl, sc, HCL_OOP_TO_SMOOI(nivars), HCL_OOP_TO_SMOOI(ncvars));
if (HCL_UNLIKELY(!t)) if (HCL_UNLIKELY(!t))
@ -3749,6 +3756,11 @@ static int execute (hcl_t* hcl)
HCL_STACK_PUSH (hcl, t); /* push the class created */ HCL_STACK_PUSH (hcl, t); /* push the class created */
break; break;
} }
/*case HCL_CODE_MAKE_METHOD:
{
}*/
/* -------------------------------------------------------- */ /* -------------------------------------------------------- */
case HCL_CODE_DUP_STACKTOP: case HCL_CODE_DUP_STACKTOP:

View File

@ -43,6 +43,7 @@ static struct
{ 5, { 'b','r','e','a','k' }, HCL_SYNCODE_BREAK, HCL_OFFSETOF(hcl_t,_break) }, { 5, { 'b','r','e','a','k' }, HCL_SYNCODE_BREAK, HCL_OFFSETOF(hcl_t,_break) },
{ 5, { 'c','a','t','c','h' }, HCL_SYNCODE_CATCH, HCL_OFFSETOF(hcl_t,_catch) }, { 5, { 'c','a','t','c','h' }, HCL_SYNCODE_CATCH, HCL_OFFSETOF(hcl_t,_catch) },
{ 8, { 'c','o','n','t','i','n','u','e' }, HCL_SYNCODE_CONTINUE, HCL_OFFSETOF(hcl_t,_continue) }, { 8, { 'c','o','n','t','i','n','u','e' }, HCL_SYNCODE_CONTINUE, HCL_OFFSETOF(hcl_t,_continue) },
{ 8, { 'd','e','f','c','l','a','s','s' }, HCL_SYNCODE_DEFCLASS, HCL_OFFSETOF(hcl_t,_defclass) },
{ 5, { 'd','e','f','u','n' }, HCL_SYNCODE_DEFUN, HCL_OFFSETOF(hcl_t,_defun) }, { 5, { 'd','e','f','u','n' }, HCL_SYNCODE_DEFUN, HCL_OFFSETOF(hcl_t,_defun) },
{ 2, { 'd','o' }, HCL_SYNCODE_DO, HCL_OFFSETOF(hcl_t,_do) }, { 2, { 'd','o' }, HCL_SYNCODE_DO, HCL_OFFSETOF(hcl_t,_do) },
{ 4, { 'e','l','i','f' }, HCL_SYNCODE_ELIF, HCL_OFFSETOF(hcl_t,_elif) }, { 4, { 'e','l','i','f' }, HCL_SYNCODE_ELIF, HCL_OFFSETOF(hcl_t,_elif) },

View File

@ -1505,6 +1505,7 @@ struct hcl_t
hcl_oop_t _break; /* symbol */ hcl_oop_t _break; /* symbol */
hcl_oop_t _catch; /* symbol */ hcl_oop_t _catch; /* symbol */
hcl_oop_t _continue; /* symbol */ hcl_oop_t _continue; /* symbol */
hcl_oop_t _defclass; /* symbol */
hcl_oop_t _defun; /* symbol */ hcl_oop_t _defun; /* symbol */
hcl_oop_t _do; /* symbol */ hcl_oop_t _do; /* symbol */
hcl_oop_t _elif; /* symbol */ hcl_oop_t _elif; /* symbol */
@ -1784,6 +1785,7 @@ enum hcl_syncode_t
HCL_SYNCODE_BREAK, HCL_SYNCODE_BREAK,
HCL_SYNCODE_CATCH, HCL_SYNCODE_CATCH,
HCL_SYNCODE_CONTINUE, HCL_SYNCODE_CONTINUE,
HCL_SYNCODE_DEFCLASS,
HCL_SYNCODE_DEFUN, HCL_SYNCODE_DEFUN,
HCL_SYNCODE_DO, HCL_SYNCODE_DO,
HCL_SYNCODE_ELIF, HCL_SYNCODE_ELIF,