added code to check if the body after if-condition or else is a block expression. work in progress
Some checks failed
continuous-integration/drone/push Build is failing
Some checks failed
continuous-integration/drone/push Build is failing
This commit is contained in:
parent
1c083885bc
commit
f42508731d
58
lib/comp.c
58
lib/comp.c
@ -401,6 +401,26 @@ HCL_INFO2 (hcl, "CLASS NAMED VAR [%.*js]\n", name->len, name->ptr);
|
||||
|
||||
/* ========================================================================= */
|
||||
|
||||
static int is_cons_pointing_to_block_in_car (hcl_t* hcl, hcl_cnode_t* c, hcl_cnode_t** blk)
|
||||
{
|
||||
hcl_cnode_t* car;
|
||||
|
||||
if (!c || !HCL_CNODE_IS_CONS(c)) goto no_block; /* not cons */
|
||||
|
||||
car = HCL_CNODE_CONS_CAR(c);
|
||||
if (!car || (!HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_BLOCK) && !HCL_CNODE_IS_ELIST_CONCODED(car, HCL_CONCODE_BLOCK)))
|
||||
{
|
||||
no_block:
|
||||
*blk = HCL_NULL;
|
||||
return 0;
|
||||
}
|
||||
|
||||
*blk = car;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* ========================================================================= */
|
||||
|
||||
static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
|
||||
{
|
||||
hcl_oow_t capa, i, lfbase = 0;
|
||||
@ -2205,11 +2225,25 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
|
||||
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;
|
||||
}
|
||||
else
|
||||
|
||||
|
||||
if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
|
||||
{
|
||||
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
|
||||
hcl_cnode_t* blk;
|
||||
|
||||
if (!is_cons_pointing_to_block_in_car(hcl, obj, &blk))
|
||||
{
|
||||
hcl_setsynerrbfmt (
|
||||
hcl, HCL_SYNERR_BLOCK, (blk? HCL_CNODE_GET_LOC(blk): &cf->u.post_if.start_loc), HCL_NULL,
|
||||
"block expression expected as body after else");
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* TODO: check if it's the only expression... */
|
||||
}
|
||||
|
||||
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
|
||||
|
||||
return patch_nearest_post_if_body(hcl, cmd);
|
||||
}
|
||||
|
||||
@ -4278,7 +4312,8 @@ redo:
|
||||
case HCL_CONCODE_BLOCK:
|
||||
if (!(hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK))
|
||||
{
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty block expression");
|
||||
/* this is treated the same as HCL_CNODE_CONS with CONCODE BLOCK */
|
||||
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) <= -1) return -1;
|
||||
@ -4479,7 +4514,7 @@ static int compile_object_list (hcl_t* hcl)
|
||||
* and onwards. this goes above COP_COMPILE_OBJECT.*/
|
||||
|
||||
/* TODO: if the previous operators is known to divert execution flow, it may skip this.
|
||||
* for instance, some 'RETURN" or 'JUMP' operators */
|
||||
* for instance, some 'RETURN' or 'JUMP' operators */
|
||||
PUSH_CFRAME (hcl, COP_EMIT_POP_STACKTOP, oprnd);
|
||||
}
|
||||
}
|
||||
@ -4704,6 +4739,21 @@ static HCL_INLINE int post_if_cond (hcl_t* hcl)
|
||||
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
|
||||
body_pos = hcl->code.bc.len;
|
||||
|
||||
if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
|
||||
{
|
||||
hcl_cnode_t* blk;
|
||||
|
||||
if (!is_cons_pointing_to_block_in_car(hcl, cf->operand, &blk))
|
||||
{
|
||||
hcl_setsynerrbfmt (
|
||||
hcl, HCL_SYNERR_BLOCK, (blk? HCL_CNODE_GET_LOC(blk): &cf->u.post_if.start_loc), HCL_NULL,
|
||||
"block expression expected as body after condition");
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* TODO: check if it's the only expression... */
|
||||
}
|
||||
|
||||
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_IF_OBJECT_LIST, cf->operand); /* 1 */
|
||||
PUSH_SUBCFRAME (hcl, COP_POST_IF_BODY, cf->operand); /* 2 */
|
||||
cf2 = GET_SUBCFRAME(hcl);
|
||||
|
Loading…
Reference in New Issue
Block a user