enhanced the print function to print the class name for a class

enahnced the compiler to handle class defintion better.
updated method management routines into method dictionary

lib/comp.c

@@ -2497,9 +2497,10 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
 
 static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
 {
-	hcl_cnode_t* cmd, * obj;
-	hcl_cnode_t* class_name;
 	hcl_cframe_t* cf;
+	hcl_cnode_t* cmd, * obj, * tmp;
+	hcl_cnode_t* class_name, * superclass;
+	int nsuperclasses;
 
 	cmd = HCL_CNODE_CONS_CAR(src);
 	obj = HCL_CNODE_CONS_CDR(src);
@@ -2512,7 +2513,7 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
 	class_as_defclass:
 		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));
+			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))
@@ -2538,8 +2539,6 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
 			return -1;
 		}
 
-/* TODO: check if a class name is one of the kernel classes. arrange to emit CLASS_LOAD instead of CLASS_ENTER */
-
 		obj = HCL_CNODE_CONS_CDR(obj);
 	}
 	else
@@ -2560,64 +2559,64 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
 		class_name = HCL_NULL;
 	}
 
-	if (obj)
+	if (!obj)
 	{
-		hcl_cnode_t* marker, * tmp, * dcl;
+		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;
+	}
 
-		marker = HCL_CNODE_CONS_CAR(obj);
+	tmp = HCL_CNODE_CONS_CAR(obj);
-		if (/*!HCL_CNODE_IS_COLON(marker)*/!HCL_CNODE_IS_DBLCOLONS(marker)) goto no_superclass;
+	if (/*HCL_CNODE_IS_COLON(tmp) || */HCL_CNODE_IS_DBLCOLONS(tmp))
+	{
+		hcl_cnode_t* marker;
 
-		tmp = obj;
+		marker = tmp;
 		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 double colons");
+			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;
 		}
 
 		/* superclass part */
-		tmp = HCL_CNODE_CONS_CAR(obj);
+		superclass = HCL_CNODE_CONS_CAR(obj);
-		if (!HCL_CNODE_IS_SYMBOL_PLAIN(tmp))
+		if (!HCL_CNODE_IS_SYMBOL_PLAIN(superclass))
 		{
-			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));
+			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));
 			return -1;
 		}
-		SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, tmp); /* 1 - superclass expression */
 
-		PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 4 - class name */
+	//SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, tmp); /* 1 - superclass expression */
-		cf = GET_SUBCFRAME(hcl);
+		nsuperclasses = 1;
-		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); /* 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? */
-		cf->u._class.cmd_cnode = cmd;
-
-		PUSH_SUBCFRAME (hcl, COP_COMPILE_SYMBOL_LITERAL, class_name); /* 2 - class name */
 	}
 	else
 	{
-	no_superclass:
+		nsuperclasses = 0;
-		SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, &hcl->c->fake_cnode.nil); /* 1 - push nil for class name */
+		superclass = HCL_NULL;
-
-		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;
-
-		PUSH_SUBCFRAME(hcl, COP_COMPILE_CLASS_P1, obj); /* 2 */
-		cf = GET_TOP_CFRAME(hcl);
-		cf->u._class.nsuperclasses = 0; /* 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? */
-		cf->u._class.cmd_cnode = cmd;
 	}
 
+	if (class_name)
+		SWITCH_TOP_CFRAME (hcl, COP_COMPILE_SYMBOL_LITERAL, class_name); /* 1 - push nil for class name */
+	else
+		SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, &hcl->c->fake_cnode.nil); /* 1 - push nil for class name */
 
+	PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 - use class name for assignment */
+	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;
+
+	PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 2 - variables declaraions and actual body */
+	cf = GET_SUBCFRAME(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 */
 	return 0;
 }
 
