diff --git a/lib/comp.c b/lib/comp.c index 46e6d31..877f7d1 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -991,44 +991,37 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src) if (HCL_IS_NIL(hcl, obj)) { - HCL_DEBUG1 (hcl, "Syntax error - no variable name in set - %O\n", src); - hcl_setsynerr (hcl, HCL_SYNERR_VARNAME, HCL_NULL, HCL_NULL); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_NULL, HCL_NULL, "no variable name in set - %O", src); /* TODO: error location */ return -1; } else if (!HCL_IS_CONS(hcl, obj)) { - HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in set - %O\n", src); - hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, "redundant cdr in set - %O", src); /* TODO: error location */ return -1; } var = HCL_CONS_CAR(obj); if (HCL_BRANDOF(hcl, var) != HCL_BRAND_SYMBOL) { - HCL_DEBUG1 (hcl, "Syntax error - variable name not a symbol - %O\n", var); - hcl_setsynerr (hcl, HCL_SYNERR_VARNAME, HCL_NULL, HCL_NULL); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_NULL, HCL_NULL, "variable name not a symbol - %O", var); /* TODO: error location */ return -1; } if (HCL_OBJ_GET_FLAGS_SYNCODE(var)) { - HCL_DEBUG1 (hcl, "Syntax error - special symbol not to be used as a variable name - %O\n", var); - hcl_setsynerr (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL); /* TOOD: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL, "special symbol not to be used as a variable name - %O", var); /* TOOD: error location */ return -1; } obj = HCL_CONS_CDR(obj); if (HCL_IS_NIL(hcl, obj)) { - /* no value */ - HCL_DEBUG1 (hcl, "Syntax error - no value specified in set - %O\n", src); - hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL, "no value specified in set - %O", src); /* TODO: error location */ return -1; } else if (!HCL_IS_CONS(hcl, obj)) { - HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in set - %O\n", src); - hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, "redundant cdr in set - %O", src); /* TODO: error location */ return -1; } @@ -1037,17 +1030,16 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src) obj = HCL_CONS_CDR(obj); if (!HCL_IS_NIL(hcl, obj)) { - HCL_DEBUG1 (hcl, "Synatx error - too many arguments to set - %O\n", src); - hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL, "too many arguments to set - %O", src); /* TODO: error location */ return -1; } SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, val); - if (find_temporary_variable_backward (hcl, var, &index) <= -1) + if (find_temporary_variable_backward(hcl, var, &index) <= -1) { PUSH_SUBCFRAME (hcl, COP_EMIT_SET, var); /* set doesn't evaluate the variable name */ - cf = GET_SUBCFRAME (hcl); + cf = GET_SUBCFRAME(hcl); cf->u.set.var_type = VAR_NAMED; } else @@ -1056,7 +1048,7 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src) HCL_ASSERT (hcl, index <= HCL_SMOOI_MAX); PUSH_SUBCFRAME (hcl, COP_EMIT_SET, HCL_SMOOI_TO_OOP(index)); - cf = GET_SUBCFRAME (hcl); + cf = GET_SUBCFRAME(hcl); cf->u.set.var_type = VAR_INDEXED; } @@ -2335,41 +2327,41 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj) break; case COP_EMIT_RETURN: - if (emit_return (hcl) <= -1) goto oops; + if (emit_return(hcl) <= -1) goto oops; break; case COP_EMIT_SET: - if (emit_set (hcl) <= -1) goto oops; + if (emit_set(hcl) <= -1) goto oops; break; case COP_POST_IF_COND: - if (post_if_cond (hcl) <= -1) goto oops; + if (post_if_cond(hcl) <= -1) goto oops; break; case COP_POST_IF_BODY: - if (post_if_body (hcl) <= -1) goto oops; + if (post_if_body(hcl) <= -1) goto oops; break; case COP_POST_UNTIL_BODY: case COP_POST_WHILE_BODY: - if (post_while_body (hcl) <= -1) goto oops; + if (post_while_body(hcl) <= -1) goto oops; break; case COP_POST_UNTIL_COND: case COP_POST_WHILE_COND: - if (post_while_cond (hcl) <= -1) goto oops; + if (post_while_cond(hcl) <= -1) goto oops; break; case COP_SUBCOMPILE_ELIF: - if (subcompile_elif (hcl) <= -1) goto oops; + if (subcompile_elif(hcl) <= -1) goto oops; break; case COP_SUBCOMPILE_ELSE: - if (subcompile_else (hcl) <= -1) goto oops; + if (subcompile_else(hcl) <= -1) goto oops; break; case COP_UPDATE_BREAK: - if (update_break (hcl) <= -1) goto oops; + if (update_break(hcl) <= -1) goto oops; break; default: diff --git a/lib/err.c b/lib/err.c index bd49ad1..df7b6aa 100644 --- a/lib/err.c +++ b/lib/err.c @@ -314,16 +314,25 @@ void hcl_getsynerr (hcl_t* hcl, hcl_synerr_t* synerr) void hcl_setsynerrbfmt (hcl_t* hcl, hcl_synerrnum_t num, const hcl_ioloc_t* loc, const hcl_oocs_t* tgt, const hcl_bch_t* msgfmt, ...) { + static hcl_bch_t syntax_error[] = "syntax error - "; + if (msgfmt) { va_list ap; + int i, selen; + va_start (ap, msgfmt); hcl_seterrbfmtv (hcl, HCL_ESYNERR, msgfmt, ap); va_end (ap); + + selen = HCL_COUNTOF(syntax_error) - 1; + HCL_MEMMOVE (&hcl->errmsg.buf[selen], &hcl->errmsg.buf[0], HCL_SIZEOF(hcl->errmsg.buf[0]) * (HCL_COUNTOF(hcl->errmsg.buf) - selen)); + for (i = 0; i < selen; i++) hcl->errmsg.buf[i] = syntax_error[i]; + hcl->errmsg.buf[HCL_COUNTOF(hcl->errmsg.buf) - 1] = '\0'; } else { - hcl_seterrbfmt (hcl, HCL_ESYNERR, "syntax error - %hs", synerr_to_errstr(num)); + hcl_seterrbfmt (hcl, HCL_ESYNERR, "%hs%hs", syntax_error, synerr_to_errstr(num)); } hcl->c->synerr.num = num; @@ -354,16 +363,25 @@ void hcl_setsynerrbfmt (hcl_t* hcl, hcl_synerrnum_t num, const hcl_ioloc_t* loc, void hcl_setsynerrufmt (hcl_t* hcl, hcl_synerrnum_t num, const hcl_ioloc_t* loc, const hcl_oocs_t* tgt, const hcl_uch_t* msgfmt, ...) { + static hcl_bch_t syntax_error[] = "syntax error - "; + if (msgfmt) { va_list ap; + int i, selen; + va_start (ap, msgfmt); hcl_seterrufmtv (hcl, HCL_ESYNERR, msgfmt, ap); va_end (ap); + + selen = HCL_COUNTOF(syntax_error) - 1; + HCL_MEMMOVE (&hcl->errmsg.buf[selen], &hcl->errmsg.buf[0], HCL_SIZEOF(hcl->errmsg.buf[0]) * (HCL_COUNTOF(hcl->errmsg.buf) - selen)); + for (i = 0; i < selen; i++) hcl->errmsg.buf[i] = syntax_error[i]; + hcl->errmsg.buf[HCL_COUNTOF(hcl->errmsg.buf) - 1] = '\0'; } else { - hcl_seterrbfmt (hcl, HCL_ESYNERR, "syntax error - %hs", synerr_to_errstr(num)); + hcl_seterrbfmt (hcl, HCL_ESYNERR, "%hs%hs", syntax_error, synerr_to_errstr(num)); } hcl->c->synerr.num = num; @@ -373,11 +391,18 @@ void hcl_setsynerrufmt (hcl_t* hcl, hcl_synerrnum_t num, const hcl_ioloc_t* loc, * hcl->c->tok.loc due to 'const' prefixed to loc. */ /*hcl->c->synerr.loc = loc? *loc: hcl->c->tok.loc;*/ if (loc) + { hcl->c->synerr.loc = *loc; + } else + { hcl->c->synerr.loc = hcl->c->tok.loc; - - if (tgt) hcl->c->synerr.tgt = *tgt; + } + + if (tgt) + { + hcl->c->synerr.tgt = *tgt; + } else { hcl->c->synerr.tgt.ptr = HCL_NULL; diff --git a/lib/hcl.h b/lib/hcl.h index e0f1d25..26c896b 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -818,7 +818,14 @@ struct hcl_cb_t /* ========================================================================= * PRIMITIVE MODULE MANIPULATION * ========================================================================= */ -typedef int (*hcl_prim_impl_t) (hcl_t* hcl, hcl_ooi_t nargs); +enum hcl_pfrc_t +{ + HCL_PF_FAILURE = -1, + HCL_PF_SUCCESS = 0 +}; +typedef enum hcl_pfrc_t hcl_pfrc_t; + +typedef hcl_pfrc_t (*hcl_prim_impl_t) (hcl_t* hcl, hcl_ooi_t nargs); typedef struct hcl_prim_mod_t hcl_prim_mod_t; @@ -1049,11 +1056,18 @@ struct hcl_t /* you can't access arguments and receiver after this macro. * also you must not call this macro more than once */ -#define HCL_STACK_SETRET(hcl,nargs,retv) (HCL_STACK_POPS(hcl, nargs), HCL_STACK_SETTOP(hcl, retv)) + +#define HCL_STACK_SETRET(hcl,nargs,retv) \ + do { \ + HCL_STACK_POPS(hcl, nargs); \ + HCL_STACK_SETTOP(hcl, (retv)); \ + } while(0) + #define HCL_STACK_SETRETTORCV(hcl,nargs) (HCL_STACK_POPS(hcl, nargs)) + /* ========================================================================= * STRING ENCODING CONVERSION * ========================================================================= */ diff --git a/lib/main.c b/lib/main.c index 5dc8bec..889faa1 100644 --- a/lib/main.c +++ b/lib/main.c @@ -1040,23 +1040,26 @@ int main (int argc, char* argv[]) { hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot compile object - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); } - /* carry on? */ } + else + { + hcl_decode (hcl, 0, hcl->code.bc.len); + HCL_LOG0 (hcl, HCL_LOG_MNEMONIC, "------------------------------------------\n"); + g_hcl = hcl; + //setup_tick (); + if (hcl_execute(hcl) <= -1) + { + hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot execute - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); + } + //cancel_tick(); + g_hcl = HCL_NULL; + } } + + } -hcl_decode (hcl, 0, hcl->code.bc.len); -HCL_LOG0 (hcl, HCL_LOG_MNEMONIC, "------------------------------------------\n"); -g_hcl = hcl; -//setup_tick (); -if (hcl_execute(hcl) <= -1) -{ - hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot execute - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); - -} -//cancel_tick(); -g_hcl = HCL_NULL; diff --git a/lib/prim.c b/lib/prim.c index e3424c4..bb27357 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -95,7 +95,7 @@ start_over: } } -static int prim_log (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t prim_log (hcl_t* hcl, hcl_ooi_t nargs) { /* TODO: accept log level */ hcl_oop_t msg, level; @@ -158,12 +158,53 @@ static int prim_log (hcl_t* hcl, hcl_ooi_t nargs) } HCL_STACK_SETRET (hcl, nargs, hcl->_nil); - return 0; + return HCL_PF_SUCCESS; +} + +/* ------------------------------------------------------------------------- */ +static hcl_pfrc_t prim_eqv (hcl_t* hcl, hcl_ooi_t nargs) +{ + hcl_oop_t a0, a1, rv; + + a0 = HCL_STACK_GETARG(hcl, nargs, 0); + a1 = HCL_STACK_GETARG(hcl, nargs, 1); + + rv = (a0 == a1? hcl->_true: hcl->_false); + + HCL_STACK_SETRET (hcl, nargs, rv); + return HCL_PF_SUCCESS; +} + +static hcl_pfrc_t prim_eql (hcl_t* hcl, hcl_ooi_t nargs) +{ + int n; + n = hcl_equalobjs(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1)); + if (n <= -1) return HCL_PF_FAILURE; + + HCL_STACK_SETRET (hcl, nargs, (n? hcl->_true: hcl->_false)); + return HCL_PF_SUCCESS; +} + +static hcl_pfrc_t prim_not (hcl_t* hcl, hcl_ooi_t nargs) +{ + hcl_oop_t arg, rv; + + arg = HCL_STACK_GETARG(hcl, nargs, 0); + if (arg == hcl->_true) rv = hcl->_false; + else if (arg == hcl->_false) rv = hcl->_true; + else + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "boolean parameter expected - %O", arg); + return HCL_PF_FAILURE; + } + + HCL_STACK_SETRET (hcl, nargs, rv); + return HCL_PF_SUCCESS; } /* ------------------------------------------------------------------------- */ -static int oop_to_ooi (hcl_t* hcl, hcl_oop_t iv, hcl_ooi_t* ov) +static hcl_pfrc_t oop_to_ooi (hcl_t* hcl, hcl_oop_t iv, hcl_ooi_t* ov) { if (HCL_OOP_IS_SMOOI(iv)) { @@ -177,12 +218,12 @@ static int oop_to_ooi (hcl_t* hcl, hcl_oop_t iv, hcl_ooi_t* ov) } else { - /* TODO: set error number or something...to indicate primitive failure... */ + hcl_seterrbfmt (hcl, HCL_EINVAL, "not a numeric object - %O", iv); return -1; } } -static int prim_plus (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t prim_plus (hcl_t* hcl, hcl_ooi_t nargs) { hcl_ooi_t x = 0; hcl_oow_t i; @@ -193,18 +234,18 @@ static int prim_plus (hcl_t* hcl, hcl_ooi_t nargs) hcl_ooi_t v; arg = HCL_STACK_GETARG(hcl, nargs, i); - if (oop_to_ooi(hcl, arg, &v) <= -1) return -1; + if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE; x += v; } ret = hcl_makeinteger (hcl, x); - if (!ret) return -1; + if (!ret) return HCL_PF_FAILURE; HCL_STACK_SETRET (hcl, nargs, ret); - return 0; + return HCL_PF_SUCCESS; } -static int prim_minus (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t prim_minus (hcl_t* hcl, hcl_ooi_t nargs) { hcl_ooi_t x = 0; hcl_oow_t i; @@ -213,24 +254,24 @@ static int prim_minus (hcl_t* hcl, hcl_ooi_t nargs) if (nargs > 0) { arg = HCL_STACK_GETARG(hcl, nargs, 0); - if (oop_to_ooi(hcl, arg, &x) <= -1) return -1; + if (oop_to_ooi(hcl, arg, &x) <= -1) return HCL_PF_FAILURE; for (i = 1; i < nargs; i++) { hcl_ooi_t v; arg = HCL_STACK_GETARG(hcl, nargs, i); - if (oop_to_ooi(hcl, arg, &v) <= -1) return -1; + if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE; x -= v; } } ret = hcl_makeinteger (hcl, x); - if (!ret) return -1; + if (!ret) return HCL_PF_FAILURE; HCL_STACK_SETRET (hcl, nargs, ret); - return 0; + return HCL_PF_SUCCESS; } -static int prim_printf (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t prim_printf (hcl_t* hcl, hcl_ooi_t nargs) { hcl_ooi_t x = 0; hcl_oow_t i; @@ -239,21 +280,21 @@ static int prim_printf (hcl_t* hcl, hcl_ooi_t nargs) if (nargs > 0) { arg = HCL_STACK_GETARG(hcl, nargs, 0); - if (oop_to_ooi(hcl, arg, &x) <= -1) return -1; + if (oop_to_ooi(hcl, arg, &x) <= -1) return HCL_PF_FAILURE; for (i = 1; i < nargs; i++) { hcl_ooi_t v; arg = HCL_STACK_GETARG(hcl, nargs, i); - if (oop_to_ooi(hcl, arg, &v) <= -1) return -1; + if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE; x -= v; } } ret = hcl_makeinteger (hcl, x); - if (!ret) return -1; + if (!ret) return HCL_PF_FAILURE; HCL_STACK_SETRET (hcl, nargs, ret); - return 0; + return HCL_PF_SUCCESS; } /* ------------------------------------------------------------------------- */ @@ -261,6 +302,14 @@ static prim_t builtin_prims[] = { { 0, HCL_TYPE_MAX(hcl_oow_t), prim_log, 3, { 'l','o','g' } }, + { 1, 1, prim_not, 3, { 'n','o','t' } }, +/* { 2, 2, prim_and, 3, { 'a','n','d' } }, + { 2, 2, prim_or, 2, { 'o','r' } }, */ + + + { 2, 2, prim_eqv, 4, { 'e','q','v','?' } }, + { 2, 2, prim_eql, 4, { 'e','q','l','?' } }, + /* { 2, 2, prim_gt, 1, { '>' } }, { 2, 2, prim_ge, 2, { '>','=' } }, @@ -269,16 +318,15 @@ static prim_t builtin_prims[] = { 2, 2, prim_eq, 1, { '=' } }, { 2, 2, prim_ne, 2, { '/','=' } }, - { 2, 2, prim_eql, 3, { 'e','q','l' } }, { 2, 2, prim_max, 3, { 'm','a','x' } }, { 2, 2, prim_min, 3, { 'm','i','n' } }, - { 2, 2, prim_and, 3, { 'a','n','d' } }, - { 2, 2, prim_or, 2, { 'o','r' } }, - { 1, 1, prim_not, 3, { 'n','o','t' } }, */ + */ + { 0, HCL_TYPE_MAX(hcl_oow_t), prim_plus, 1, { '+' } }, { 0, HCL_TYPE_MAX(hcl_oow_t), prim_minus, 1, { '-' } }, + { 0, HCL_TYPE_MAX(hcl_oow_t), prim_printf, 6, { 'p','r','i','n','t','f' } }, }; @@ -291,15 +339,15 @@ int hcl_addbuiltinprims (hcl_t* hcl) for (i = 0; i < HCL_COUNTOF(builtin_prims); i++) { - prim = hcl_makeprim (hcl, builtin_prims[i].impl, builtin_prims[i].minargs, builtin_prims[i].maxargs); + prim = hcl_makeprim(hcl, builtin_prims[i].impl, builtin_prims[i].minargs, builtin_prims[i].maxargs); if (!prim) return -1; hcl_pushtmp (hcl, &prim); - name = hcl_makesymbol (hcl, builtin_prims[i].name, builtin_prims[i].namelen); + name = hcl_makesymbol(hcl, builtin_prims[i].name, builtin_prims[i].namelen); hcl_poptmp (hcl); if (!name) return -1; - if (!hcl_putatsysdic (hcl, name, prim)) return -1; + if (!hcl_putatsysdic(hcl, name, prim)) return -1; } return 0; diff --git a/lib/read.c b/lib/read.c index 2402f75..6d44869 100644 --- a/lib/read.c +++ b/lib/read.c @@ -222,7 +222,7 @@ static HCL_INLINE int is_alnumchar (hcl_ooci_t c) static HCL_INLINE int is_delimiter (hcl_ooci_t c) { - return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' || c == '\"' || c == '#' || c == ';' || c == '|' || is_spacechar(c) || c == HCL_UCI_EOF; + return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' || c == '\"' || c == '\'' || c == '#' || c == ';' || c == '|' || is_spacechar(c) || c == HCL_UCI_EOF; } @@ -692,15 +692,13 @@ static int get_sharp_token (hcl_t* hcl) * #bBBBB binary * #oOOOO octal * #xXXXX hexadecimal - * #t - * #f * #true * #false * #include * #\C * character * #\xHHHH * unicode * #\uHHHH - * #( ) * vector + * #( ) * array * #[ ] * byte array * #{ } * dictionary * #< > -- xxx @@ -720,6 +718,8 @@ static int get_sharp_token (hcl_t* hcl) if (get_radix_number (hcl, c, radix) <= -1) return -1; break; +#if 0 +/* i changed mind. i don't want to have #t for true and #f for false. */ case 't': ADD_TOKEN_CHAR (hcl, '#'); ADD_TOKEN_CHAR (hcl, 't'); @@ -737,6 +737,7 @@ static int get_sharp_token (hcl_t* hcl) unget_char (hcl, &hcl->c->lxc); SET_TOKEN_TYPE (hcl, HCL_IOTOK_FALSE); break; +#endif case '\\': /* character literal */ ADD_TOKEN_CHAR (hcl, '#'); @@ -777,44 +778,44 @@ static int get_sharp_token (hcl_t* hcl) c = c * 16 + CHAR_TO_NUM(hcl->c->tok.name.ptr[i], 16); } } - else if (does_token_name_match (hcl, VOCA_SPACE)) + else if (does_token_name_match(hcl, VOCA_SPACE)) { c = ' '; } - else if (does_token_name_match (hcl, VOCA_NEWLINE)) + else if (does_token_name_match(hcl, VOCA_NEWLINE)) { /* TODO: convert it to host newline convention. how to handle if it's composed of 2 letters like \r\n? */ c = '\n'; } - else if (does_token_name_match (hcl, VOCA_BACKSPACE)) + else if (does_token_name_match(hcl, VOCA_BACKSPACE)) { c = '\b'; } - else if (does_token_name_match (hcl, VOCA_TAB)) + else if (does_token_name_match(hcl, VOCA_TAB)) { c = '\t'; } - else if (does_token_name_match (hcl, VOCA_LINEFEED)) + else if (does_token_name_match(hcl, VOCA_LINEFEED)) { c = '\n'; } - else if (does_token_name_match (hcl, VOCA_PAGE)) + else if (does_token_name_match(hcl, VOCA_PAGE)) { c = '\f'; } - else if (does_token_name_match (hcl, VOCA_RETURN)) + else if (does_token_name_match(hcl, VOCA_RETURN)) { c = '\r'; } - else if (does_token_name_match (hcl, VOCA_NUL)) + else if (does_token_name_match(hcl, VOCA_NUL)) /* null character. not #nil */ { c = '\0'; } - else if (does_token_name_match (hcl, VOCA_VTAB)) + else if (does_token_name_match(hcl, VOCA_VTAB)) { c = '\v'; } - else if (does_token_name_match (hcl, VOCA_RUBOUT)) + else if (does_token_name_match(hcl, VOCA_RUBOUT)) { c = '\x7F'; /* DEL */ } @@ -838,19 +839,19 @@ static int get_sharp_token (hcl_t* hcl) unget_char (hcl, &hcl->c->lxc); break; - case '(': /* #( - array literal */ + case '(': /* #( - array opener */ ADD_TOKEN_CHAR (hcl, '#'); ADD_TOKEN_CHAR(hcl, c); SET_TOKEN_TYPE (hcl, HCL_IOTOK_APAREN); break; - case '[': /* #[ - byte array literal */ + case '[': /* #[ - byte array opener */ ADD_TOKEN_CHAR (hcl, '#'); ADD_TOKEN_CHAR(hcl, c); SET_TOKEN_TYPE (hcl, HCL_IOTOK_BAPAREN); break; - case '{': + case '{': /* #{ - dictionary opener */ ADD_TOKEN_CHAR (hcl, '#'); ADD_TOKEN_CHAR(hcl, c); SET_TOKEN_TYPE (hcl, HCL_IOTOK_DPAREN); @@ -986,9 +987,11 @@ retry: if (get_string(hcl, '\"', '\\', 0, 0) <= -1) return -1; break; +#if 0 case '\'': if (get_quoted_token(hcl) <= -1) return -1; break; +#endif case '#': if (get_sharp_token(hcl) <= -1) return -1; @@ -1061,6 +1064,12 @@ retry: default: ident: + if (is_delimiter(c)) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ILCHR, TOKEN_LOC(hcl), HCL_NULL, "illegal character %jc encountered", c); + return -1; + } + SET_TOKEN_TYPE (hcl, HCL_IOTOK_IDENT); while (1) { @@ -1351,9 +1360,9 @@ done: case HCL_CONCODE_DIC: return (hcl_oop_t)hcl_makedic(hcl, 100); /* TODO: default dictionary size for empty definition? */ - case HCL_CONCODE_XLIST: - hcl_setsynerr (hcl, HCL_SYNERR_EMPTYXLIST, TOKEN_LOC(hcl), HCL_NULL); - return HCL_NULL; + /* NOTE: empty xlist will get translated to #nil. + * this is useful when used in the lambda expression to express an empty argument. + * (lambda () ...) is equivalent to (lambda #nil ...) */ } } @@ -1668,10 +1677,12 @@ static int read_object (hcl_t* hcl) flagv = 0; LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_DIC); goto start_list; +#if 0 case HCL_IOTOK_QPAREN: flagv = 0; LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST); goto start_list; +#endif case HCL_IOTOK_LPAREN: flagv = 0; LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_XLIST); diff --git a/lib/utl.c b/lib/utl.c index cbe481e..0b04b14 100644 --- a/lib/utl.c +++ b/lib/utl.c @@ -351,6 +351,7 @@ hcl_bch_t* hcl_findbcharinbcstr (const hcl_bch_t* ptr, hcl_bch_t c) return HCL_NULL; } + /* ----------------------------------------------------------------------- */ int hcl_concatoocstrtosbuf (hcl_t* hcl, const hcl_ooch_t* str, int id)