implementing a message sending list

lang.txt

@@ -0,0 +1,165 @@
+## dictionary list (DIC)
+	{ 1 2 3 4 }
+	{ 1: 2, 3: 4}
+	{} -> empty dictionary
+	{ 1 } -> error, no value.  dictionary requires even number of items.
+
+## array list
+	[ 1 2 3 4]
+	[ 1, 2, 3, 4 ]
+	[] -> empty array
+
+## byte array list
+	#[ 1 2 3 4 ]
+	#[  1, 2, 3, 4 ]
+	each item must be in the byte range.
+	if a given value is not a number in the allowed range, an exception error is raised.
+	(try
+		(set a 20)
+		#[ 1 2 3 (+ a 300)]  ; this throws an catchable exception.
+	catch(e)
+		(printf "EXCEPTION - %O\n" e)
+	)
+
+## non-executable list (QLIST)
+	#(1 2 3 4)
+	#(1 2 3 4 . 5)
+	#() -> same as null
+	comma not allowed to seperate items.
+
+## varaible declaration list (VLIST)
+	| a b c |
+
+
+## class declaration with methods.
+
+(defclass X 
+
+	| x y |                 ; instance variables 
+	::: | bob jim |             ; class variables
+
+	; instance variables and class variables must not collide with those of parent classes.
+	; they must not collide with method names of parent classes
+
+	(set bob "Bob")         ; can access class variables. disallowed to access instance variables
+
+	(defun setX (a)
+		(set self.x a)
+		;(super.setX a) 
+	)
+
+	; instance method. a method name must not collide with instance variable names and class variable names.
+	; the name can be the same as method names of parent classes.
+	(defun K (a b)
+		(self.Y a)
+		(return (+ a b x y))
+	)
+
+	(defun Y (a)
+		(printf ("Y=>%d [%s]\n", a, bob) 
+	)
+
+	(defun ::: KK (a b)
+		(printf "K=>%s\n", bob) ; a class method can access class variables but not instance variables
+		(return (+ a b))
+	)
+
+	(set jim (lambda (a b) (+ a b))) ; the anonymous function created is 
+)
+
+
+## method invocation
+
+a period isn't a good token to use for chaining method invocation.
+	super.a().b().c()
+		push super
+		send_to_super a
+		send_to_self b
+		send_to_self c
+		(send_to_xxx is lookup + call)
+
+
+we need a way to swap the first parameter and the called function
+(: a b 2 3 4)
+
+(a b 2 3 4)
+	(a.b.c 20 30 40) 
+	((a:b 20 30):c 30)
+	
+
+normal function call
+(f arg1 arg2 arg3)
+(rcv f arg1 arg2)
+
+(:X (f) arg1 arg2)
+as long as f returns a symbol, it can also invoke a method??
+
+
+(defun getX() X) ; ->it must return an object
+((getX)->show "hello")
+
+X.Y
+ push X
+ push_symbol Y
+ lookup
+
+(X.Y)
+ push X
+ push_symbol Y
+ lookup
+ call 0
+
+X.Y.Z
+ push X
+ push_symbol Y
+ lookup
+ push_symbol Z
+ lookup
+ 
+ --- if this is within a method, it must become push_instvar
+ self.x
+  push self
+  push symbol x
+  lookup
+
+
+
+
+fun f(a, b) 
+{
+}
+
+fun f(a, b) -> (c, d)
+{
+
+}
+
+class X
+{
+	var x, y, z
+	var! printer;
+
+	printer := Printer.new();
+
+	fun! new(a, b)
+	{
+		return super.new().init(a, b);
+	}
+
+	fun init(a, b)
+	{
+	}
+
+	fun show(a, b)
+	{
+		Printer.dump(a, b);
+	}
+
+}
+
+x := X.new(10, 20);
+x.show (40, 50);
+
+
+
+---------------

lib/comp.c

@@ -212,6 +212,33 @@ static void kill_temporary_variable_at_offset (hcl_t* hcl, hcl_oow_t offset)
 	hcl->c->tv.s.ptr[offset] = '('; /* HACK!! put a special character which can't form a variable name */
 }
 