@@ -4617,7 +4616,7 @@ static int compile_symbol_literal (hcl_t* hcl)
 
 	/* 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);
+	lit = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(oprnd), HCL_CNODE_GET_TOKLEN(oprnd));
 	if (HCL_UNLIKELY(!lit)) return -1;
 
 	if (emit_push_literal(hcl, lit, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;

lib/dic.c

@@ -95,7 +95,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc)
 	return newbuc;
 }
 
-static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key, hcl_oop_t value)
+static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key, hcl_oop_t value, int is_method)
 {
 	hcl_ooi_t tally;
 	hcl_oow_t index;
@@ -120,33 +120,42 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k
 	/* find */
 	while (dic->bucket->slot[index] != hcl->_nil)
 	{
-	#if defined(SYMBOL_ONLY_KEY)
+#if defined(SYMBOL_ONLY_KEY)
+		/* nothing */
+#else
+		int n;
+#endif
+
 		ass = (hcl_oop_cons_t)dic->bucket->slot[index];
 		HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass));
-		HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car));
 
+#if defined(SYMBOL_ONLY_KEY)
+		HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car));
 		if (HCL_OBJ_GET_SIZE(key) == HCL_OBJ_GET_SIZE(ass->car) &&
 		    hcl_equal_oochars(HCL_OBJ_GET_CHAR_SLOT(key), HCL_OBJ_GET_CHAR_SLOT(ass->car), HCL_OBJ_GET_SIZE(key)))
-		{
+#else
-			/* the value of HCL_NULL indicates no insertion or update. */
-			if (value) ass->cdr = value; /* update */
-			return ass;
-		}
-	#else
-		int n;
-
-		ass = (hcl_oop_cons_t)dic->bucket->slot[index];
-		HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass));
-
 		n = hcl_equalobjs(hcl, key, ass->car);
 		if (n <= -1) return HCL_NULL;
 		if (n >= 1)
+#endif
 		{
 			/* the value of HCL_NULL indicates no insertion or update. */
-			if (value) ass->cdr = value; /* update */
+			if (value)
+			{
+				if (is_method)
+				{
+					HCL_ASSERT (hcl, HCL_IS_CONS(hcl, ass->cdr));
+					HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, value));
+					if (is_method & 1) ((hcl_oop_cons_t)(ass->cdr))->car = value; /* class method */
+					if (is_method & 2) ((hcl_oop_cons_t)(ass->cdr))->cdr = value; /* instance method */
+					/* the class instantiation method goes to both cells.
+					 * you can't define a class method or an instance method with the name of
+					 * a class instantiation method */
+				}
+				else ass->cdr = value; /* normal update */
+			}
 			return ass;
 		}
-	#endif
 
 		index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket);
 	}
@@ -195,22 +204,33 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k
 
 		dic->bucket = bucket;
 
-	#if defined(SYMBOL_ONLY_KEY)
+#if defined(SYMBOL_ONLY_KEY)
 		/* recalculate the index for the expanded bucket */
 		index = hcl_hash_oochars(HCL_OBJ_GET_CHAR_SLOT(key), HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket);
-	#else
+#else
 		hcl_hashobj(hcl, key, &index); /* this must succeed as i know 'key' is hashable */
 		index %= HCL_OBJ_GET_SIZE(dic->bucket);
-	#endif
+#endif
-
 		while (dic->bucket->slot[index] != hcl->_nil)
 			index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket);
 	}
 
+	if (is_method)
+	{
+		/* create a new association that holds a class method at the first cell and an instance method at the second cell */
+		hcl_oop_t newval;
+		HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, value));
+		hcl_pushvolat (hcl, &key);
+		newval = hcl_makecons(hcl, (is_method & 1? value: hcl->_nil), (is_method & 2? value: hcl->_nil));
+		hcl_popvolat (hcl);
+		if (HCL_UNLIKELY(!newval)) goto oops;
+		value = newval;
+	}
+
 	/* create a new assocation of a key and a value since
 	 * the key isn't found in the root dictionary */
 	ass = (hcl_oop_cons_t)hcl_makecons(hcl, (hcl_oop_t)key, value);
-	if (!ass) goto oops;
+	if (HCL_UNLIKELY(!ass)) goto oops;
 
 	/* the current tally must be less than the maximum value. otherwise,
 	 * it overflows after increment below */
