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

implemented else handling

Browse Source
This commit is contained in:
hyung-hwan 2016-10-18 17:00:35 +00:00
parent 57af7d6c7e
commit ac818fdbfd
5 changed files with 176 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

187
lib/comp.c
View File

@ -583,6 +583,20 @@ static int push_subcframe (hcl_t* hcl, int opcode, hcl_oop_t operand)
return push_cframe (hcl, tmp.opcode, tmp.operand);
}
static HCL_INLINE hcl_cframe_t* find_cframe_from_top (hcl_t* hcl, int opcode)
{
hcl_cframe_t* cf;
hcl_ooi_t i;
for (i = hcl->c->cfs.top; i >= 0; i--)
{
cf = &hcl->c->cfs.ptr[i];
if (cf->opcode == opcode) return cf;
}
return HCL_NULL;
}
#define PUSH_SUBCFRAME(hcl,opcode,operand) \
do { if (push_subcframe(hcl,opcode,operand) <= -1) return -1; } while(0)
@ -593,6 +607,10 @@ enum
COP_COMPILE_OBJECT,
COP_COMPILE_OBJECT_LIST,
COP_COMPILE_ARGUMENT_LIST,
COP_COMPILE_IF_OBJECT_LIST,
COP_SUBCOMPILE_ELIF,
COP_SUBCOMPILE_ELSE,
COP_EMIT_CALL,
COP_EMIT_LAMBDA,
@ -699,15 +717,15 @@ static int compile_if (hcl_t* hcl, hcl_oop_t src)
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
else if (HCL_BRANDOF(hcl, obj) != HCL_BRAND_CONS)
else if (!HCL_IS_CONS(hcl, obj))
{
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in if - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
cond_pos = hcl->code.bc.len; /* position where the bytecode for the conditional is emitted */
HCL_ASSERT (cond_pos < HCL_SMOOI_MAX);
cond = HCL_CONS_CAR(obj);
obj = HCL_CONS_CDR(obj);
@ -715,9 +733,9 @@ static int compile_if (hcl_t* hcl, hcl_oop_t src)
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, cond); /* 1 */
PUSH_SUBCFRAME (hcl, COP_POST_IF_COND, obj); /* 2 */
cf = GET_SUBCFRAME (hcl);
cf->u.post_if.cond_pos = cond_pos;
cf->u.post_if.body_pos = 0; /* unknown yet */
/* TODO: pass information on the conditional if it's an absoluate true or absolute false to
cf->u.post_if.body_pos = -1; /* unknown yet */
/* TODO: OPTIMIZATION:
* pass information on the conditional if it's an absoluate true or absolute false to
* eliminate some code .. i can't eliminate code because there can be else or elsif...
* if absoluate true, don't need else or other elsif part
* if absoluate false, else or other elsif part is needed.
@ -921,7 +939,7 @@ static int compile_return (hcl_t* hcl, hcl_oop_t src)
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
else if (HCL_BRANDOF(hcl, obj) != HCL_BRAND_CONS)
else if (!HCL_IS_CONS(hcl, obj))
{
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in return - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
@ -961,7 +979,7 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src)
hcl_setsynerr (hcl, HCL_SYNERR_VARNAME, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
else if (HCL_BRANDOF(hcl, obj) != HCL_BRAND_CONS)
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 */
@ -991,7 +1009,7 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src)
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
else if (HCL_BRANDOF(hcl, obj) != HCL_BRAND_CONS)
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 */
@ -1049,15 +1067,15 @@ static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop)
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
else if (HCL_BRANDOF(hcl, obj) != HCL_BRAND_CONS)
else if (!HCL_IS_CONS(hcl, obj))
{
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in while - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
cond_pos = hcl->code.bc.len; /* position where the bytecode for the conditional is emitted */
HCL_ASSERT (cond_pos < HCL_SMOOI_MAX);
cond = HCL_CONS_CAR(obj);
obj = HCL_CONS_CDR(obj);
@ -1066,7 +1084,7 @@ static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop)
PUSH_SUBCFRAME (hcl, next_cop, obj); /* 2 */
cf = GET_SUBCFRAME (hcl);
cf->u.post_while.cond_pos = cond_pos;
cf->u.post_while.body_pos = 0; /* unknown yet*/
cf->u.post_while.body_pos = -1; /* unknown yet*/
return 0;
}
@ -1100,6 +1118,15 @@ HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
/* TODO: not implemented yet */
break;
case HCL_SYNCODE_ELSE:
HCL_DEBUG1 (hcl, "Syntax error - else without if - %O\n", obj);
hcl_setsynerr (hcl, HCL_SYNERR_ELSE, HCL_NULL, HCL_NULL); /* error location */
return -1;
case HCL_SYNCODE_ELIF:
HCL_DEBUG1 (hcl, "Syntax error - elif without if - %O\n", obj);
hcl_setsynerr (hcl, HCL_SYNERR_ELIF, HCL_NULL, HCL_NULL); /* error location */
return -1;
case HCL_SYNCODE_IF:
if (compile_if (hcl, obj) <= -1) return -1;
break;
@ -1323,7 +1350,8 @@ static int compile_object_list (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_COMPILE_OBJECT_LIST ||
cf->opcode == COP_COMPILE_ARGUMENT_LIST);
cf->opcode == COP_COMPILE_ARGUMENT_LIST ||
cf->opcode == COP_COMPILE_IF_OBJECT_LIST);
if (HCL_IS_NIL(hcl, cf->operand))
{
@ -1344,6 +1372,21 @@ static int compile_object_list (hcl_t* hcl)
cop = cf->opcode;
car = HCL_CONS_CAR(cf->operand);
cdr = HCL_CONS_CDR(cf->operand);
if (cop == COP_COMPILE_IF_OBJECT_LIST)
{
if (car == hcl->_elif)
{
SWITCH_TOP_CFRAME (hcl, COP_SUBCOMPILE_ELIF, cf->operand);
goto done;
}
else if (car == hcl->_else)
{
SWITCH_TOP_CFRAME (hcl, COP_SUBCOMPILE_ELSE, cf->operand);
goto done;
}
}
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
if (!HCL_IS_NIL(hcl, cdr))
@ -1356,11 +1399,16 @@ static int compile_object_list (hcl_t* hcl)
* (lambda (x y) (+ x 10) (+ y 20))
* - the result of (+ x 10) should be popped before (+ y 20)
* is executed
*
* for the latter, inject POP_STACKTOP after each object evaluation
* except the last.
*/
PUSH_SUBCFRAME (hcl, cop, cdr);
if (cop == COP_COMPILE_OBJECT_LIST)
{
/* let's arrange to emit POP before generating code for the rest of the list */
/* let's arrange to emit POP_STACKTOP before generating
* code for the rest of the list. */
hcl_oop_t tmp;
/* look ahead for some special functions */
tmp = HCL_CONS_CAR(cdr);
@ -1370,34 +1418,115 @@ static int compile_object_list (hcl_t* hcl)
}
}
done:
return 0;
}
/* ========================================================================= */
static HCL_INLINE int subcompile_elif (hcl_t* hcl)
{
HCL_DEBUG0 (hcl, "TODO: ELIF HANDLING\n");
return -1;
}
static HCL_INLINE int subcompile_else (hcl_t* hcl)
{
hcl_oop_t obj, src;
hcl_ooi_t jump_inst_pos, body_pos;
hcl_ooi_t jip, jump_offset;
hcl_cframe_t* cf;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_SUBCOMPILE_ELSE);
src = cf->operand;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_else);
obj = HCL_CONS_CDR(src);
if (!HCL_IS_NIL(hcl, obj) && !HCL_IS_CONS(hcl, obj))
{
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in else - %O\n", src);
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
return -1;
}
cf = find_cframe_from_top (hcl, COP_POST_IF_BODY);
HCL_ASSERT (cf != HCL_NULL);
/* jump instruction position of the JUMP_FORWARD_IF_FALSE after the conditional */
jip = HCL_OOP_TO_SMOOI(cf->operand);
if (hcl->code.bc.len <= cf->u.post_if.body_pos)
{
/* the if body is empty. */
if (emit_byte_instruction (hcl, HCL_CODE_PUSH_NIL) <= -1) return -1;
}
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
jump_inst_pos = hcl->code.bc.len;
/* emit jump_forward at the beginning of the else block.
* this is to make the earlier if or elsif block to skip
* the else part. it is to be patched in post_else_body(). */
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP) <= -1) return -1;
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
jump_offset = hcl->code.bc.len - jip - (HCL_BCODE_LONG_PARAM_SIZE + 1);
if (jump_offset > MAX_CODE_JUMP * 2)
{
HCL_DEBUG1 (hcl, "code in else body too big - size %zu\n", jump_offset);
hcl_setsynerr (hcl, HCL_SYNERR_IFFLOOD, HCL_NULL, HCL_NULL); /* error location */
return -1;
}
patch_long_jump (hcl, jip, jump_offset);
/* beginning of the else block code */
/* to drop the result of the conditional when the conditional is false */
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP) <= -1) return -1;
/* this is the actual beginning */
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
body_pos = hcl->code.bc.len;
/* modify the POST_IF_BODY frame */
HCL_ASSERT (cf->opcode == COP_POST_IF_BODY);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
cf->operand = HCL_SMOOI_TO_OOP(jump_inst_pos);
cf->u.post_if.body_pos = body_pos;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
return 0;
}
/* ========================================================================= */
static HCL_INLINE int post_if_cond (hcl_t* hcl)
{
hcl_cframe_t* cf;
hcl_ooi_t jump_inst_pos;
hcl_ooi_t cond_pos, body_pos;
hcl_ooi_t body_pos;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_POST_IF_COND);
cond_pos = cf->u.post_while.cond_pos;
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
jump_inst_pos = hcl->code.bc.len;
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP) <= -1) return -1;
/* to drop the result of the conditional when it is true */
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP) <= -1) return -1;
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
body_pos = hcl->code.bc.len;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, cf->operand); /* 1 */
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_IF_OBJECT_LIST, cf->operand); /* 1 */
PUSH_SUBCFRAME (hcl, COP_POST_IF_BODY, HCL_SMOOI_TO_OOP(jump_inst_pos)); /* 2 */
cf = GET_SUBCFRAME(hcl);
cf->u.post_if.cond_pos = cond_pos;
cf->u.post_if.body_pos = body_pos;
return 0;
}
@ -1414,30 +1543,23 @@ static HCL_INLINE int post_if_body (hcl_t* hcl)
jip = HCL_OOP_TO_SMOOI(cf->operand);
if (hcl->code.bc.len <= cf->u.post_while.body_pos)
if (hcl->code.bc.len <= cf->u.post_if.body_pos)
{
/* if body is empty */
/*if (emit_byte_instruction (hcl, HCL_CODE_PUSH_NIL) <= -1) return -1;*/
/* if body is empty, remove all instructions generated for the body so far */
hcl->code.bc.len = jip;
goto done;
if (emit_byte_instruction (hcl, HCL_CODE_PUSH_NIL) <= -1) return -1;
}
HCL_ASSERT (hcl->code.bc.len >= cf->u.post_while.cond_pos);
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE instruction */
jump_offset = hcl->code.bc.len - jip - (HCL_BCODE_LONG_PARAM_SIZE + 1);
if (jump_offset > MAX_CODE_JUMP * 2)
{
HCL_DEBUG1 (hcl, "code in if body too big - size %zu\n", jump_offset);
hcl_setsynerr (hcl, HCL_SYNERR_BLKFLOOD, HCL_NULL, HCL_NULL); /* error location */
HCL_DEBUG1 (hcl, "code in if-else body too big - size %zu\n", jump_offset);
hcl_setsynerr (hcl, HCL_SYNERR_IFFLOOD, HCL_NULL, HCL_NULL); /* error location */
return -1;
}
patch_long_jump (hcl, jip, jump_offset);
/* TOOD: if 'else' or 'elsif' appears, process further... */
done:
POP_CFRAME (hcl);
return 0;
}
@ -1716,6 +1838,7 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
case COP_COMPILE_OBJECT_LIST:
case COP_COMPILE_ARGUMENT_LIST:
case COP_COMPILE_IF_OBJECT_LIST:
if (compile_object_list (hcl) <= -1) goto oops;
break;
@ -1757,6 +1880,14 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
if (post_while_cond (hcl) <= -1) goto oops;
break;
case COP_SUBCOMPILE_ELIF:
if (subcompile_elif (hcl) <= -1) goto oops;
break;
case COP_SUBCOMPILE_ELSE:
if (subcompile_else (hcl) <= -1) goto oops;
break;
case COP_UPDATE_BREAK:
if (update_break (hcl) <= -1) goto oops;
break;

