From 889d5d90ae9453bd5d12976f587c67eab5db8029 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Fri, 10 Nov 2023 02:59:41 +0900 Subject: [PATCH] compiler fix to support the code block expression --- bin/main.c | 2 +- lib/comp.c | 115 ++++++++++++++++++++++++++++++++++++------------- lib/err.c | 1 + lib/read.c | 5 ++- t/insta-01.hcl | 2 +- 5 files changed, 92 insertions(+), 33 deletions(-) diff --git a/bin/main.c b/bin/main.c index 8479e21..6afc2c9 100644 --- a/bin/main.c +++ b/bin/main.c @@ -457,7 +457,7 @@ static int on_fed_cnode_in_interactive_mode (hcl_t* hcl, hcl_cnode_t* obj) static int on_fed_cnode_in_batch_mode (hcl_t* hcl, hcl_cnode_t* obj) { xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl); - return hcl_compile(hcl, obj, xtn->extra_cflags); + return hcl_compile(hcl, obj, xtn->extra_cflags); } static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose) diff --git a/lib/comp.c b/lib/comp.c index b0f55e3..f9078ce 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -1903,27 +1903,14 @@ inside_loop: /* ========================================================================= */ -static int compile_do (hcl_t* hcl, hcl_cnode_t* src) +static int compile_do_list (hcl_t* hcl, hcl_cnode_t* src, hcl_cnode_t* obj) { - hcl_cnode_t* cmd, * obj, * tmp; + hcl_cnode_t* cmd, * tmp; hcl_oow_t nlvars, tvslen; hcl_fnblk_info_t* fbi; hcl_cframe_t* cf; - - /* (do - * (+ 10 20) - * (* 2 30) - * ... - * ) - * you can use this to combine multiple expressions to a single expression - */ - - HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); - HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_DO)); - - cmd = HCL_CNODE_CONS_CAR(src); /* do itself */ - obj = HCL_CNODE_CONS_CDR(src); /* expression list after it */ + //obj = HCL_CNODE_CONS_CDR(src); /* expression list after it */ if (!obj) { @@ -1962,6 +1949,69 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* src) return 0; } +static int compile_do (hcl_t* hcl, hcl_cnode_t* src) +{ + hcl_cnode_t* cmd, * obj, * tmp; + hcl_oow_t nlvars, tvslen; + hcl_fnblk_info_t* fbi; + hcl_cframe_t* cf; + + + /* (do + * (+ 10 20) + * (* 2 30) + * ... + * ) + * you can use this to combine multiple expressions to a single expression + */ + + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_DO)); + + cmd = HCL_CNODE_CONS_CAR(src); /* do itself */ + obj = HCL_CNODE_CONS_CDR(src); /* expression list after it */ + +#if 0 + if (!obj) + { + /* 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; + } + else if (!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) + { + 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]; + fbi->tmprlen = hcl->c->tv.s.len; + fbi->tmprcnt = hcl->c->tv.wcount; + fbi->tmpr_nlvars = fbi->tmpr_nlvars + nlvars; + + SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */ + + PUSH_SUBCFRAME (hcl, COP_COMPILE_DO_P1, src); /* 2 */ + cf = GET_SUBCFRAME(hcl); + cf->u.post_do.lvar_start = tvslen; + cf->u.post_do.lvar_end = fbi->tmprlen; + + return 0; +#else + return compile_do_list(hcl, src, obj); +#endif +} + static int compile_do_p1 (hcl_t* hcl) { hcl_cframe_t* cf; @@ -2701,36 +2751,42 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) } HCL_ASSERT (hcl, nargs + nrvars == hcl->c->tv.wcount - saved_tv_wcount); - obj = HCL_CNODE_CONS_CDR(obj); - if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK) { - hcl_cnode_t* bdy; + hcl_cnode_t* blk, * bdy, * trl; - if (!obj || !HCL_CNODE_IS_CONS(obj)) + blk = HCL_CNODE_CONS_CDR(obj); + if (!blk || !HCL_CNODE_IS_CONS(blk)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(args), HCL_NULL, "block expression expected as body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt ( + hcl, HCL_SYNERR_BLOCK, (blk? HCL_CNODE_GET_LOC(blk): HCL_CNODE_GET_LOC(obj)), HCL_NULL, + "block expression expected as body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } - bdy = HCL_CNODE_CONS_CAR(obj); - if (!bdy || !HCL_CNODE_IS_CONS_CONCODED(bdy, HCL_CONCODE_BLOCK)) + bdy = HCL_CNODE_CONS_CAR(blk); /* {} must be the last item */ + 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))) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(obj), HCL_NULL, "block expression expected as body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt ( + hcl, HCL_SYNERR_BLOCK, (bdy? HCL_CNODE_GET_LOC(bdy): HCL_CNODE_GET_LOC(obj)), HCL_NULL, + "block expression expected as body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } - if (HCL_CNODE_CONS_CDR(bdy)) + if (trl) { - /* TODO: change error code */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(obj), HCL_NULL, "redundant code prohibited after body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(trl), HCL_NULL, "redundant code prohibited after body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } + obj = HCL_CNODE_IS_ELIST(bdy)? HCL_NULL: bdy; nlvars = 0; /* no known local variables until the actual block is processed */ } else { + obj = HCL_CNODE_CONS_CDR(obj); tv_dup_start = hcl->c->tv.s.len; if (collect_vardcls(hcl, obj, &obj, tv_dup_start, &nlvars, "local") <= -1) return -1; @@ -3821,8 +3877,9 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret return 0; } -static int compile_cons_block_expression (hcl_t* hcl, hcl_cnode_t* obj, int nrets) +static int compile_cons_block_expression (hcl_t* hcl, hcl_cnode_t* obj) { + return compile_do_list(hcl, obj, obj); } static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj) @@ -4151,7 +4208,7 @@ redo: hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCKBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "block expression disallowed"); return -1; } - if (compile_cons_block_expression(hcl, oprnd, 0) <= -1) return -1; + if (compile_cons_block_expression(hcl, oprnd) <= -1) return -1; break; case HCL_CONCODE_ARRAY: diff --git a/lib/err.c b/lib/err.c index 487379e..f177b07 100644 --- a/lib/err.c +++ b/lib/err.c @@ -159,6 +159,7 @@ static char* synerrstr[] = "invalid callable", "unbalanced key/value pair", "unbalanced parenthesis/brace/bracket", + "unexpected semicolon", "empty x-list", "empty m-list", "block expression expected" diff --git a/lib/read.c b/lib/read.c index 68830d8..0e66ec3 100644 --- a/lib/read.c +++ b/lib/read.c @@ -1096,7 +1096,6 @@ static int feed_process_token (hcl_t* hcl) case HCL_TOK_LBRACE: /* { */ frd->flagv = 0; LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_BLOCK); -hcl_logbfmt (hcl, HCL_LOG_FATAL, "XXXX [%d,%d]\n", TOKEN_LOC(hcl)->line, TOKEN_LOC(hcl)->colm); goto start_list; case HCL_TOK_DLPAREN: /* #{ */ @@ -2682,10 +2681,11 @@ int hcl_feedbchars (hcl_t* hcl, const hcl_bch_t* data, hcl_oow_t len) if (n <= -1) { + if (n == -2 && outlen > 0) goto ok; + if (n == -2 || n == -3) { hcl_oow_t rsdlen; - HCL_ASSERT (hcl, len > inlen); rsdlen = len - inlen; HCL_ASSERT (hcl, rsdlen <= HCL_COUNTOF(hcl->c->feed.rsd.buf)); @@ -2698,6 +2698,7 @@ int hcl_feedbchars (hcl_t* hcl, const hcl_bch_t* data, hcl_oow_t len) return -1; } + ok: inpos += inlen; len -= inlen; } diff --git a/t/insta-01.hcl b/t/insta-01.hcl index 9c06de0..029118a 100644 --- a/t/insta-01.hcl +++ b/t/insta-01.hcl @@ -1,4 +1,4 @@ -; test class instantiation methods +## test class instantiation methods (defclass A | a b c |