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

updated compiler to prohibit redefinition of a named class
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-07-22 17:24:26 +09:00
parent 2d120f0d0e
commit 28c05ff903
3 changed files with 76 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
lib/comp.c
View File

@ -2588,9 +2588,7 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
return -1;
}
//SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, tmp); /* 1 - superclass expression */
nsuperclasses = 1;
obj = HCL_CNODE_CONS_CDR(obj);
}
else
@ -2599,24 +2597,45 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
superclass = HCL_NULL;
}
if (class_name)
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_SYMBOL_LITERAL, class_name); /* 1 - push the class name for a named class */
else
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, &hcl->c->fake_cnode.nil); /* 1 - push nil for class name for anonymous class */
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 - use class name for assignment */
cf = GET_SUBCFRAME(hcl);
if (class_name)
{
//SWITCH_TOP_CFRAME (hcl, COP_COMPILE_SYMBOL_LITERAL, class_name); /* 1 - push the class name for a named class */
hcl_oow_t index;
hcl_oop_t cons, sym;
sym = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(class_name), HCL_CNODE_GET_TOKLEN(class_name));
if (HCL_UNLIKELY(!sym)) return -1;
cons = (hcl_oop_t)hcl_getatsysdic(hcl, sym);
if (!cons)
{
cons = (hcl_oop_t)hcl_putatsysdic(hcl, sym, hcl->_nil);
if (HCL_UNLIKELY(!cons)) return -1;
}
if (add_literal(hcl, cons, &index) <= -1) return -1;
if (emit_single_param_instruction(hcl, HCL_CODE_PUSH_LITERAL_0, index, HCL_CNODE_GET_LOC(class_name)) <= -1) return -1;
}
else
{
if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL,HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; /* push nil for class name of an anonymous class */
}
POP_CFRAME (hcl);
PUSH_CFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 - use class name for assignment */
cf = GET_TOP_CFRAME(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;
PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 2 - variables declaraions and actual body */
cf = GET_SUBCFRAME(hcl);
PUSH_CFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 2 - variables declaraions and actual body */
cf = GET_TOP_CFRAME(hcl);
cf->u._class.nsuperclasses = nsuperclasses; /* this 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? */
cf->u._class.cmd_cnode = cmd;
if (superclass) PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, superclass); /* 0 - superclass expression */
if (superclass) PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, superclass); /* 1 - superclass expression */
return 0;
}

32
lib/exec.c
View File