2
lib/gc.c
View File

@ -37,6 +37,8 @@ static struct
{ 5, { 'b','e','g','i','n' }, HCL_SYNCODE_BEGIN, HCL_OFFSETOF(hcl_t,_begin) },
{ 5, { 'b','r','e','a','k' }, HCL_SYNCODE_BREAK, HCL_OFFSETOF(hcl_t,_break) },
{ 5, { 'd','e','f','u','n' }, HCL_SYNCODE_DEFUN, HCL_OFFSETOF(hcl_t,_defun) },
{ 4, { 'e','l','i','f' }, HCL_SYNCODE_ELIF, HCL_OFFSETOF(hcl_t,_elif) },
{ 4, { 'e','l','s','e' }, HCL_SYNCODE_ELSE, HCL_OFFSETOF(hcl_t,_else) },
{ 2, { 'i','f' }, HCL_SYNCODE_IF, HCL_OFFSETOF(hcl_t,_if) },
{ 6, { 'l','a','m','b','d','a' }, HCL_SYNCODE_LAMBDA, HCL_OFFSETOF(hcl_t,_lambda) },
{ 5, { 'q','u','o','t','e' }, HCL_SYNCODE_QUOTE, HCL_OFFSETOF(hcl_t,_quote) },

1
lib/hcl-prv.h
View File

