From 8cb9178820094434ea57f3c18cd7e59e5b47bfc6 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Sun, 12 Nov 2023 21:54:17 +0900 Subject: [PATCH] fixed many more issue in compiling block expressoins --- lib/cnode.c | 16 ++--- lib/comp.c | 83 +++++++++++++++-------- lib/hcl-prv.h | 11 ++- lib/print.c | 52 +++++++++++++++ lib/read.c | 181 ++++++++++++++++++++++++++++++++++---------------- lib/std.c | 8 +-- 6 files changed, 252 insertions(+), 99 deletions(-) diff --git a/lib/cnode.c b/lib/cnode.c index 191173e..6e1dd6e 100644 --- a/lib/cnode.c +++ b/lib/cnode.c @@ -94,7 +94,7 @@ hcl_cnode_t* hcl_makecnodedcstar (hcl_t* hcl, const hcl_loc_t* loc, const hcl_o hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, const hcl_ooch_t v) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CHARLIT, loc, tok); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CHARLIT, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.charlit.v = v; return c; @@ -102,7 +102,7 @@ hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_ hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SYMBOL, loc, tok); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SYMBOL, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.symbol.syncode = hcl_getsyncodebyoocs_noseterr(hcl, tok); return c; @@ -135,7 +135,7 @@ hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_ hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_oow_t v) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SMPTRLIT, loc, tok); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SMPTRLIT, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.smptrlit.v = v; return c; @@ -143,15 +143,15 @@ hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_ hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_ooi_t v) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ERRLIT, loc, tok); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ERRLIT, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.errlit.v = v; return c; } -hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr) +hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_cnode_t* car, hcl_cnode_t* cdr) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CONS, loc, HCL_NULL); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CONS, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.cons.car = car; c->u.cons.cdr = cdr; @@ -160,7 +160,7 @@ hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* c hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_loc_t* loc, hcl_concode_t type) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ELIST, loc, HCL_NULL); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ELIST, loc, HCL_NULL); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.elist.concode = type; return c; @@ -168,7 +168,7 @@ hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_loc_t* loc, hcl_concode_t hcl_cnode_t* hcl_makecnodeshell (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* obj) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SHELL, loc, HCL_NULL); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SHELL, loc, HCL_NULL); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.shell.obj = obj; return c; diff --git a/lib/comp.c b/lib/comp.c index f9078ce..e4b1e49 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -1232,14 +1232,14 @@ static HCL_INLINE void pop_cframe (hcl_t* hcl) hcl_cframe_t* _cf = GET_TOP_CFRAME(hcl); \ _cf->opcode = _opcode; \ _cf->operand = _operand; \ - } while (0); + } while(0) #define SWITCH_CFRAME(hcl,_index,_opcode,_operand) \ do { \ hcl_cframe_t* _cf = GET_CFRAME(hcl,_index); \ _cf->opcode = _opcode; \ _cf->operand = _operand; \ - } while (0); + } while(0) static int push_subcframe (hcl_t* hcl, int opcode, hcl_cnode_t* operand) { @@ -1903,35 +1903,48 @@ inside_loop: /* ========================================================================= */ -static int compile_do_list (hcl_t* hcl, hcl_cnode_t* src, hcl_cnode_t* obj) +static int compile_expression_block (hcl_t* hcl, hcl_cnode_t* src, const hcl_bch_t* ctxname, int is_block) { - hcl_cnode_t* cmd, * tmp; + hcl_cnode_t* cmd, * obj, * tmp; hcl_oow_t nlvars, tvslen; hcl_fnblk_info_t* fbi; hcl_cframe_t* cf; - //obj = HCL_CNODE_CONS_CDR(src); /* expression list after it */ - - if (!obj) + if (is_block) { - /* no value */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); - return -1; + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(src, HCL_CONCODE_BLOCK) || HCL_CNODE_IS_ELIST_CONCODED(src, HCL_CONCODE_BLOCK)); + cmd = src; /* it's the cons cell itself */ + /* `obj` must point to the cons cell pointing to the braced expression list */ + obj = HCL_CNODE_IS_ELIST(src)? HCL_NULL: src; + /* no check for redundant cdr because {} cannot be dotted */ } - else if (!HCL_CNODE_IS_CONS(obj)) + else { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); - return -1; + cmd = HCL_CNODE_CONS_CAR(src); /* `do` itself */ + /* `obj` must point to the expression list after `do` */ + obj = HCL_CNODE_CONS_CDR(src); /* expression list after it */ + if (obj && !HCL_CNODE_IS_CONS(obj)) + { + hcl_setsynerrbfmt ( + hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), + "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + return -1; + } } - tmp = obj; tvslen = hcl->c->tv.s.len; - if (collect_vardcls(hcl, obj, &obj, tvslen, &nlvars, "do") <= -1) return -1; - - if (nlvars > MAX_CODE_NBLKLVARS) + nlvars = 0; + if (obj) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(tmp), HCL_NULL, "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); - return -1; + hcl_cnode_t* tmp = obj; + if (collect_vardcls(hcl, obj, &obj, tvslen, &nlvars, ctxname) <= -1) return -1; + if (nlvars > MAX_CODE_NBLKLVARS) + { + hcl_setsynerrbfmt ( + hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(tmp), HCL_NULL, + "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + return -1; + } } fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth]; @@ -1939,6 +1952,10 @@ static int compile_do_list (hcl_t* hcl, hcl_cnode_t* src, hcl_cnode_t* obj) fbi->tmprcnt = hcl->c->tv.wcount; fbi->tmpr_nlvars = fbi->tmpr_nlvars + nlvars; + /* for an expression like `(do )` or `(do | a b | ) , `obj` will point to HCL_NULL. + * let `obj` point to the internal cnode to convert the expression like `(do #nil)` or `(do |a b| #nil)`. */ + if (!obj) obj = &hcl->c->fake_cnode.cons_to_nil; + SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */ PUSH_SUBCFRAME (hcl, COP_COMPILE_DO_P1, src); /* 2 */ @@ -2008,7 +2025,7 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* src) return 0; #else - return compile_do_list(hcl, src, obj); + return compile_expression_block(hcl, src, "do", 0); #endif } @@ -2764,7 +2781,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) return -1; } - bdy = HCL_CNODE_CONS_CAR(blk); /* {} must be the last item */ + bdy = HCL_CNODE_CONS_CAR(blk); /* {} must be the last item. bdy is the expression inside */ trl = HCL_CNODE_CONS_CDR(blk); /* something after {} */ if (!bdy || (!HCL_CNODE_IS_CONS_CONCODED(bdy, HCL_CONCODE_BLOCK) && !HCL_CNODE_IS_ELIST_CONCODED(bdy, HCL_CONCODE_BLOCK))) @@ -2781,7 +2798,13 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) return -1; } - obj = HCL_CNODE_IS_ELIST(bdy)? HCL_NULL: bdy; +hcl_logbfmt(hcl, HCL_LOG_FATAL, "bdy[%d.%d] blk[%d.%d] obj[%d.%d]\n", + HCL_CNODE_GET_LOC(bdy)->line, HCL_CNODE_GET_LOC(bdy)->colm, + HCL_CNODE_GET_LOC(blk)->line, HCL_CNODE_GET_LOC(blk)->colm, + HCL_CNODE_GET_LOC(obj)->line, HCL_CNODE_GET_LOC(obj)->colm); + + //obj = HCL_CNODE_IS_ELIST(bdy)? HCL_NULL: blk /* bdy */; + obj = blk; nlvars = 0; /* no known local variables until the actual block is processed */ } else @@ -3879,7 +3902,7 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret static int compile_cons_block_expression (hcl_t* hcl, hcl_cnode_t* obj) { - return compile_do_list(hcl, obj, obj); + return compile_expression_block(hcl, obj, "block", 1); } static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj) @@ -4253,9 +4276,13 @@ redo: return -1; case HCL_CONCODE_BLOCK: - /* TODO: may have to allow it.. */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty block list"); - return -1; + if (!(hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty block expression"); + return -1; + } + if (compile_cons_block_expression(hcl, oprnd) <= -1) return -1; + break; case HCL_CONCODE_ARRAY: if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; @@ -4438,8 +4465,8 @@ static int compile_object_list (hcl_t* hcl) * except the last. */ int nextcop; - nextcop = (cop == COP_COMPILE_OBJECT_LIST)? COP_COMPILE_OBJECT_LIST_TAIL: - (cop == COP_COMPILE_IF_OBJECT_LIST)? COP_COMPILE_IF_OBJECT_LIST_TAIL: + nextcop = (cop == COP_COMPILE_OBJECT_LIST)? COP_COMPILE_OBJECT_LIST_TAIL: + (cop == COP_COMPILE_IF_OBJECT_LIST)? COP_COMPILE_IF_OBJECT_LIST_TAIL: (cop == COP_COMPILE_TRY_OBJECT_LIST)? COP_COMPILE_TRY_OBJECT_LIST_TAIL: cop; PUSH_SUBCFRAME (hcl, nextcop, cdr); } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 1ad7e68..a1e81dc 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -637,6 +637,7 @@ struct hcl_frd_t int expect_vlist_item; int do_include_file; hcl_cnode_t* obj; + hcl_loc_t list_loc; }; struct hcl_compiler_t @@ -756,6 +757,13 @@ struct hcl_compiler_t hcl_clsblk_info_t* info; hcl_oow_t info_capa; } clsblk; /* class block */ + + + struct + { + hcl_cnode_t cons_to_nil; + hcl_cnode_t nil; + } fake_cnode; }; #endif @@ -1715,11 +1723,12 @@ hcl_cnode_t* hcl_makecnoderadnumlit (hcl_t* hcl, const hcl_loc_t* loc, const hc hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_oow_t v); hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_ooi_t v); -hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr); +hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_cnode_t* car, hcl_cnode_t* cdr); hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_loc_t* loc, hcl_concode_t type); hcl_cnode_t* hcl_makecnodeshell (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* obj); void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c); hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons); +void hcl_dumpcnode (hcl_t* hcl, hcl_cnode_t* c, int newline); /* ========================================================================= */ diff --git a/lib/print.c b/lib/print.c index 5d8bbe9..690c934 100644 --- a/lib/print.c +++ b/lib/print.c @@ -784,3 +784,55 @@ int hcl_print (hcl_t* hcl, hcl_oop_t obj) /*return hcl_outfmtobj(hcl, HCL_LOG_APP | HCL_LOG_FATAL, obj);*/ return hcl_prbfmt(hcl, "%O", obj); } + +void hcl_dumpcnode (hcl_t* hcl, hcl_cnode_t* cnode, int newline) +{ + int t; + + /* TODO: this is incomplete function. make it complete */ + if (cnode) + { + t = HCL_CNODE_GET_TYPE(cnode); + switch (t) + { + case HCL_CNODE_CHARLIT: + case HCL_CNODE_SYMBOL: + case HCL_CNODE_DSYMBOL: + case HCL_CNODE_STRLIT: + case HCL_CNODE_NUMLIT: + case HCL_CNODE_RADNUMLIT: + case HCL_CNODE_FPDECLIT: + case HCL_CNODE_SMPTRLIT: + case HCL_CNODE_ERRLIT: + case HCL_CNODE_NIL: + case HCL_CNODE_TRUE: + case HCL_CNODE_FALSE: + case HCL_CNODE_SELF: + case HCL_CNODE_SUPER: + case HCL_CNODE_ELLIPSIS: + case HCL_CNODE_TRPCOLONS: + case HCL_CNODE_DCSTAR: + hcl_logbfmt (hcl, HCL_LOG_FATAL, " %.*js ", HCL_CNODE_GET_TOKLEN(cnode), HCL_CNODE_GET_TOKPTR(cnode)); + break; + + case HCL_CNODE_CONS: + hcl_logbfmt (hcl, HCL_LOG_FATAL, " ("); + hcl_dumpcnode (hcl, HCL_CNODE_CONS_CAR(cnode), 0); + hcl_dumpcnode (hcl, HCL_CNODE_CONS_CDR(cnode),0); + hcl_logbfmt (hcl, HCL_LOG_FATAL, ") "); + break; + + case HCL_CNODE_ELIST: + hcl_logbfmt (hcl, HCL_LOG_FATAL, " () ", HCL_CNODE_GET_TOKLEN(cnode), HCL_CNODE_GET_TOKPTR(cnode)); + break; + + case HCL_CNODE_SHELL: + hcl_logbfmt (hcl, HCL_LOG_FATAL, " () ", HCL_CNODE_GET_TOKLEN(cnode), HCL_CNODE_GET_TOKPTR(cnode)); + break; + } + } + + if (newline) hcl_logbfmt (hcl, HCL_LOG_FATAL, "\n"); +} + + diff --git a/lib/read.c b/lib/read.c index 97ab92f..c363f8c 100644 --- a/lib/read.c +++ b/lib/read.c @@ -44,6 +44,7 @@ static struct voca_t { { 8, { '#','i','n','c','l','u','d','e' } }, { 7, { '#','p','r','a','g','m','a' } }, + { 11, { '#','\\','b','a','c','k','s','p','a','c','e' } }, { 10, { '#','\\','l','i','n','e','f','e','e','d' } }, { 9, { '#','\\','n','e','w','l','i','n','e' } }, @@ -54,6 +55,22 @@ static struct voca_t { 7, { '#','\\','s','p','a','c','e' } }, { 5, { '#','\\','t','a','b' } }, { 6, { '#','\\','v','t','a','b' } }, + + { 4, { 'n','u','l','l' } }, + { 4, { 't','r','u','e' } }, + { 5, { 'f','a','l','s','e' } }, + { 4, { 's','e','l','f' } }, + { 5, { 's','u','p','e','r' } }, + + { 3, { '(',' ',')' } }, + { 4, { '(',':',' ',')' } }, + { 3, { '{',' ','}' } }, + { 3, { '[',' ',']' } }, + { 4, { '#','[',' ',']' } }, + { 4, { '#','{',' ','}' } }, + { 4, { '#','(',' ',')' } }, + { 3, { '|',' ','|' } }, + { 5, { '<','E','O','L','>' } }, { 5, { '<','E','O','F','>' } } }; @@ -63,16 +80,31 @@ enum voca_id_t VOCA_INCLUDE, VOCA_PRAGMA, - VOCA_BACKSPACE, - VOCA_LINEFEED, - VOCA_NEWLINE, - VOCA_NUL, - VOCA_PAGE, - VOCA_RETURN, - VOCA_RUBOUT, - VOCA_SPACE, - VOCA_TAB, - VOCA_VTAB, + VOCA_CHAR_BACKSPACE, + VOCA_CHAR_LINEFEED, + VOCA_CHAR_NEWLINE, + VOCA_CHAR_NUL, + VOCA_CHAR_PAGE, + VOCA_CHAR_RETURN, + VOCA_CHAR_RUBOUT, + VOCA_CHAR_SPACE, + VOCA_CHAR_TAB, + VOCA_CHAR_VTAB, + + VOCA_KW_NULL, + VOCA_KW_TRUE, + VOCA_KW_FALSE, + VOCA_KW_SELF, + VOCA_KW_SUPER, + + VOCA_XLIST, + VOCA_MLIST, + VOCA_BLOCK, + VOCA_ARRAY, + VOCA_BYTEARRAY, + VOCA_DIC, + VOCA_QLIST, + VOCA_VLIST, VOCA_EOL, VOCA_EOF @@ -98,6 +130,25 @@ enum list_flag_t #define LIST_FLAG_GET_CONCODE(x) (((x) >> 12) & 0x0FFF) #define LIST_FLAG_SET_CONCODE(x,type) ((x) = ((x) & ~0xFF000) | ((type) << 12)) +static struct +{ + int closer; + hcl_synerrnum_t synerr; + int voca_id; +} cons_info[] = +{ + /*[HCL_CONCODE_XLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_XLIST }, /* XLIST ( ) */ + /*[HCL_CONCODE_MLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_MLIST }, /* MLIST (: ) */ + /*[HCL_CONCODE_BLOCK] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE, VOCA_BLOCK }, /* BLOCK { } */ + /*[HCL_CONCODE_ARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_ARRAY }, /* ARRAY [ ] */ + /*[HCL_CONCODE_BYTEARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_BYTEARRAY }, /* BYTEARRAY #[ ] */ + /*[HCL_CONCODE_DIC] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE, VOCA_DIC }, /* DIC #{ } */ + /*[HCL_CONCODE_QLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_QLIST }, /* QLIST #( ) */ + + /* VLIST's closer and synerr are not used. there is dedicated logic in feed_process_token(). only voca_id is used */ + /*[HCL_CONCODE_VLIST] =*/ { HCL_TOK_VBAR, HCL_SYNERR_VBAR, VOCA_VLIST } /* VLIST | | */ +}; + static int init_compiler (hcl_t* hcl); static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* num) @@ -520,23 +571,23 @@ static int get_char (hcl_t* hcl) static hcl_tok_type_t classify_ident_token (hcl_t* hcl, const hcl_oocs_t* v) { hcl_oow_t i; - struct + static struct { - hcl_oow_t len; - hcl_ooch_t name[10]; + int voca_id; hcl_tok_type_t type; } tab[] = { - { 4, { 'n','u','l','l' }, HCL_TOK_NIL }, - { 4, { 't','r','u','e' }, HCL_TOK_TRUE }, - { 5, { 'f','a','l','s','e' }, HCL_TOK_FALSE }, - { 4, { 's','e','l','f' }, HCL_TOK_SELF }, - { 5, { 's','u','p','e','r' }, HCL_TOK_SUPER } + { VOCA_KW_NULL, HCL_TOK_NIL }, + { VOCA_KW_TRUE, HCL_TOK_TRUE }, + { VOCA_KW_FALSE, HCL_TOK_FALSE }, + { VOCA_KW_SELF, HCL_TOK_SELF }, + { VOCA_KW_SUPER, HCL_TOK_SUPER } }; for (i = 0; i < HCL_COUNTOF(tab); i++) { - if (hcl_comp_oochars(v->ptr, v->len, tab[i].name, tab[i].len) == 0) return tab[i].type; + int vid = tab[i].voca_id; + if (hcl_comp_oochars(v->ptr, v->len, vocas[vid].str, vocas[vid].len) == 0) return tab[i].type; } return HCL_TOK_IDENT; @@ -617,7 +668,7 @@ static HCL_INLINE int enter_list (hcl_t* hcl, const hcl_loc_t* loc, int flagv) return 0; } -static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv) +static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, hcl_loc_t* list_loc, int* flagv, int* oldflagv) { hcl_rstl_t* rstl; hcl_cnode_t* head; @@ -643,6 +694,7 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv return HCL_NULL; } + *list_loc = loc; *oldflagv = fv; if (!hcl->c->r.st) { @@ -657,9 +709,9 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv *flagv = hcl->c->r.st->flagv; } - /* NOTE: empty xlist will get translated to #nil. + /* NOTE: empty xlist will get translated to `null`. * this is useful when used in the lambda expression to express an empty argument. also in defun. - * (lambda () ...) is equivalent to (lambda #nil ...) + * (lambda () ...) is equivalent to (lambda null ...) * (defun x() ...) */ if (head) @@ -744,7 +796,7 @@ static HCL_INLINE void clear_comma_colon_flag (hcl_t* hcl) rstl->flagv &= ~(COMMAED | COLONED); } -static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) +static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj, hcl_loc_t* loc) { hcl_rstl_t* rstl; int flagv; @@ -806,6 +858,8 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) else { hcl_cnode_t* cons, * tail; + hcl_oocs_t fake_tok, * fake_tok_ptr = HCL_NULL; + int concode; if ((flagv & JSON) && rstl->count > 0 && !(flagv & (COMMAED | COLONED))) { @@ -815,7 +869,20 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) return -1; } - cons = hcl_makecnodecons(hcl, HCL_CNODE_GET_LOC(obj), obj, HCL_NULL); + /* `loc` may be passed in if the added `obj` is a cons cell for another list */ + HCL_ASSERT (hcl, (loc && (HCL_CNODE_IS_CONS(obj) || HCL_CNODE_IS_ELIST(obj))) || (!loc && !HCL_CNODE_IS_CONS(obj))); + concode = HCL_CNODE_IS_CONS(obj)? HCL_CNODE_CONS_CONCODE(obj): + HCL_CNODE_IS_ELIST(obj)? HCL_CNODE_ELIST_CONCODE(obj): -1; + + if (concode >= 0) + { + int vid = cons_info[concode].voca_id; + fake_tok.ptr = vocas[vid].str; + fake_tok.len = vocas[vid].len; + fake_tok_ptr = &fake_tok; + } + + cons = hcl_makecnodecons(hcl, (loc? loc: HCL_CNODE_GET_LOC(obj)), fake_tok_ptr, obj, HCL_NULL); if (HCL_UNLIKELY(!cons)) return -1; if (rstl->count <= 0) @@ -831,8 +898,7 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) } else { - /* the new cons cell is not the first element. - * append it to the list */ + /* the new cons cell is not the first element. append it to the list */ tail = rstl->tail; HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(tail)); tail->u.cons.cdr = cons; @@ -998,6 +1064,8 @@ static HCL_INLINE int is_at_block_beginning (hcl_t* hcl) static int feed_process_token (hcl_t* hcl) { hcl_frd_t* frd = &hcl->c->feed.rd; + hcl_loc_t* list_loc = HCL_NULL; + /* TODO: frd->obj and frd->list_loc can become local variables in this function.. */ /* this function composes an s-expression non-recursively * by manipulating its own stack. */ @@ -1058,9 +1126,10 @@ static int feed_process_token (hcl_t* hcl) /* closer */ int oldflagv; frd->expect_vlist_item = 0; - frd->obj = leave_list(hcl, &frd->flagv, &oldflagv); + frd->obj = leave_list(hcl, &frd->list_loc, &frd->flagv, &oldflagv); frd->level--; frd->flagv |= AT_BEGINNING; + list_loc = &frd->list_loc; break; } else @@ -1132,7 +1201,7 @@ static int feed_process_token (hcl_t* hcl) * a list literal or an array literal */ if (enter_list(hcl, TOKEN_LOC(hcl), frd->flagv) <= -1) goto oops; frd->level++; - frd->flagv |= AT_BEGINNING; /* indicate that the reader is now at the beginning of a list */ + frd->flagv |= AT_BEGINNING; /* the reader is now at the beginning of a list */ /* read the next token */ goto ok; @@ -1189,9 +1258,10 @@ static int feed_process_token (hcl_t* hcl) goto oops; } - frd->obj = leave_list(hcl, &frd->flagv, &oldflagv); + frd->obj = leave_list(hcl, &frd->list_loc, &frd->flagv, &oldflagv); frd->level--; frd->flagv |= AT_BEGINNING; /* the current one is over. move on the beginning for the next expression */ + list_loc = &frd->list_loc; break; } @@ -1199,21 +1269,6 @@ static int feed_process_token (hcl_t* hcl) case HCL_TOK_RBRACK: /* bytearray #[], array [] */ case HCL_TOK_RBRACE: /* dictionary #{}, block {} */ { - static struct - { - int closer; - hcl_synerrnum_t synerr; - } req[] = - { - /*[HCL_CONCODE_XLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN }, /* XLIST ( ) */ - /*[HCL_CONCODE_MLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN }, /* MLIST (: ) */ - /*[HCL_CONCODE_BLOCK] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE }, /* BLOCK { } */ - /*[HCL_CONCODE_ARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK }, /* ARRAY [ ] */ - /*[HCL_CONCODE_BYTEARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY #[ ] */ - /*[HCL_CONCODE_DIC] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE }, /* DIC #{ } */ - /*[HCL_CONCODE_QLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN } /* QLIST #( ) */ - }; - int oldflagv; int concode; @@ -1232,9 +1287,9 @@ static int feed_process_token (hcl_t* hcl) goto oops; } - if (req[concode].closer != TOKEN_TYPE(hcl)) + if (cons_info[concode].closer != TOKEN_TYPE(hcl)) { - hcl_setsynerr (hcl, req[concode].synerr, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); + hcl_setsynerr (hcl, cons_info[concode].synerr, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); goto oops; } @@ -1262,9 +1317,10 @@ static int feed_process_token (hcl_t* hcl) goto oops; } #endif - frd->obj = leave_list(hcl, &frd->flagv, &oldflagv); + frd->obj = leave_list(hcl, &frd->list_loc, &frd->flagv, &oldflagv); frd->level--; frd->flagv |= AT_BEGINNING; + list_loc = &frd->list_loc; break; } @@ -1445,7 +1501,7 @@ static int feed_process_token (hcl_t* hcl) { /* if not, append the element read into the current list. * if we are not at the top frd->level, we must be in a list */ - if (chain_to_list(hcl, frd->obj) <= -1) goto oops; + if (chain_to_list(hcl, frd->obj, list_loc) <= -1) goto oops; /* because it has been chained to the list, it belongs to the current stack top. * mark that obj is not stand-alone by nullifying it. without this, if a jump @@ -1915,16 +1971,16 @@ static int flx_hmarked_char (hcl_t* hcl, hcl_ooci_t c) goto hexcharlit; } #endif - else if (does_token_name_match(hcl, VOCA_BACKSPACE)) c = '\b'; - else if (does_token_name_match(hcl, VOCA_LINEFEED)) c = '\n'; - else if (does_token_name_match(hcl, VOCA_NEWLINE)) c = '\n'; /* TODO: convert it to host newline convention. how to handle if it's composed of 2 letters like \r\n? */ - else if (does_token_name_match(hcl, VOCA_NUL)) c = '\0'; /* null character. not the object null */ - else if (does_token_name_match(hcl, VOCA_PAGE)) c = '\f'; - else if (does_token_name_match(hcl, VOCA_RETURN)) c = '\r'; - else if (does_token_name_match(hcl, VOCA_RUBOUT)) c = '\x7F'; /* DEL */ - else if (does_token_name_match(hcl, VOCA_SPACE)) c = ' '; - else if (does_token_name_match(hcl, VOCA_TAB)) c = '\t'; - else if (does_token_name_match(hcl, VOCA_VTAB)) c = '\v'; + else if (does_token_name_match(hcl, VOCA_CHAR_BACKSPACE)) c = '\b'; + else if (does_token_name_match(hcl, VOCA_CHAR_LINEFEED)) c = '\n'; + else if (does_token_name_match(hcl, VOCA_CHAR_NEWLINE)) c = '\n'; /* TODO: convert it to host newline convention. how to handle if it's composed of 2 letters like \r\n? */ + else if (does_token_name_match(hcl, VOCA_CHAR_NUL)) c = '\0'; /* null character. not the object null */ + else if (does_token_name_match(hcl, VOCA_CHAR_PAGE)) c = '\f'; + else if (does_token_name_match(hcl, VOCA_CHAR_RETURN)) c = '\r'; + else if (does_token_name_match(hcl, VOCA_CHAR_RUBOUT)) c = '\x7F'; /* DEL */ + else if (does_token_name_match(hcl, VOCA_CHAR_SPACE)) c = ' '; + else if (does_token_name_match(hcl, VOCA_CHAR_TAB)) c = '\t'; + else if (does_token_name_match(hcl, VOCA_CHAR_VTAB)) c = '\v'; else { hcl_setsynerrbfmt (hcl, HCL_SYNERR_CHARLIT, TOKEN_LOC(hcl), TOKEN_NAME(hcl), @@ -2869,6 +2925,15 @@ static int init_compiler (hcl_t* hcl) init_feed (hcl); hcl->c->cbp = cbp; + + /* initialize the internal cons to represent a cell pointing to `null` in the `car` part */ + hcl->c->fake_cnode.nil.cn_type = HCL_CNODE_NIL; + hcl->c->fake_cnode.nil.cn_tok.ptr = vocas[VOCA_KW_NULL].str; + hcl->c->fake_cnode.nil.cn_tok.len = vocas[VOCA_KW_NULL].len; + + hcl->c->fake_cnode.cons_to_nil.cn_type = HCL_CNODE_CONS; + hcl->c->fake_cnode.cons_to_nil.u.cons.car = &hcl->c->fake_cnode.nil; + hcl->c->fake_cnode.cons_to_nil.u.cons.cdr = HCL_NULL; return 0; } diff --git a/lib/std.c b/lib/std.c index fc1eca9..f96e07e 100644 --- a/lib/std.c +++ b/lib/std.c @@ -24,6 +24,10 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +#if !defined(_GNU_SOURCE) +# define _GNU_SOURCE +#endif + #include "hcl-prv.h" #include @@ -129,10 +133,6 @@ #else -# if !defined(_GNU_SOURCE) -# define _GNU_SOURCE -# endif - # include # include # include