@ -3550,10 +3550,19 @@ static int execute (hcl_t* hcl)
/*ass = hcl->code.lit.arr->slot[b1];*/
ass = (hcl_oop_cons_t)hcl->active_function->literal_frame[b1];
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, ass));
/* this association is an entry in the system dictionary.
* it doesn't need to look up the dictionary for each access
* as the pointer to the association is in the literal frame */
if ((bcode >> 3) & 1)
{
/* store or pop */
if (HCL_IS_CLASS(hcl, ass->cdr) && ((hcl_oop_class_t)ass->cdr)->name == ass->car)
{
hcl_seterrbfmt (hcl, HCL_EPERM, "prohibited redefintion of %.*js", HCL_OBJ_GET_SIZE(ass->car), HCL_OBJ_GET_CHAR_SLOT(ass->car));
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
goto oops_with_errmsg_supplement;
}
ass->cdr = HCL_STACK_GETTOP(hcl);
if ((bcode >> 2) & 1)
@ -3857,13 +3866,13 @@ static int execute (hcl_t* hcl)
case HCL_CODE_CLASS_ENTER:
{
/* push superclass
push class_name
/* push an association with class_name as a key or push nil
push superclass (only if nsuperclassses > 0)
push ivars_string
push cvars_string
class_enter nsuperclasses nivars ncvars
*/
hcl_oop_t t, superclass, ivars_str, cvars_str, class_name;
hcl_oop_t t, superclass, ivars_str, cvars_str, class_name, class_name_ass;
hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1); /* nsuperclasses */
@ -3886,9 +3895,6 @@ 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_SYMBOL(hcl, class_name));
if (b1 > 0)
{
HCL_STACK_POP_TO (hcl, superclass); /* TODO: support more than 1 superclass later when the compiler supports more */
@ -3901,14 +3907,25 @@ static int execute (hcl_t* hcl)
}
else superclass = hcl->_nil;
HCL_STACK_POP_TO(hcl, class_name_ass);
/*HCL_ASSERT (hcl, HCL_IS_NIL(hcl, class_name) || HCL_IS_SYMBOL(hcl, class_name));*/
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, class_name_ass) || HCL_IS_CONS(hcl, class_name_ass));
//////////////
//hcl_logbfmt(hcl, HCL_LOG_STDERR, "class_name in class_enter 111>>>[%O]<<<\n", class_name);
if (HCL_IS_SYMBOL(hcl, class_name))
if (HCL_IS_CONS(hcl, class_name_ass))
{
//hcl_logbfmt(hcl, HCL_LOG_STDERR, "class_name in class_enter >>>[%O]<<<\n", class_name);
/* TODO: check if the class exists.
* check if the class is a incomlete kernel class.
* if so, .... */
class_name = ((hcl_oop_cons_t)(class_name_ass))->car;
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, class_name));
}
else
{
/* anonymous class */
class_name = hcl->_nil;
}
//////////////
@ -4089,7 +4106,6 @@ static int execute (hcl_t* hcl)
if ((bcode >> 3) & 1)
{
/* store or pop */
t->slot[b1] = HCL_STACK_GETTOP(hcl);
if ((bcode >> 2) & 1)

47
t/insta-02.hcl
View File

@ -54,10 +54,7 @@ else { printf "OK: value is %d\n" v }
## --------------------------------------------------------------
class F [ j t ] {
}
class X [ a b c ] {
class X1 [ a b c ] {
fun :* new () {
self.a := 20
return self
@ -69,27 +66,27 @@ class X [ a b c ] {
| v |
v := 50
if (t > 5) {
fun X:get_j() { return (((1 + t) + a) + (b + v)) }
fun X1:get_j() { return (((1 + t) + a) + (b + v)) }
} else {
fun X:get_j() { return ((2 * (t + a)) + (b + v)) }
fun X1:get_j() { return ((2 * (t + a)) + (b + v)) }
}
return self
}
}
fun X:get_a() {
fun X1:get_a() {
return (self:getA)
}
v := ((X:new):get_a)
v := ((X1:new):get_a)
if (nqv? v 20) { printf "ERROR: v is not 20 - %d\n" v } \
else { printf "OK: value is %d\n" v }
v := (((X:new):make 5 6 7):get_j)
v := (((X1:new):make 5 6 7):get_j)
if (nqv? v 79) { printf "ERROR: v is not 79 - %d\n" v } \
else { printf "OK: value is %d\n" v }
v := (((X:new):make 6 6 7):get_j)
v := (((X1:new):make 6 6 7):get_j)
if (nqv? v 70) { printf "ERROR: v is not 70 - %d\n" v } \
else { printf "OK: value is %d\n" v }
@ -98,7 +95,7 @@ else { printf "OK: value is %d\n" v }
class F [ j t ] {
}
class X [ a b c ] {
class X2 [ a b c ] {
fun :* new () {
| j |
self.a := 20
@ -108,33 +105,33 @@ class X [ a b c ] {
}
}
X:new
X2:new
v := (F:get_x)
if (nqv? v 1600) { printf "ERROR: v is not 1600 - %d\n" v } \
else { printf "OK: value is %d\n" v }
## --------------------------------------------------------------
class X {
class X3 {
fun :* new (a b) {
fun X:sum() { return (fun(j) { return (j + (a + b)) }) }
fun X3:sum() { return (fun(j) { return (j + (a + b)) }) }
return self;
}
}
v := (((X:new 10 2):sum) 23)
v := (((X3:new 10 2):sum) 23)
if (nqv? v 35) { printf "ERROR: v is not 35 - %d\n" v } \
else { printf "OK: value is %d\n" v }
## --------------------------------------------------------------
class X {
class X4 {
fun :: t() {
| X |
class X { ## this X isn't the local variable X
| X4 |
class X4 { ## this X4 isn't the local variable X4
fun :: t() {
X := (class {
X4 := (class {
fun :: t() {
| X |
X := (class { ## this X is the local variable X
| X4 |
X4 := (class { ## this X4 is the local variable X4
fun :: t() { return 60 }
})
return 40
@ -147,18 +144,18 @@ class X {
}
}
v := (X:t)
v := (X4:t)
if (nqv? v 30) { printf "ERROR: v is not 30 - %d\n" v } \
else { printf "OK: value is %d\n" v }
v := (X:t)
v := (X4:t)
if (nqv? v 20) { printf "ERROR: v is not 20 - %d\n" v } \
else { printf "OK: value is %d\n" v }
v := (X:t)
v := (X4:t)
if (nqv? v 40) { printf "ERROR: v is not 40 - %d\n" v } \
else { printf "OK: value is %d\n" v }
v := (X:t)
v := (X4:t)
if (nqv? v 40) { printf "ERROR: v is not 40 - %d\n" v } \
else { printf "OK: value is %d\n" v }