diff --git a/lib/comp.c b/lib/comp.c index 7294b7b..88047b8 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -3172,7 +3172,9 @@ static int compile_return (hcl_t* hcl, hcl_cnode_t* src, int ret_from_home) HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN) || - HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN_FROM_HOME)); + HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_REVERT) || + HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_RETURN) || + HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(src), HCL_CNODE_REVERT)); fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth]; obj = HCL_CNODE_CONS_CDR(src); @@ -3952,6 +3954,16 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret case HCL_CNODE_WHILE: if (compile_while(hcl, obj, COP_POST_WHILE_COND) <= -1) return -1; goto done; + + case HCL_CNODE_RETURN: + /* (return 10) + * (return (+ 10 20)) */ + if (compile_return(hcl, obj, 0) <= -1) return -1; + goto done; + + case HCL_CNODE_REVERT: + if (compile_return(hcl, obj, 1) <= -1) return -1; + goto done; } if (HCL_CNODE_IS_SYMBOL(car) && (syncode = HCL_CNODE_SYMBOL_SYNCODE(car))) @@ -4023,6 +4035,16 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret if (compile_plus(hcl, obj) <= -1) return -1; break; + case HCL_SYNCODE_RETURN: + /* (return 10) + * (return (+ 10 20)) */ + if (compile_return(hcl, obj, 0) <= -1) return -1; + break; + + case HCL_SYNCODE_REVERT: + if (compile_return(hcl, obj, 1) <= -1) return -1; + break; + case HCL_SYNCODE_SET: /* (set x 10) * (set x (fun (x y) (+ x y)) */ @@ -4034,16 +4056,6 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret if (compile_set_r(hcl, obj) <= -1) return -1; break; - case HCL_SYNCODE_RETURN: - /* (return 10) - * (return (+ 10 20)) */ - if (compile_return(hcl, obj, 0) <= -1) return -1; - break; - - case HCL_SYNCODE_RETURN_FROM_HOME: - if (compile_return(hcl, obj, 1) <= -1) return -1; - break; - case HCL_SYNCODE_THROW: if (compile_throw(hcl, obj) <= -1) return -1; break; diff --git a/lib/gc.c b/lib/gc.c index 6518eae..30dd1eb 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -47,13 +47,12 @@ static struct { 2, { 'd','o' }, HCL_SYNCODE_DO, HCL_OFFSETOF(hcl_t,s_do) }, { 4, { 'e','l','i','f' }, HCL_SYNCODE_ELIF, HCL_OFFSETOF(hcl_t,s_elif) }, { 4, { 'e','l','s','e' }, HCL_SYNCODE_ELSE, HCL_OFFSETOF(hcl_t,s_else) }, - { 3, { 'f','u','n' }, HCL_SYNCODE_FUN, HCL_OFFSETOF(hcl_t,s_fun) }, + { 3, { 'f','u','n' }, HCL_SYNCODE_FUN, HCL_OFFSETOF(hcl_t,s_fun) }, { 2, { 'i','f' }, HCL_SYNCODE_IF, HCL_OFFSETOF(hcl_t,s_if) }, { 2, { 'o','r' }, HCL_SYNCODE_OR, HCL_OFFSETOF(hcl_t,s_or) }, { 4, { 'p','l','u','s' }, HCL_SYNCODE_PLUS, HCL_OFFSETOF(hcl_t,s_plus) }, { 6, { 'r','e','t','u','r','n'}, HCL_SYNCODE_RETURN, HCL_OFFSETOF(hcl_t,s_return) }, - { 16, { 'r','e','t','u','r','n','-','f','r','o','m','-','h','o','m','e'}, - HCL_SYNCODE_RETURN_FROM_HOME, HCL_OFFSETOF(hcl_t,s_return_from_home) }, + { 6, { 'r','e','v','e','r','t'}, HCL_SYNCODE_REVERT, HCL_OFFSETOF(hcl_t,s_revert) }, { 3, { 's','e','t' }, HCL_SYNCODE_SET, HCL_OFFSETOF(hcl_t,s_set) }, { 5, { 's','e','t','-','r' }, HCL_SYNCODE_SET_R, HCL_OFFSETOF(hcl_t,s_set_r) }, { 5, { 't','h','r','o','w' }, HCL_SYNCODE_THROW, HCL_OFFSETOF(hcl_t,s_throw) }, diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index bb775ca..5e023b0 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -313,6 +313,8 @@ enum hcl_tok_type_t HCL_TOK_CONTINUE, HCL_TOK_UNTIL, HCL_TOK_WHILE, + HCL_TOK_RETURN, + HCL_TOK_REVERT, HCL_TOK_BINOP, HCL_TOK_IDENT, @@ -407,6 +409,8 @@ enum hcl_cnode_type_t HCL_CNODE_CONTINUE, HCL_CNODE_UNTIL, HCL_CNODE_WHILE, + HCL_CNODE_RETURN, + HCL_CNODE_REVERT, HCL_CNODE_ELLIPSIS, HCL_CNODE_TRPCOLONS, diff --git a/lib/hcl.h b/lib/hcl.h index e1c3007..f461325 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -1681,7 +1681,7 @@ struct hcl_t hcl_oop_t s_or; /* symbol */ hcl_oop_t s_plus; /* symbol */ hcl_oop_t s_return; /* symbol */ - hcl_oop_t s_return_from_home; /* symbol */ + hcl_oop_t s_revert; /* symbol */ hcl_oop_t s_set; /* symbol */ hcl_oop_t s_set_r; /* symbol */ hcl_oop_t s_throw; /* symbol */ @@ -2047,8 +2047,8 @@ enum hcl_syncode_t HCL_SYNCODE_FUN, HCL_SYNCODE_OR, HCL_SYNCODE_PLUS, - HCL_SYNCODE_RETURN, - HCL_SYNCODE_RETURN_FROM_HOME, + HCL_SYNCODE_RETURN, /* local return. return from the current context. */ + HCL_SYNCODE_REVERT, /* non-local return. return from home context */ HCL_SYNCODE_SET, HCL_SYNCODE_SET_R, HCL_SYNCODE_THROW, diff --git a/lib/read.c b/lib/read.c index 991cd84..bcd65ca 100644 --- a/lib/read.c +++ b/lib/read.c @@ -70,6 +70,8 @@ static struct voca_t { 8, { 'c','o','n','t','i','n','u','e' } }, { 5, { 'u','n','t','i','l' } }, { 5, { 'w','h','i','l','e' } }, + { 6, { 'r','e','t','u','r','n' } }, + { 6, { 'r','e','v','e','r','t' } }, { 3, { 's','e','t' } }, { 5, { 's','e','t','-','r' } }, @@ -125,6 +127,8 @@ enum voca_id_t VOCA_KW_CONTINUE, VOCA_KW_UNTIL, VOCA_KW_WHILE, + VOCA_KW_RETURN, + VOCA_KW_REVERT, VOCA_SYM_SET, VOCA_SYM_SET_R, @@ -446,7 +450,9 @@ static hcl_tok_type_t classify_ident_token (hcl_t* hcl, const hcl_oocs_t* v) { VOCA_KW_BREAK, HCL_TOK_BREAK }, { VOCA_KW_CONTINUE, HCL_TOK_CONTINUE }, { VOCA_KW_UNTIL, HCL_TOK_UNTIL }, - { VOCA_KW_WHILE, HCL_TOK_WHILE } + { VOCA_KW_WHILE, HCL_TOK_WHILE }, + { VOCA_KW_RETURN, HCL_TOK_RETURN }, + { VOCA_KW_REVERT, HCL_TOK_REVERT } }; for (i = 0; i < HCL_COUNTOF(tab); i++) @@ -1275,7 +1281,9 @@ static hcl_cnode_type_t kw_to_cnode_type (int tok_type) HCL_CNODE_BREAK, HCL_CNODE_CONTINUE, HCL_CNODE_UNTIL, - HCL_CNODE_WHILE + HCL_CNODE_WHILE, + HCL_CNODE_RETURN, + HCL_CNODE_REVERT }; return mapping[tok_type - HCL_TOK_NIL]; @@ -1695,6 +1703,8 @@ static int feed_process_token (hcl_t* hcl) case HCL_TOK_CONTINUE: case HCL_TOK_UNTIL: case HCL_TOK_WHILE: + case HCL_TOK_RETURN: + case HCL_TOK_REVERT: frd->obj = hcl_makecnode(hcl, kw_to_cnode_type(TOKEN_TYPE(hcl)), 0, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); goto auto_xlist; diff --git a/t/ret-01.hcl b/t/ret-01.hcl index 1a8100f..4ec59e7 100644 --- a/t/ret-01.hcl +++ b/t/ret-01.hcl @@ -8,7 +8,7 @@ defun repeat(n f) { defun test-non-local-ret-1(k) { repeat 10 (fun() { set k (+ k 2); - if (= k 28) { return-from-home k }; + if (= k 28) { revert k }; }); return k;