+static int is_in_class_init_scope (hcl_t* hcl)
+{
+	hcl_fnblk_info_t* fbi;
+	fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth];
+	return (fbi->clsblk_top >= 0);
+}
+
+static int is_in_class_method_scope (hcl_t* hcl)
+{
+	hcl_oow_t i, j;
+
+	for (i = hcl->c->fnblk.depth + 1; i > 0; )
+	{
+		hcl_fnblk_info_t* fbi;
+
+		fbi = &hcl->c->fnblk.info[--i];
+
+		if (fbi->clsblk_top >= 0)
+		{
+			if (i >= hcl->c->fnblk.depth) return 0; /* in class initialization scope */
+			return 1; /* in class method scope */
+		}
+	}
+
+	return 0; /* in plain function scope */
+}
+
 static int find_variable_backward (hcl_t* hcl, const hcl_cnode_t* token, hcl_var_info_t* vi)
 {
 	hcl_oow_t i, j;
@@ -2361,7 +2388,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
 	{
 		/* empty list - no argument - (lambda () (+ 10 20)) */
 	}
-	else if (!HCL_CNODE_IS_CONS(args))
+	else if (!HCL_CNODE_IS_CONS_CONCODED(args, HCL_CONCODE_XLIST))
 	{
 		hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(args), HCL_CNODE_GET_TOK(args), "not an argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
 		return -1;
@@ -2924,9 +2951,9 @@ static HCL_INLINE int compile_catch (hcl_t* hcl)
 	}
 
 	exarg = HCL_CNODE_CONS_CAR(obj);
-	if (HCL_CNODE_IS_ELIST_CONCODED(exarg, HCL_CONCODE_XLIST) || !HCL_CNODE_IS_CONS(exarg) || hcl_countcnodecons(hcl, exarg) != 1)
+	if (!HCL_CNODE_IS_CONS_CONCODED(exarg, HCL_CONCODE_XLIST) || hcl_countcnodecons(hcl, exarg) != 1)
 	{
-		hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(exarg), HCL_NULL, "not single exception variable in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(exarg), HCL_NULL, "not proper exception variable in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
 		return -1;
 	}
 
@@ -3420,6 +3447,20 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 	return 0;
 }
 
+static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nrets)
+{
+	hcl_cnode_t* car;
+	int syncode; /* syntax code of the first element */
+
+	/* message sending 
+	 *  (: receiver message argument-list)
+	 */
+	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST));
+
+	car = HCL_CNODE_CONS_CAR(obj);
+	return 0;
+}
+
 static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj)
 {
 	hcl_var_info_t vi;
@@ -3726,6 +3767,10 @@ redo:
 					if (compile_cons_xlist_expression(hcl, oprnd, 0) <= -1) return -1;
 					break;
 
+				case HCL_CONCODE_MLIST:
+					if (compile_cons_mlist_expression(hcl, oprnd, 0) <= -1) return -1;
+					break;
+
 				case HCL_CONCODE_ARRAY:
 					if (compile_cons_array_expression(hcl, oprnd) <= -1) return -1;
 					break;
@@ -3763,6 +3808,10 @@ redo:
 					hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty executable list");
 					return -1;
 
+				case HCL_CONCODE_MLIST:
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty message send list");
+					return -1;
+
 				case HCL_CONCODE_ARRAY:
 					if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;
 					goto done;
@@ -3827,7 +3876,6 @@ static int compile_object_r (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_OBJECT_R);
@@ -4575,9 +4623,28 @@ static HCL_INLINE int post_lambda (hcl_t* hcl)
 		hcl_var_info_t vi;
 		int x;
 
+		if (is_in_class_init_scope(hcl))
+		{
+			/* method definition */
+			x = find_variable_backward(hcl, defun_name, &vi);
+			if (x <= -1) return -1;
+			if (x == 0)
+			{
+				/* save to the method slot */
+printf ("this is a method defintion...^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^.\n");
+			}
+			else
+			{
+/* TODO: proper error code */
+				hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAMEDUP, HCL_CNODE_GET_LOC(defun_name), HCL_CNODE_GET_TOK(defun_name), "duplicate name");
+				return -1;
+			}
+			cf->u.set.mode = VAR_ACCESS_STORE;
+		}
+		else
+		{
 			x = find_variable_backward(hcl, defun_name, &vi);
 			if (x <= -1) return -1;
-		
 			if (x == 0)
 			{
 				SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name);
@@ -4593,6 +4660,7 @@ static HCL_INLINE int post_lambda (hcl_t* hcl)
 			}
 			cf->u.set.mode = VAR_ACCESS_STORE;
 		}