@@ -288,7 +308,7 @@ hcl_oop_cons_t hcl_putatsysdic (hcl_t* hcl, hcl_oop_t key, hcl_oop_t value)
 #if defined(SYMBOL_ONLY_KEY)
 	HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
 #endif
-	return find_or_upsert(hcl, hcl->sysdic, key, value);
+	return find_or_upsert(hcl, hcl->sysdic, key, value, 0);
 }
 
 hcl_oop_cons_t hcl_getatsysdic (hcl_t* hcl, hcl_oop_t key)
@@ -296,7 +316,7 @@ hcl_oop_cons_t hcl_getatsysdic (hcl_t* hcl, hcl_oop_t key)
 #if defined(SYMBOL_ONLY_KEY)
 	HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
 #endif
-	return find_or_upsert(hcl, hcl->sysdic, key, HCL_NULL);
+	return find_or_upsert(hcl, hcl->sysdic, key, HCL_NULL, 0);
 }
 
 hcl_oop_cons_t hcl_lookupsysdicforsymbol_noseterr (hcl_t* hcl, const hcl_oocs_t* name)
@@ -322,7 +342,15 @@ hcl_oop_cons_t hcl_putatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key, hcl_o
 #if defined(SYMBOL_ONLY_KEY)
 	HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
 #endif
-	return find_or_upsert(hcl, dic, key, value);
+	return find_or_upsert(hcl, dic, key, value, 0);
+}
+
+hcl_oop_cons_t hcl_putatdic_method (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key, hcl_oop_t value, int mtype)
+{
+#if defined(SYMBOL_ONLY_KEY)
+	HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
+#endif
+	return find_or_upsert(hcl, dic, key, value, mtype);
 }
 
 hcl_oop_cons_t hcl_getatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key)
@@ -330,7 +358,7 @@ hcl_oop_cons_t hcl_getatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key)
 #if defined(SYMBOL_ONLY_KEY)
 	HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
 #endif
-	return find_or_upsert(hcl, dic, key, HCL_NULL);
+	return find_or_upsert(hcl, dic, key, HCL_NULL, 0);
 }
 
 int hcl_zapatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key)

lib/err.c

@@ -137,8 +137,9 @@ static char* synerrstr[] =
 	"::: disallowed",
 	"loop body too big",
 	"if body too big",
-	"lambda block too big",
+	"block too big",
-	"lambda block too deep",
+	"block too deep",
+	"name expected",
 	"argument name list expected",
 	"argument name expected",
 	"duplicate argument name",

lib/exec.c

@@ -2163,7 +2163,6 @@ static hcl_oop_lambda_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class
 	{
 		hcl_oop_t dic;
 
-
 		dic = class_->mdic;
 		HCL_ASSERT (hcl, HCL_IS_NIL(hcl, dic) || HCL_IS_DIC(hcl, dic));
 
@@ -3862,7 +3861,7 @@ 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));
+				HCL_ASSERT (hcl, HCL_IS_NIL(hcl, class_name) || HCL_IS_SYMBOL(hcl, class_name));
 
 				if (b1 > 0)
 				{
@@ -3876,6 +3875,17 @@ static int execute (hcl_t* hcl)
  				}
 				else superclass = hcl->_nil;
 
+//////////////
+hcl_logbfmt(hcl, HCL_LOG_STDERR, "class_name in class_enter 111>>>[%O]<<<\n", class_name);
+				if (HCL_IS_SYMBOL(hcl, class_name))
+				{
+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,  .... */
+				}
+//////////////
+
 				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;
 
@@ -3914,46 +3924,41 @@ static int execute (hcl_t* hcl)
 			}
 
 			case HCL_CODE_CLASS_CMSTORE:
-			case HCL_CODE_CLASS_CIMSTORE:
 			case HCL_CODE_CLASS_IMSTORE:
