diff --git a/lib/comp.c b/lib/comp.c index 28b3c2f..b9d766f 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -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; } diff --git a/lib/exec.c b/lib/exec.c index 93488ce..fed6651 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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) diff --git a/t/insta-02.hcl b/t/insta-02.hcl index 7243e80..304a8bb 100644 --- a/t/insta-02.hcl +++ b/t/insta-02.hcl @@ -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 }