+	}
 	else
 	{
 		POP_CFRAME (hcl);

lib/err.c

@@ -158,7 +158,8 @@ static char* synerrstr[] =
 	"invalid callable",
 	"unbalanced key/value pair",
 	"unbalanced parenthesis/brace/bracket",
-	"empty x-list"
+	"empty x-list",
+	"empty m-list"
 };
 
 /* -------------------------------------------------------------------------- 

lib/exec.c

@@ -2167,6 +2167,38 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
 
 /* ------------------------------------------------------------------------- */
 
+static void supplement_errmsg (hcl_t* hcl, hcl_ooi_t ip)
+{
+	if (hcl->active_function->dbgi != hcl->_nil)
+	{
+		hcl_dbgi_t* dbgi;
+		const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
+		hcl_errnum_t orgnum = hcl_geterrnum(hcl);
+
+		HCL_ASSERT (hcl, HCL_IS_BYTEARRAY(hcl, hcl->active_function->dbgi));
+		dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
+
+		hcl_seterrbfmt (hcl, orgnum, "%js (%js:%zu)", orgmsg,
+			(dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline);
+	}
+}
+
+static int do_throw_with_internal_errmsg (hcl_t* hcl, hcl_ooi_t ip)
+{
+	hcl_oop_t ex;
+/* TODO: considuer throwing an exception object instead of a string? */
+	ex = hcl_makestring(hcl, hcl->errmsg.buf, hcl->errmsg.len, 0);
+	if (HCL_UNLIKELY(!ex))
+	{
+		supplement_errmsg (hcl, ip);
+		return -1;
+	}
+	if (do_throw(hcl, ex, ip) <= -1) return -1;
+	return 0;
+}
+
+/* ------------------------------------------------------------------------- */
+
 
 #if 0
 /* EXPERIMENTAL CODE INTEGRATING EXTERNAL COMMANDS */
@@ -2844,22 +2876,6 @@ static void xma_dumper (void* ctx, const char* fmt, ...)
 	va_end (ap);
 }
 
-static void supplement_errmsg (hcl_t* hcl, hcl_ooi_t ip)
-{
-	if (hcl->active_function->dbgi != hcl->_nil)
-	{
-		hcl_dbgi_t* dbgi;
-		const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
-		hcl_errnum_t orgnum = hcl_geterrnum(hcl);
-
-		HCL_ASSERT (hcl, HCL_IS_BYTEARRAY(hcl, hcl->active_function->dbgi));
-		dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
-
-		hcl_seterrbfmt (hcl, orgnum, "%js (%js:%zu)", orgmsg,
-			(dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline);
-	}
-}
-
 static int execute (hcl_t* hcl)
 {
 	hcl_oob_t bcode;
@@ -2918,7 +2934,6 @@ static int execute (hcl_t* hcl)
 		{
 			/* ------------------------------------------------- */
 
-#if 0
 			case HCL_CODE_PUSH_INSTVAR_X:
 				FETCH_PARAM_CODE_TO (hcl, b1);
 				goto push_instvar;
@@ -2934,6 +2949,7 @@ static int execute (hcl_t* hcl)
 			push_instvar:
 				LOG_INST_1 (hcl, "push_instvar %zu", b1);
 				HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver_or_base) == HCL_OBJ_TYPE_OOP);
+	/* TODO: FIX TO OFFSET THE INHERTED PART... */
 				HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1]);
 				break;
 
@@ -2976,7 +2992,6 @@ static int execute (hcl_t* hcl)
 				((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1] = HCL_STACK_GETTOP(hcl);
 				HCL_STACK_POP (hcl);
 				break;
-#endif
 
 			/* ------------------------------------------------- */
 			case HCL_CODE_PUSH_TEMPVAR_X:
@@ -3648,6 +3663,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				{
 					hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "empty class stack");
 					supplement_errmsg (hcl, fetched_instruction_pointer);
+				/* TODO: do throw??? instead */
 					goto oops;
 				}
 				HCL_CLSTACK_FETCH_TOP_TO(hcl, t);
@@ -3664,6 +3680,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				{
 					hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "empty class stack");
 					supplement_errmsg (hcl, fetched_instruction_pointer);
+				/* TODO: do throw??? instead */
 					goto oops;
 				}
 				HCL_CLSTACK_FETCH_TOP_TO(hcl, t);