+			case HCL_CODE_CLASS_CIMSTORE:
 			{
-				hcl_oop_t class_;
+				hcl_oop_t _class;
 				hcl_oop_t mdic, cons, blk, car, cdr, name;
+				int mtype;
+				static hcl_bch_t* pfx[] = { "c", "i", "ci" };
 
+				mtype = (bcode - HCL_CODE_CLASS_CMSTORE) + 1;
 				FETCH_PARAM_CODE_TO (hcl, b1);
-				LOG_INST_2 (hcl, "class_%hsmstore @%zu", (bcode == HCL_CODE_CLASS_CMSTORE? "c": (bcode == HCL_CODE_CLASS_CIMSTORE? "ci": "i")), b1);
+				LOG_INST_2 (hcl, "class_%hsmstore @%zu", pfx[mtype], b1);
 
 				/* store the stack top in the member dictionary of the currect class with the key indicated by 'b1' */
 
 				HCL_ASSERT (hcl, !HCL_CLSTACK_IS_EMPTY(hcl));
 
-				HCL_CLSTACK_FETCH_TOP_TO (hcl, class_);
+				HCL_CLSTACK_FETCH_TOP_TO (hcl, _class);
-				HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, class_));
+				HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, _class));
 
-				mdic = ((hcl_oop_class_t)class_)->mdic; /* instance-side dictionary */
+				mdic = ((hcl_oop_class_t)_class)->mdic; /* instance-side dictionary */
 				HCL_ASSERT (hcl, HCL_IS_NIL(hcl, mdic) || HCL_IS_DIC(hcl, mdic));
 				if (HCL_IS_NIL(hcl, mdic))
 				{
-					hcl_pushvolat (hcl, (hcl_oop_t*)&class_);
+					hcl_pushvolat (hcl, (hcl_oop_t*)&_class);
 					mdic = hcl_makedic(hcl, 16); /* TODO: configurable initial size? */
 					hcl_popvolat (hcl);
 					if (HCL_UNLIKELY(!mdic)) goto oops_with_errmsg_supplement;
-					((hcl_oop_class_t)class_)->mdic = mdic;
+					((hcl_oop_class_t)_class)->mdic = mdic;
 				}
 
 				blk = HCL_STACK_GETTOP(hcl);
-				hcl_pushvolat (hcl, (hcl_oop_t*)&mdic);
-				/* let car point to the instance method,
-				 * let cdr point to the class method */
-				car = (bcode == HCL_CODE_CLASS_IMSTORE? hcl->_nil: blk);
-				cdr = (bcode == HCL_CODE_CLASS_CMSTORE? hcl->_nil: blk);
-				cons = hcl_makecons(hcl, car, cdr);
-				hcl_popvolat (hcl);
-				if (HCL_UNLIKELY(!cons)) goto oops_with_errmsg_supplement;
-
-				/* put the code at method dictionary */
 				name = hcl->active_function->literal_frame[b1]; /* method name */
-				if (!hcl_putatdic(hcl, (hcl_oop_dic_t)mdic, name, cons)) goto oops_with_errmsg_supplement;
+				/* put the code at method dictionary
+				   pass 1 for class method, 2 for instance method, 3 for class instantiation method */
+				if (!hcl_putatdic_method(hcl, (hcl_oop_dic_t)mdic, name, blk, mtype)) goto oops_with_errmsg_supplement;
 				break;
 			}
 			/* -------------------------------------------------------- */

lib/hcl-prv.h

@@ -1339,8 +1339,8 @@ enum hcl_bcode_t
 
 	HCL_CODE_PUSH_OBJVAR_X            = 0xE4, /* 228 ## */
 	HCL_CODE_CLASS_CMSTORE            = 0xE5, /* 229 */
-	HCL_CODE_CLASS_CIMSTORE           = 0xE6, /* 230 */
+	HCL_CODE_CLASS_IMSTORE            = 0xE6, /* 230 */
-	HCL_CODE_CLASS_IMSTORE            = 0xE7, /* 231 */
+	HCL_CODE_CLASS_CIMSTORE           = 0xE7, /* 231 */
 
 	HCL_CODE_STORE_INTO_OBJVAR_X      = 0xE8, /* 232 ## */
 	HCL_CODE_MAKE_ARRAY               = 0xE9, /* 233 ## */
