diff --git a/lang.txt b/lang.txt new file mode 100644 index 0000000..2ba6844 --- /dev/null +++ b/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); + + + +--------------- diff --git a/lib/comp.c b/lib/comp.c index 0112f64..9e86f08 100644 --- a/lib/comp.c +++ b/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; @@ -1226,7 +1253,7 @@ enum COP_COMPILE_OR_P1, COP_COMPILE_OR_P2, - + COP_COMPILE_CLASS_P1, COP_COMPILE_CLASS_P2, COP_COMPILE_CLASS_P3, @@ -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); @@ -4574,24 +4622,44 @@ static HCL_INLINE int post_lambda (hcl_t* hcl) hcl_oow_t index; hcl_var_info_t vi; int x; - - x = find_variable_backward(hcl, defun_name, &vi); - if (x <= -1) return -1; - - if (x == 0) + + if (is_in_class_init_scope(hcl)) { - SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name); - cf = GET_TOP_CFRAME(hcl); - cf->u.set.vi.type = VAR_NAMED; + /* 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 { - HCL_ASSERT (hcl, index <= HCL_SMOOI_MAX); - SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name); - cf = GET_TOP_CFRAME(hcl); - cf->u.set.vi = vi; + 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); + cf = GET_TOP_CFRAME(hcl); + cf->u.set.vi.type = VAR_NAMED; + } + else + { + HCL_ASSERT (hcl, index <= HCL_SMOOI_MAX); + SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name); + cf = GET_TOP_CFRAME(hcl); + cf->u.set.vi = vi; + } + cf->u.set.mode = VAR_ACCESS_STORE; } - cf->u.set.mode = VAR_ACCESS_STORE; } else { diff --git a/lib/err.c b/lib/err.c index 81b2c5f..14c3dfb 100644 --- a/lib/err.c +++ b/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" }; /* -------------------------------------------------------------------------- diff --git a/lib/exec.c b/lib/exec.c index 2b66c8c..7032f7a 100644 --- a/lib/exec.c +++ b/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)); - goto oops; + hcl_seterrbfmt (hcl, HCL_ECALL, "array 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_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; } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index cd7d6aa..c2614fd 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -152,16 +152,17 @@ enum hcl_iotok_type_t HCL_IOTOK_COLON, HCL_IOTOK_TRPCOLONS, HCL_IOTOK_COMMA, - HCL_IOTOK_LPAREN, - HCL_IOTOK_RPAREN, - HCL_IOTOK_BAPAREN, /* #[ */ - HCL_IOTOK_QLPAREN, /* #( */ - HCL_IOTOK_LBRACK, /* [ */ - HCL_IOTOK_RBRACK, /* ] */ - HCL_IOTOK_LBRACE, /* { */ - HCL_IOTOK_RBRACE, /* } */ - HCL_IOTOK_VBAR, - HCL_IOTOK_EOL, /* end of line */ + HCL_IOTOK_LPAREN, /* ( */ + 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_EOL, /* end of line */ HCL_IOTOK_INCLUDE }; diff --git a/lib/hcl.h b/lib/hcl.h index 187d83d..b2e0230 100644 --- a/lib/hcl.h +++ b/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_ARRAY, /* [] */ - HCL_CONCODE_BYTEARRAY, /* #[] */ - HCL_CONCODE_DIC, /* {} */ - HCL_CONCODE_QLIST, /* #() - data list */ + HCL_CONCODE_XLIST = 0, /* ( ) - executable list */ + HCL_CONCODE_MLIST, /* (: ) - message send list */ + HCL_CONCODE_ARRAY, /* [ ] */ + HCL_CONCODE_BYTEARRAY, /* #[ ] */ + HCL_CONCODE_DIC, /* { } */ + HCL_CONCODE_QLIST, /* #( ) - data list */ HCL_CONCODE_VLIST /* | | - symbol list */ }; typedef enum hcl_concode_t hcl_concode_t; diff --git a/lib/print.c b/lib/print.c index 543e297..cef900f 100644 --- a/lib/print.c +++ b/lib/print.c @@ -214,26 +214,29 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj) static const hcl_bch_t *opening_parens[][2] = { - { "(", "(" }, /*HCL_CONCODE_XLIST */ - { "[", "[" }, /*HCL_CONCODE_ARRAY */ - { "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */ - { "{", "{" }, /*HCL_CONCODE_DIC */ - { "#(", "[" } /*HCL_CONCODE_QLIST */ + /* navtive json */ + { "(", "(" }, /*HCL_CONCODE_XLIST */ + { "(:", "(" }, /*HCL_CONCODE_MLIST */ + { "[", "[" }, /*HCL_CONCODE_ARRAY */ + { "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */ + { "{", "{" }, /*HCL_CONCODE_DIC */ + { "#(", "[" } /*HCL_CONCODE_QLIST */ }; static const hcl_bch_t *closing_parens[][2] = { - { ")", ")" }, /*HCL_CONCODE_XLIST */ - { "]", "]" }, /*HCL_CONCODE_ARRAY */ - { "]", "]" }, /*HCL_CONCODE_BYTEARRAY */ - { "}", "}" }, /*HCL_CONCODE_DIC */ - { ")", "]" }, /*HCL_CONCODE_QLIST */ + { ")", ")" }, /*HCL_CONCODE_XLIST */ + { ")", ")" }, /*HCL_CONCODE_MLIST */ + { "]", "]" }, /*HCL_CONCODE_ARRAY */ + { "]", "]" }, /*HCL_CONCODE_BYTEARRAY */ + { "}", "}" }, /*HCL_CONCODE_DIC */ + { ")", "]" }, /*HCL_CONCODE_QLIST */ }; static const hcl_bch_t* breakers[][2] = { - { " ", "," }, /* item breaker */ - { " ", ":" } /* key value breaker */ + { " ", "," }, /* item breaker */ + { " ", ":" } /* key value breaker */ }; json = !!(fmtout->mask & HCL_LOG_PREFER_JSON); diff --git a/lib/read.c b/lib/read.c index b0fe160..261f354 100644 --- a/lib/read.c +++ b/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_RBRACK, HCL_SYNERR_RBRACK }, /* ARRAY [] */ - { HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY #[] */ - { HCL_IOTOK_RBRACE, HCL_SYNERR_RBRACE }, /* DIC {} */ - { HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN } /* QLIST #() */ + { HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* XLIST ( ) */ + { HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* MLIST (: ) */ + { HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* ARRAY [ ] */ + { HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY #[ ] */ + { HCL_IOTOK_RBRACE, HCL_SYNERR_RBRACE }, /* DIC { } */ + { HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN } /* QLIST #( ) */ }; int oldflagv;