@@ -3685,6 +3702,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				{
 					hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
 					supplement_errmsg (hcl, fetched_instruction_pointer);
+				/* TODO: do throw??? instead */
 					goto oops;
 				}
 				t = HCL_OBJ_GET_CLASS(t);
@@ -3702,6 +3720,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				{
 					hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
 					supplement_errmsg (hcl, fetched_instruction_pointer);
+				/* TODO: do throw??? instead */
 					goto oops;
 				}
 				t = HCL_OBJ_GET_CLASS(t);
@@ -3831,8 +3850,9 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				t2 = HCL_STACK_GETTOP(hcl); /* array */
 				if (HCL_UNLIKELY(b1 >= HCL_OBJ_GET_SIZE(t2)))
 				{
-					hcl_seterrbfmt (hcl, HCL_ECALL, "index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2));
+					hcl_seterrbfmt (hcl, HCL_ECALL, "array index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2));
-					goto oops;
+					if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops;
+					break;
 				}
 
 				((hcl_oop_oop_t)t2)->slot[b1] = t1;
@@ -3870,10 +3890,18 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				if (!HCL_OOP_IS_SMOOI(t1) || (bv = HCL_OOP_TO_SMOOI(t1)) < 0 || bv > 255)
 				{
 					hcl_seterrbfmt (hcl, HCL_ERANGE, "not a byte or out of byte range - %O", t1);
-					goto oops;
+					if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops;
+					break;
 				}
 				HCL_STACK_POP (hcl);
-				t2 = HCL_STACK_GETTOP(hcl); /* array */
+				t2 = HCL_STACK_GETTOP(hcl); /* byte array */
+
+				if (HCL_UNLIKELY(b1 >= HCL_OBJ_GET_SIZE(t2)))
+				{
+					hcl_seterrbfmt (hcl, HCL_ECALL, "bytearray index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2));
+					if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops;
+					break;
+				}
 				((hcl_oop_byte_t)t2)->slot[b1] = bv;
 				break;
 			}

lib/hcl-prv.h

@@ -152,15 +152,16 @@ enum hcl_iotok_type_t
 	HCL_IOTOK_COLON,
 	HCL_IOTOK_TRPCOLONS,
 	HCL_IOTOK_COMMA,
-	HCL_IOTOK_LPAREN,
+	HCL_IOTOK_LPAREN,    /* ( */
-	HCL_IOTOK_RPAREN,
+	HCL_IOTOK_RPAREN,    /* ) */
+	HCL_IOTOK_LPARCOLON, /* (: */
 	HCL_IOTOK_BAPAREN,   /* #[ */
 	HCL_IOTOK_QLPAREN,   /* #( */
 	HCL_IOTOK_LBRACK,    /* [ */
 	HCL_IOTOK_RBRACK,    /* ] */
 	HCL_IOTOK_LBRACE,    /* { */
 	HCL_IOTOK_RBRACE,    /* } */
-	HCL_IOTOK_VBAR,
+	HCL_IOTOK_VBAR,      /* | */
 	HCL_IOTOK_EOL,       /* end of line */
 
 	HCL_IOTOK_INCLUDE

lib/hcl.h

@@ -163,7 +163,8 @@ enum hcl_synerrnum_t
 	HCL_SYNERR_CALLABLE,      /* invalid callable */
 	HCL_SYNERR_UNBALKV,       /* unbalanced key/value pair */
 	HCL_SYNERR_UNBALPBB,      /* unbalanced parenthesis/brace/bracket */
-	HCL_SYNERR_EMPTYXLIST     /* empty x-list */
+	HCL_SYNERR_EMPTYXLIST,    /* empty x-list */
+	HCL_SYNERR_EMPTYMLIST     /* empty m-list */
 };
 typedef enum hcl_synerrnum_t hcl_synerrnum_t;
 
@@ -1841,11 +1842,12 @@ typedef enum hcl_syncode_t hcl_syncode_t;
 enum hcl_concode_t
 {
 	/* these can be set in the SYNCODE flags for a cons cell */
-	HCL_CONCODE_XLIST = 0,  /* () - executable list */
+	HCL_CONCODE_XLIST = 0,  /* ( ) - executable list */
-	HCL_CONCODE_ARRAY,      /* [] */
+	HCL_CONCODE_MLIST,      /* (: ) - message send list */
-	HCL_CONCODE_BYTEARRAY,  /* #[] */
+	HCL_CONCODE_ARRAY,      /* [ ] */
-	HCL_CONCODE_DIC,        /* {} */
+	HCL_CONCODE_BYTEARRAY,  /* #[ ] */
-	HCL_CONCODE_QLIST,      /* #() - data list */
+	HCL_CONCODE_DIC,        /* { } */
+	HCL_CONCODE_QLIST,      /* #( ) - data list */
 	HCL_CONCODE_VLIST       /* | | - symbol list */
 };
 typedef enum hcl_concode_t hcl_concode_t;

lib/print.c

@@ -214,7 +214,9 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj)
 
 	static const hcl_bch_t *opening_parens[][2] =
 	{
+		/* navtive   json */
 		{ "(",       "(" },  /*HCL_CONCODE_XLIST */
+		{ "(:",      "(" },  /*HCL_CONCODE_MLIST */
 		{ "[",       "[" },  /*HCL_CONCODE_ARRAY */
 		{ "#[",      "[" },  /*HCL_CONCODE_BYTEARRAY */ 
 		{ "{",       "{" },  /*HCL_CONCODE_DIC */
@@ -224,6 +226,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj)
 	static const hcl_bch_t *closing_parens[][2] =
 	{
 		{ ")",       ")" },   /*HCL_CONCODE_XLIST */
+		{ ")",       ")" },   /*HCL_CONCODE_MLIST */
 		{ "]",       "]" },   /*HCL_CONCODE_ARRAY */
 		{ "]",       "]" },   /*HCL_CONCODE_BYTEARRAY */
 		{ "}",       "}" },   /*HCL_CONCODE_DIC */

lib/read.c

@@ -1043,6 +1043,21 @@ retry:
 		}
 
 		case '(':
