hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

enhanced the reader and compiler to treat the binop expression like a message-send expression
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan
2024-09-03 12:18:08 +09:00
parent 4c1a50df83
commit a62b89cea9
18 changed files with 197 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
lib/comp.c
View File

@ -4054,11 +4054,11 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
goto done;
case HCL_CNODE_ELIF:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELSE, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "else without if");
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELSE, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "elif without if");
return -1;
case HCL_CNODE_ELSE:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELIF, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "elif without if");
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELIF, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "else without if");
return -1;
case HCL_CNODE_THROW:
@ -4215,6 +4215,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
else if (HCL_CNODE_IS_SYMBOL(car) || HCL_CNODE_IS_DSYMBOL(car) ||
HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_XLIST) ||
HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_MLIST) ||
HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_BLIST) ||
HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_ALIST))
{
/* normal function call
@ -4319,8 +4320,11 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
/* message sending
* (:<receiver> <operator> <operand1> ...)
* (<receiver>:<operator> <operand1> ...)
* (<receiver> <binop> <operand>
*/
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST));
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_BLIST) ||
HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST));
car = HCL_CNODE_CONS_CAR(obj);
if (HCL_CNODE_IS_SYMBOL(car) && (syncode = HCL_CNODE_SYMBOL_SYNCODE(car)))
@ -4914,7 +4918,8 @@ redo:
if (compile_cons_xlist_expression(hcl, oprnd, 0) <= -1) return -1;
break;
case HCL_CONCODE_MLIST:
case HCL_CONCODE_BLIST: /* message send with binop */
case HCL_CONCODE_MLIST: /* message send expression */
if (compile_cons_mlist_expression(hcl, oprnd, 0) <= -1) return -1;
break;
@ -4969,6 +4974,11 @@ redo:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty executable list");
return -1;
case HCL_CONCODE_BLIST:
/* this must not happend as the reader prevents it */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty binop 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;
@ -5056,23 +5066,32 @@ static int compile_object_r (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT_R);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
oprnd = cf->operand;
if (HCL_CNODE_IS_CONS_CONCODED(oprnd, HCL_CONCODE_XLIST))
oprnd = cf->operand;
if (HCL_CNODE_IS_CONS(oprnd))
{
return compile_cons_xlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
}
else if (HCL_CNODE_IS_CONS_CONCODED(oprnd, HCL_CONCODE_MLIST))
{
return compile_cons_mlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
}
hcl_concode_t cc;
/*
else if (HCL_CNODE_IS_CONS_CONCODED(oprnd, HCL_CONCODE_ALIST))
{
ALIST is transformed to XLIST with or set or set-r by the reader.
so it must not appear here..
cc = HCL_CNODE_CONS_CONCODE(oprnd);
switch (cc)
{
case HCL_CONCODE_XLIST:
return compile_cons_xlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
case HCL_CONCODE_BLIST:
case HCL_CONCODE_MLIST:
return compile_cons_mlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
#if 0
case HCL_CONCODE_ALIST:
/* TODO: can support it? */
k := ([a, b, c] := (+ 10 20 30))
break;
#endif
default:
break;
}
}
*/
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "non-function call/non-message send disallowed");
return -1;

2
lib/exec.c
View File

@ -2382,7 +2382,7 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
hcl_loc_t loc;
dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled %js:%zu- %O", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline, val);
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled %js:%zu - %O", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline, val);
HCL_MEMSET (&loc, 0, HCL_SIZEOF(loc));
loc.file = dbgi[ip].fname;
loc.line = dbgi[ip].sline;

3
lib/prim.c
View File

@ -1280,7 +1280,8 @@ static pf_t builtin_prims[] =
{ 2, 2, pf_number_lt, 1, { '<' } },
{ 2, 2, pf_number_le, 2, { '<','=' } },
{ 2, 2, pf_number_eq, 1, { '=' } },
{ 2, 2, pf_number_ne, 2, { '/','=' } },
{ 2, 2, pf_number_eq, 2, { '=', '=' } },
{ 2, 2, pf_number_ne, 2, { '~','=' } },
/* bitwise operations are supported for integers only */
{ 2, 2, pf_integer_band, 7, { 'b','i','t','-','a','n','d' } },

4
lib/print.c
View File

@ -841,6 +841,10 @@ void hcl_dumpcnode (hcl_t* hcl, hcl_cnode_t* cnode, int newline)
case HCL_CONCODE_ALIST:
hcl_logbfmt (hcl, HCL_LOG_FATAL, " := ");
break;
case HCL_CONCODE_BLIST:
case HCL_CONCODE_MLIST:
hcl_logbfmt (hcl, HCL_LOG_FATAL, ":");
break;
}
hcl_dumpcnode (hcl, HCL_CNODE_CONS_CDR(cnode),0);