@@ -1536,6 +1536,18 @@ hcl_oop_t hcl_findsymbol (
 );
 
 
+/* ========================================================================= */
+/* dic.c                                                                    */
+/* ========================================================================= */
+hcl_oop_cons_t hcl_putatdic_method (
+	hcl_t*        hcl,
+	hcl_oop_dic_t dic,
+	hcl_oop_t     key,
+	hcl_oop_t     value,
+	int           mtype /* 1 for class method, 2 for instance method */
+);
+
+
 /* ========================================================================= */
 /* proc.c                                                                    */
 /* ========================================================================= */

lib/hcl.h

@@ -141,8 +141,9 @@ enum hcl_synerrnum_t
 	HCL_SYNERR_TRPCOLONSBANNED, /* ::: disallowed */
 	HCL_SYNERR_LOOPFLOOD,     /* loop body too big */
 	HCL_SYNERR_IFFLOOD,       /* if body too big */
-	HCL_SYNERR_BLKFLOOD,      /* lambda block too big */
+	HCL_SYNERR_BLKFLOOD,      /* block too big */
-	HCL_SYNERR_BLKDEPTH,      /* lambda block too deep */
+	HCL_SYNERR_BLKDEPTH,      /* block too deep */
+	HCL_SYNERR_NAME,          /* name expected */
 	HCL_SYNERR_ARGNAMELIST,   /* argument name list expected */
 	HCL_SYNERR_ARGNAME,       /* argument name expected */
 	HCL_SYNERR_ARGNAMEDUP,    /* duplicate argument name  */

lib/print.c

@@ -692,14 +692,31 @@ next:
 			goto print_word;
 
 		case HCL_BRAND_CLASS:
-			/* TODO: print the class name */
+		{
-			word_index = WORD_CLASS;
+			hcl_oop_class_t _class = (hcl_oop_class_t)obj;
-			goto print_word;
+			if (HCL_IS_NIL(hcl, _class->name))
+			{
+				word_index = WORD_CLASS;
+				goto print_word;
+			}
+			HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, _class->name));
+			if (hcl_bfmt_out(hcl, fmtout, "%.*js", HCL_OBJ_GET_SIZE(_class->name), HCL_OBJ_GET_CHAR_SLOT(_class->name)) <= -1) return -1;
+			break;
+		}
 
 		case HCL_BRAND_INSTANCE:
-			/* TODO: print the class name also */
+		{
-			word_index = WORD_INSTANCE;
+			hcl_oop_class_t _class = (hcl_oop_class_t)HCL_CLASSOF(hcl, obj);
-			goto print_word;
+			HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, _class));
+			if (HCL_IS_NIL(hcl, _class->name))
+			{
+				word_index = WORD_INSTANCE;
+				goto print_word;
+			}
+			HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, _class->name));
+			if (hcl_bfmt_out(hcl, fmtout, "#INSTANCE OF %.*js", HCL_OBJ_GET_SIZE(_class->name), HCL_OBJ_GET_CHAR_SLOT(_class->name)) <= -1) return -1;
+			break;
+		}
 
 		default:
 			HCL_DEBUG3 (hcl, "Internal error - unknown object type %d at %s:%d\n", (int)brand, __FILE__, __LINE__);

mod/core.c

@@ -33,10 +33,15 @@ static hcl_pfrc_t pf_core_get_class_name (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t
 
 	obj = (hcl_oop_oop_t)HCL_STACK_GETARG(hcl, nargs, 0);
 
-	if (!HCL_IS_CLASS(hcl,obj))
+	if (!HCL_IS_CLASS(hcl, obj))
 	{
+	#if 0
 		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not a class - %O", obj);
 		return HCL_PF_FAILURE;
+	#else
+		obj = (hcl_oop_oop_t)HCL_CLASSOF(hcl, obj);
+		HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, obj));
+	#endif
 	}
 
 	HCL_STACK_SETRET (hcl, nargs, ((hcl_oop_class_t)obj)->name);