+			oldc = c;
+			GET_CHAR_TO (hcl, c);
+			if(c == ':')
+			{
+				SET_TOKEN_TYPE (hcl, HCL_IOTOK_LPARCOLON);
+				ADD_TOKEN_CHAR (hcl, oldc);
+				ADD_TOKEN_CHAR (hcl, c);
+				break;
+			}
+			else
+			{
+				unget_char (hcl, &hcl->c->lxc);
+			}
+			c = oldc;
+
 			ADD_TOKEN_CHAR(hcl, c);
 			SET_TOKEN_TYPE (hcl, HCL_IOTOK_LPAREN);
 			break;
@@ -1811,22 +1826,27 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
 				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_ARRAY);
 				goto start_list;
 
-			case HCL_IOTOK_BAPAREN: /* #[] */
+			case HCL_IOTOK_BAPAREN: /* #[ */
 				flagv = 0;
 				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_BYTEARRAY);
 				goto start_list;
 
-			case HCL_IOTOK_LBRACE: /* {} */
+			case HCL_IOTOK_LBRACE: /* { */
 				flagv = 0;
 				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_DIC);
 				goto start_list;
 
-			case HCL_IOTOK_QLPAREN: /* #() */
+			case HCL_IOTOK_QLPAREN: /* #( */
 				flagv = 0;
 				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST);
 				goto start_list;
 
-			case HCL_IOTOK_LPAREN: /* () */
+			case HCL_IOTOK_LPARCOLON: /* (: */
+				flagv = 0;
+				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_MLIST);
+				goto start_list;
+				
+			case HCL_IOTOK_LPAREN: /* ( */
 				flagv = 0;
 				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_XLIST);
 			start_list:
@@ -1891,11 +1911,12 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
 					hcl_synerrnum_t synerr;
 				} req[] =
 				{
-					{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* XLIST     ()  */
+					{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* XLIST     ( )  */
-					{ HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* ARRAY     [] */
+					{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* MLIST     (: ) */
-					{ HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY #[] */
+					{ HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* ARRAY     [ ] */
-					{ HCL_IOTOK_RBRACE, HCL_SYNERR_RBRACE }, /* DIC       {} */
+					{ HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY #[ ] */
-					{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }  /* QLIST     #()  */
+					{ HCL_IOTOK_RBRACE, HCL_SYNERR_RBRACE }, /* DIC       { } */
+					{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }  /* QLIST     #( )  */
 				};
 
 				int oldflagv;