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

broken code - trying to put the name field to class
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-07-15 19:37:26 +09:00
parent 43062e4db3
commit e1de4624fd
4 changed files with 62 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
lib/comp.c
View File

@ -1631,6 +1631,7 @@ enum
{
COP_COMPILE_OBJECT,
COP_COMPILE_OBJECT_R,
COP_COMPILE_SYMBOL_LITERAL,
COP_COMPILE_ARGUMENT_LIST,
COP_COMPILE_OBJECT_LIST,
@ -2548,7 +2549,7 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
if (obj && HCL_CNODE_IS_CONS(obj))
{
class_name = HCL_CNODE_CONS_CAR(obj);
if (HCL_CNODE_IS_SYMBOL(class_name))
if (HCL_CNODE_IS_SYMBOL_PLAIN(class_name))
{
/* to handle 'class' in place of 'defclass' */
defclass = 1;
@ -2561,40 +2562,35 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
if (obj)
{
hcl_cnode_t* tmp, * dcl;
hcl_cnode_t* marker, * tmp, * dcl;
tmp = HCL_CNODE_CONS_CAR(obj);
if (/*!HCL_CNODE_IS_COLON(tmp)*/!HCL_CNODE_IS_DBLCOLONS(tmp)) goto no_superclass;
marker = HCL_CNODE_CONS_CAR(obj);
if (/*!HCL_CNODE_IS_COLON(marker)*/!HCL_CNODE_IS_DBLCOLONS(marker)) goto no_superclass;
tmp = obj;
obj = HCL_CNODE_CONS_CDR(obj);
if (!obj || !HCL_CNODE_IS_CONS(obj))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_EOX, HCL_CNODE_GET_LOC(tmp), HCL_NULL, "no expression or declaration after triple colons");
hcl_setsynerrbfmt (hcl, HCL_SYNERR_EOX, HCL_CNODE_GET_LOC(tmp), HCL_NULL, "no expression or declaration after double colons");
return -1;
}
/* if the tricolons symbol is followed by a variable declaration list,
* there is no superclass */
dcl = HCL_CNODE_CONS_CAR(obj);
if (HCL_CNODE_IS_CONS_CONCODED(dcl, HCL_CONCODE_VLIST))
{
obj = tmp; /* rewind to the cons cell of the triple colons */
goto no_superclass;
}
/* superclass part */
tmp = HCL_CNODE_CONS_CAR(obj);
if (!HCL_CNODE_IS_SYMBOL_PLAIN(tmp)) {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(tmp), HCL_NULL, "no valid superclass name found after %.*js", HCL_CNODE_GET_TOKLEN(marker), HCL_CNODE_GET_TOKPTR(marker));
return -1;
}
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, tmp); /* 1 - superclass expression */
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 - class name */
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 4 - class name */
cf = GET_SUBCFRAME(hcl);
cf->u._class.nsuperclasses = 0; /* unsed for CLASS_P2 */
cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
cf->u._class.cmd_cnode = cmd;
obj = HCL_CNODE_CONS_CDR(obj);
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 2 - variables declaraions and actual body */
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 3 - variables declaraions and actual body */
cf = GET_SUBCFRAME(hcl);
cf->u._class.nsuperclasses = 1; /* this one needs to change if we support multiple superclasses... */
cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
@ -2609,13 +2605,18 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
cf->u._class.cmd_cnode = cmd;
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 2 */
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 */
cf = GET_SUBCFRAME(hcl);
cf->u._class.nsuperclasses = 0; /* unsed for CLASS_P2 */
cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
cf->u._class.cmd_cnode = cmd;
}
if (class_name)
PUSH_SUBCFRAME (hcl, COP_COMPILE_SYMBOL_LITERAL, class_name); /* 2 - class name */
else
PUSH_SUBCFRAME (hcl, COP_COMPILE_OBJECT, hcl->_nil); /* 2 - push nil for class name */
return 0;
}
@ -2792,15 +2793,15 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl)
cf->u.set.mode = VAR_ACCESS_STORE;
#endif
#if 0
#if 0
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P3, cf->operand);
#endif
#endif
}
else
{
#if 0
#if 0
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_CLASS_P3, cf->operand);
#endif
#endif
POP_CFRAME (hcl);
}
@ -4600,6 +4601,29 @@ static hcl_oop_t string_to_fpdec (hcl_t* hcl, hcl_oocs_t* str, const hcl_loc_t*
return hcl_makefpdec(hcl, v, scale);
}
static int compile_symbol_literal (hcl_t* hcl)
{
hcl_cframe_t* cf;
hcl_cnode_t* oprnd;
hcl_oop_t lit;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_SYMBOL_LITERAL);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
oprnd = cf->operand;
HCL_ASSERT (hcl, HCL_CNODE_GET_TYPE(oprnd) == HCL_CNODE_SYMBOL);
/* treat a symbol as a string */
/* TODO: do i need to create a symbol literal like smalltalk? */
lit = hcl_makestring(hcl, HCL_CNODE_GET_TOKPTR(oprnd), HCL_CNODE_GET_TOKLEN(oprnd), 0);
if (HCL_UNLIKELY(!lit)) return -1;
if (emit_push_literal(hcl, lit, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;
POP_CFRAME (hcl);
return 0;
}
static int compile_object (hcl_t* hcl)
{
hcl_cframe_t* cf;
@ -6092,6 +6116,10 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
if (compile_object_r(hcl) <= -1) goto oops;
break;
case COP_COMPILE_SYMBOL_LITERAL:
if (compile_symbol_literal(hcl) <= -1) goto oops;
break;
case COP_COMPILE_ARGUMENT_LIST:
case COP_COMPILE_OBJECT_LIST:
case COP_COMPILE_OBJECT_LIST_TAIL:

12
lib/exec.c
View File

@ -3833,11 +3833,12 @@ static int execute (hcl_t* hcl)
case HCL_CODE_CLASS_ENTER:
{
/* push superclass
push ivars
push cvars
push class_name
push ivars_string
push cvars_string
class_enter nsuperclasses nivars ncvars
*/
hcl_oop_t t, superclass, ivars_str, cvars_str;
hcl_oop_t t, superclass, ivars_str, cvars_str, class_name;
hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1); /* nsuperclasses */
@ -3860,6 +3861,9 @@ static int execute (hcl_t* hcl)
}
else ivars_str = hcl->_nil;
HCL_STACK_POP_TO(hcl, class_name);
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, class_name) || HCL_IS_STRING(hcl, class_name));
if (b1 > 0)
{
HCL_STACK_POP_TO (hcl, superclass); /* TODO: support more than 1 superclass later when the compiler supports more */
@ -3872,7 +3876,7 @@ static int execute (hcl_t* hcl)
}
else superclass = hcl->_nil;
t = hcl_makeclass(hcl, superclass, b2, b3, ivars_str, cvars_str); /* TOOD: pass variable information... */
t = hcl_makeclass(hcl, class_name, superclass, b2, b3, ivars_str, cvars_str); /* TOOD: pass variable information... */
if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement;
/* push the class created to the class stack. but don't push to the normal operation stack */