@ -297,7 +297,6 @@ struct hcl_cframe_t
struct
{
hcl_ooi_t cond_pos;
hcl_ooi_t body_pos;
} post_if;
} u;

20
lib/hcl.h
View File

@ -111,6 +111,8 @@ enum hcl_synerrnum_t
HCL_SYNERR_BANNEDVARNAME, /* disallowed varible name */
HCL_SYNERR_BANNEDARGNAME, /* disallowed argument name */
HCL_SYNERR_ELIF, /* elif without if */
HCL_SYNERR_ELSE, /* else without if */
HCL_SYNERR_BREAK /* break outside loop */
};
typedef enum hcl_synerrnum_t hcl_synerrnum_t;
@ -839,16 +841,18 @@ struct hcl_t
hcl_oop_t _true;
hcl_oop_t _false;
hcl_oop_t _begin; /* symbol */
hcl_oop_t _break; /* symbol */
hcl_oop_t _defun; /* symbol */
hcl_oop_t _begin; /* symbol */
hcl_oop_t _break; /* symbol */
hcl_oop_t _defun; /* symbol */
hcl_oop_t _elif; /* symbol */
hcl_oop_t _else; /* symbol */
hcl_oop_t _if; /* symbol */
hcl_oop_t _lambda; /* symbol */
hcl_oop_t _quote; /* symbol */
hcl_oop_t _quote; /* symbol */
hcl_oop_t _return; /* symbol */
hcl_oop_t _set; /* symbol */
hcl_oop_t _until; /* symbol */
hcl_oop_t _while; /* symbol */
hcl_oop_t _set; /* symbol */
hcl_oop_t _until; /* symbol */
hcl_oop_t _while; /* symbol */
/* == NEVER CHANGE THE ORDER OF FIELDS BELOW == */
/* hcl_ignite() assumes this order. make sure to update symnames in ignite_3() */
@ -1030,6 +1034,8 @@ enum
HCL_SYNCODE_BEGIN = 1,
HCL_SYNCODE_BREAK,
HCL_SYNCODE_DEFUN,
HCL_SYNCODE_ELIF,
HCL_SYNCODE_ELSE,
HCL_SYNCODE_IF,
HCL_SYNCODE_LAMBDA,
HCL_SYNCODE_QUOTE,

2
lib/main.c
View File

@ -601,6 +601,8 @@ static char* syntax_error_msg[] =
"disallowed variable name",
"disallowed argument name",
"elif without if",
"else without if",
"break outside loop"
};