From ac818fdbfd7cd623a97ea49f907c98259c5c6130 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Tue, 18 Oct 2016 17:00:35 +0000 Subject: [PATCH] implemented else handling --- lib/comp.c | 187 ++++++++++++++++++++++++++++++++++++++++++-------- lib/gc.c | 2 + lib/hcl-prv.h | 1 - lib/hcl.h | 20 ++++-- lib/main.c | 2 + 5 files changed, 176 insertions(+), 36 deletions(-) diff --git a/lib/comp.c b/lib/comp.c index a2b4ecc..37730f5 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -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; diff --git a/lib/gc.c b/lib/gc.c index 7561dbc..0ceb377 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -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) }, diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index afa1c19..98a04c8 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -297,7 +297,6 @@ struct hcl_cframe_t struct { - hcl_ooi_t cond_pos; hcl_ooi_t body_pos; } post_if; } u; diff --git a/lib/hcl.h b/lib/hcl.h index 448b517..ea8a23a 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -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, diff --git a/lib/main.c b/lib/main.c index 15bae23..d869bb3 100644 --- a/lib/main.c +++ b/lib/main.c @@ -601,6 +601,8 @@ static char* syntax_error_msg[] = "disallowed variable name", "disallowed argument name", + "elif without if", + "else without if", "break outside loop" };