1
lib/hcl.h
View File

@ -2893,6 +2893,7 @@ HCL_EXPORT hcl_oop_t hcl_makedic (
HCL_EXPORT hcl_oop_t hcl_makeclass (
hcl_t* hcl,
hcl_oop_t name,
hcl_oop_t superclass,
hcl_ooi_t nivars,
hcl_ooi_t ncvars,

6
lib/obj.c
View File

@ -461,10 +461,11 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale)
return (hcl_oop_t)f;
}
hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t superclass, hcl_ooi_t nivars, hcl_ooi_t ncvars, hcl_oop_t ivars_str, hcl_oop_t cvars_str)
hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t class_name, hcl_oop_t superclass, hcl_ooi_t nivars, hcl_ooi_t ncvars, hcl_oop_t ivars_str, hcl_oop_t cvars_str)
{
hcl_oop_class_t c;
hcl_pushvolat (hcl, &class_name);
hcl_pushvolat (hcl, &superclass);
hcl_pushvolat (hcl, &ivars_str);
hcl_pushvolat (hcl, &cvars_str);
@ -473,7 +474,7 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t superclass, hcl_ooi_t nivars, hcl
#else
c = (hcl_oop_class_t)hcl_instantiate(hcl, hcl->c_class, HCL_NULL, ncvars);
#endif
hcl_popvolats (hcl, 3);
hcl_popvolats (hcl, 4);
if (HCL_UNLIKELY(!c))
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
@ -484,6 +485,7 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t superclass, hcl_ooi_t nivars, hcl
c->spec = HCL_SMOOI_TO_OOP(0); /* TODO: fix this - encode nivars and nivars_super to spec??? */
c->selfspec = HCL_SMOOI_TO_OOP(0); /* TODO: fix this - encode ncvars to selfspec??? */
c->name = class_name;
c->superclass = superclass;
c->nivars = HCL_SMOOI_TO_OOP(nivars);
c->ncvars = HCL_SMOOI_TO_OOP(ncvars);