47
lib/read.c
View File

@ -203,6 +203,7 @@ static struct
static int init_compiler (hcl_t* hcl);
static void feed_continue (hcl_t* hcl, hcl_flx_state_t state);
static int is_at_block_beginning (hcl_t* hcl);
/* ----------------------------------------------------------------- */
@ -762,8 +763,16 @@ but the check isn't complemete if more operands are added without an operator e.
goto oops;
}
#define TRANSFORM_BLIST
#if defined(TRANSFORM_BLIST)
/* this part is to transform (x binop y) to (binop x y).
* if transformation is done, it is a normal executable expression
* where the binary operator is a primitive function.
*
* alternatively, the compiler treat this as a message send expression
* if the reader skips this transformation.
*
* We keep this part commented out to have this trated as a message
* send expression. */
HCL_CNODE_CONS_CDR(head) = HCL_CNODE_CONS_CDR(binop);
HCL_CNODE_CONS_CDR(binop) = head;
head = binop;
@ -928,14 +937,33 @@ static HCL_INLINE int can_binop_list (hcl_t* hcl)
rstl = hcl->c->r.st;
cc = (hcl_concode_t)LIST_FLAG_GET_CONCODE(rstl->flagv);
if (rstl->count <= 0 || cc == HCL_CONCODE_TUPLE)
if (rstl->count <= 0 || cc == HCL_CONCODE_TUPLE || is_at_block_beginning(hcl))
{
/* allowed but it must be treated like a normal identifier.
* in case of the tuple, chain_to_list() rejects binop symbols.
* so let this routine to allow it as a normal indentifier. */
* so let this routine to allow it as a normal indentifier.
*
* when the expression is inside a block enclosed in {},
* rstl->count is the number of preceding expression.
* call is_at_block_begigging() separately to check if it is
* at the beging of the sub-expression. For example,
* { a := 10; b := 20; + a b }
* when this function is called for '+' above, rstl->count is 2.
*/
return 1;
}
if (rstl->count >= 1 && cc == HCL_CONCODE_XLIST)
{
/* special case:
* fun xxx::+() { }
* fun + () {}
*/
/* TODO: this whole block is hacky. we may do proper parsing instead of checking the first element is 'fun' */
if (HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(rstl->head), HCL_CNODE_FUN)) return 1;
}
/* repeated delimiters - e.g (a ++ ++ ...) (a : := ... ) */
if (rstl->flagv & (COMMAED | COLONED | COLONEQED | BINOPED)) return 0;
@ -962,15 +990,12 @@ static HCL_INLINE int can_binop_list (hcl_t* hcl)
fake_tok.len = vocas[VOCA_BLIST].len;
fake_tok_ptr = &fake_tok;
hcl_logbfmt(hcl, HCL_LOG_STDERR, "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXxx\n");
if (rstl->head) hcl_dumpcnode(hcl, rstl->head, 1);
else hcl_logbfmt(hcl, HCL_LOG_STDERR, "rstl->head is null\n");
if (rstl->tail) hcl_dumpcnode(hcl, rstl->tail, 1);
else hcl_logbfmt(hcl, HCL_LOG_STDERR, "rstl->tail is null\n");
/* dirty hack to create a wrapper cell containing the first three items.
* TODO: do i have to do this on the caller side of can_binop_list()? */
HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(rstl->head, HCL_CNODE_CONS));
wrap = hcl_makecnodecons(hcl, 0, HCL_CNODE_GET_LOC(rstl->head), fake_tok_ptr, rstl->head, rstl->head->u.cons.cdr);
wrap = hcl_makecnodecons(hcl, 0, HCL_CNODE_GET_LOC(rstl->head), fake_tok_ptr, rstl->head, HCL_NULL);
if (HCL_UNLIKELY(!wrap)) return -1;
HCL_CNODE_CONS_CONCODE(rstl->head) = HCL_CONCODE_BLIST;
rstl->head = wrap;
rstl->tail = wrap;
@ -1279,7 +1304,7 @@ static void feed_clean_up_reader_stack (hcl_t* hcl)
}
}
static HCL_INLINE int is_at_block_beginning (hcl_t* hcl)
static int is_at_block_beginning (hcl_t* hcl)
{
hcl_rstl_t* rstl;
rstl = hcl->c->r.st;