diff options
| -rw-r--r-- | eval.c | 36 | ||||
| -rw-r--r-- | txr.1 | 95 |
2 files changed, 127 insertions, 4 deletions
@@ -84,7 +84,7 @@ val setq_s, inc_s, zap_s; val for_s, for_star_s, each_s, each_star_s, collect_each_s, collect_each_star_s; val append_each_s, append_each_star_s, while_s, while_star_s, until_star_s; val dohash_s; -val uw_protect_s, return_s, return_from_s, sys_abscond_from_s; +val uw_protect_s, return_s, return_from_s, sys_abscond_from_s, block_star_s; val list_s, append_s, apply_s, iapply_s; val gen_s, gun_s, generate_s, rest_s, plus_s; val promise_s, promise_forced_s, promise_inprogress_s, force_s; @@ -1898,6 +1898,19 @@ static val op_block(val form, val env) return result; } +static val op_block_star(val form, val env) +{ + val sym_form = second(form); + val body = rest(rest(form)); + val sym = eval(sym_form, env, form); + + uw_block_begin (sym, result); + result = eval_progn(body, env, form); + uw_block_end; + + return result; +} + static val op_return(val form, val env) { val retval = eval(second(form), env, form); @@ -3099,7 +3112,7 @@ tail: return rlcp(cons(sym, cons(funcs_ex, body_ex)), form); } } else if (sym == block_s || sym == return_from_s || - sym == sys_abscond_from_s) + sym == sys_abscond_from_s || sym == block_star_s) { val name = second(form); val body = rest(rest(form)); @@ -3409,6 +3422,21 @@ static val constantp(val form, val env_in) } } +static val return_star(val name, val retval) +{ + uw_block_return(name, retval); + eval_error(nil, lit("return*: no block named ~s is visible"), name, nao); + abort(); +} + +static val abscond_star(val name, val retval) +{ + uw_block_abscond(name, retval); + eval_error(nil, lit("sys:abscond*: no block named ~s is visible"), + name, nao); + abort(); +} + val mapcarv(val fun, struct args *lists) { if (!args_more(lists, 0)) { @@ -4228,6 +4256,7 @@ void eval_init(void) return_s = intern(lit("return"), user_package); return_from_s = intern(lit("return-from"), user_package); sys_abscond_from_s = intern(lit("abscond-from"), system_package); + block_star_s = intern(lit("block*"), user_package); gethash_s = intern(lit("gethash"), user_package); car_s = intern(lit("car"), user_package); cdr_s = intern(lit("cdr"), user_package); @@ -4321,6 +4350,7 @@ void eval_init(void) reg_op(dohash_s, op_dohash); reg_op(uw_protect_s, op_unwind_protect); reg_op(block_s, op_block); + reg_op(block_star_s, op_block_star); reg_op(return_s, op_return); reg_op(return_from_s, op_return_from); reg_op(sys_abscond_from_s, op_abscond_from); @@ -4890,6 +4920,8 @@ void eval_init(void) func_n0v(register_exception_subtypes)); reg_fun(intern(lit("exception-subtype-p"), user_package), func_n2(uw_exception_subtype_p)); + reg_fun(intern(lit("return*"), user_package), func_n2o(return_star, 1)); + reg_fun(intern(lit("abscond*"), system_package), func_n2o(abscond_star, 1)); reg_fun(intern(lit("match-fun"), user_package), func_n4(match_fun)); @@ -12559,9 +12559,10 @@ allowing the operator to be used to terminate at any point. -.coNP Operator @ block +.coNP Operators @ block and @ block* .synb .mets (block < name << body-form *) +.mets (block* < name-form << body-form *) .syne .desc The @@ -12577,6 +12578,15 @@ and A block named by the symbol nil is slightly special: it is understood to be an anonymous block. +The +.code block* +operator differs from +.code block +in that it evaluates +.metn name-form , +which is expected to produce a symbol. The resulting symbol +is used for the name of the block. + A named or anonymous block establishes an exit point for the .code return-from or @@ -12610,6 +12620,11 @@ block does not lexically surround .codn foo . +It is because blocks are dynamic that the +.code block* +variant exists; for lexically scoped blocks, it would make little +sense to have support a dynamically computed name. + Thus blocks in \*(TL provide dynamic non-local returns, as well as returns out of lexical nesting. @@ -12633,7 +12648,21 @@ is not allowed in Common Lisp, but can be transliterated to: Note that foo is quoted in CL. This underscores the dynamic nature of the construct. .code throw -itself is a function and not an operator. +itself is a function and not an operator. Also note that the CL +example, in turn, is even more closely transcribed back into \*(TL +simply by replacing its +.code throw +and +.code catch +with +.code return* +and +.code block* : + +.cblk + (defun func () (return* 'foo 42)) + (block* 'foo (func)) +.cble Common Lisp blocks also do not support delimited continuations. @@ -12685,6 +12714,37 @@ terminates block .codn foo , and so the second pprint form is not evaluated. +.coNP Function @ return* +.synb +.mets (return* < name <> [ value ]) +.syne +.desc +The +.code return* +function is similar to the the +.code return-from +operator, except that +.code name +is an ordinary function parameter, and so when +.code return* +is used, an argument expression must be specified which evaluates +to a symbol. Thus +.code return* +allows the target block of a return to be dynamically computed. + +The following equivalence holds between the operator and function: + +.cblk + (return-from a b) <--> (return* 'a b) +.cble + +Expressions used as +.meta name +arguments to +.code return* +which do not simply quote a symbol have no equivalent in +.codn return-from . + .SS* Evaluation .coNP Function @ eval @@ -27724,6 +27784,37 @@ operators to escape out of a block in which a continuation has been captured. Neglecting to unwind is valid due to the expectation that control will return into a restarted copy of that context. +.coNP Function @ sys:abscond* +.synb +.mets (sys:abscond* < name <> [ value ]) +.syne +.desc +The +.code sys:return* +function is similar to the the +.code sys:abscond-from +operator, except that +.code name +is an ordinary function parameter, and so when +.code return* +is used, an argument expression must be specified which evaluates +to a symbol. Thus +.code sys:abscond* +allows the target block of a return to be dynamically computed. + +The following equivalence holds between the operator and function: + +.cblk + (sys:abscond-from a b) <--> (sys:abscond* 'a b) +.cble + +Expressions used as +.meta name +arguments to +.code abscond* +which do not simply quote a symbol have no equivalent in +.codn abscond-from . + .coNP Macros @ obtain and @ yield-from .synb .mets (obtain << forms *) |