diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2015-10-25 20:48:39 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2015-10-25 20:48:39 -0700 |
commit | 596f3633c74f5dbd90768355e389ffadfbf2e89f (patch) | |
tree | ff52b9d41fb9988eb5e4301a312a777ce76e690b | |
parent | bde25e195a88a78c12d3cdac820bcfdc8a01bbca (diff) | |
download | txr-596f3633c74f5dbd90768355e389ffadfbf2e89f.tar.gz txr-596f3633c74f5dbd90768355e389ffadfbf2e89f.tar.bz2 txr-596f3633c74f5dbd90768355e389ffadfbf2e89f.zip |
TXR gets delimited continuations.
* unwind.c (sys_cont_s): New symbol variable.
(uw_pop_block): New function, supporting uw_block_end macro.
Special logic is needed for popping blocks now, because a
block can be a captured stub at the top of a continuation,
which must not be popped in the
regular manner.
(struct cont): New struct type.
(cont_destroy, cont_mark): New static functions.
(cont_ops): New static structure.
(revive_cont, capture_cont): New static functions.
(uw_capture_cont): New functions.
(uw_init): Initialize sys_cont_s.
Register sys:capture-cont intrinsic.
* unwind.h (enum uw_frtype): New enum member
UW_CAPTURED_BLOCK. When a block is captured as a stub copy of
the prompt block of a delimited continuation, its type is
changed from UW_BLOCK to this new type. This does two things:
it makes the block invisible to block-related code that does
nothing with continuations (code that looks for UW_BLOCK
and ignores anything else). Secondly, there is some special
handling related to UW_CAPTURED_BLOCK frames.
(uw_pop_block, uw_capture_cont): Declared.
(uw_block_begin): New local pointer uw_rslt introduced
which helps communicate the result variable over to the
uw_block_end macro (so we don't have to add a variable
argument to the latter).
(uw_block_end): Use uw_pop_block instead of uw_pop_frame.
* txr.1: Documented delimited continuations.
-rw-r--r-- | txr.1 | 183 | ||||
-rw-r--r-- | unwind.c | 156 | ||||
-rw-r--r-- | unwind.h | 11 |
3 files changed, 345 insertions, 5 deletions
@@ -12506,6 +12506,23 @@ and A block named by the symbol nil is slightly special: it is understood to be an anonymous block. +A named or anonymous block establishes an exit point for the +.code return-from +or +.code return +operator, respectively. These operators can be invoked within a block +to cause its immediate termination with a specified return value. + +A block also establishes a prompt for a +.IR "delimited continuation" . +Anywhere in a block, a continuation can be captured using the +.code sys:capture-cont +function. Delimited continuations are described in the section +Delimited Continuations. A delimited continuation allows an apparently +abandoned block to be restarted at the capture point, with the +entire call chain and dynamic environment between the prompt and the capture +point intact. + Blocks in \*(TL have dynamic scope. This means that the following situation is allowed: @@ -12547,6 +12564,8 @@ the construct. .code throw itself is a function and not an operator. +Common Lisp blocks also do not support delimited continuations. + .coNP Operators @ return and @ return-from .synb .mets (return <> [ value ]) @@ -27301,6 +27320,170 @@ The frame receives control even if it it is not otherwise eligible for catching the exception type denoted by .metn symbol . +.SS* Delimited Continuations + +\*(TL supports delimited continuations, which are integrated with the +.code block +feature. Any named or anonymous block, including the implicit blocks +created around function bodies, can be used as the delimiting +.I prompt +for the capture of a continuation. + +A delimited continuation consists of a copy +of entire activation chain ("call stack") segment between the delimiting +prompt and the capture point, +.I reified +as a first-class function. The function takes one argument. When the +continuation function is called, the copy of the evaluation context is +reinstated and its execution is restarted. Within the reinstated context, +control resumes at the point where the continuation was originally captured. + +The argument passed to the continuation function appears as a return value from +the capture form. Thus the capture form appears to return multiple times: the +first time it returns, it returns the continuation. Then each time the +continuation is called, and thereby resumed, the capture form appears to return +again, this time returning the value which was passed in. + +A restarted continuation can terminate normally: that is, by simply continuing +to execute and then finally terminating the block which served as its +delimiting prompt. When this happens, the continuation function terminates +and returns the block's value. + +Thus, a delimited continuation is an ordinary function. It can be invoked +multiple times, composed with other functions and so forth. + +.TP* Notes: + +Delimited continuations resemble lexical closures in some ways. Both +constructs provide a way to return to some context whose evaluation +has already been abandoned, and to access some aspects of that context. +However, lexical closures are statically scoped. Closures capture the lexically +apparent scope at a given point, and produce a function whose body has access +to that scope, as well as to some arbitrary arguments. Thus, a lexical scope +is reified as a first-class function. By contrast, a delimited continuation +is dynamic. It captures an an entire segment of a program activation chain, +up to the delimiting prompt. This segment includes scopes which are not +lexically visible at the capture point: the scopes of parent functions. +Moreover, the segment includes not only scopes, but also other aspects of +the evaluation context, such as the possibility of returning to callers, +and the (captured portion of) the original dynamic environment, such as +exception handlers. That is to say, a lexical closure's body cannot return to +the surrounding code or see any of its original dynamic environment; it can +only inspect the environment, and then return to its own caller. Whereas a +restarted delimited continuation can continue evaluation of the surrounding +code, return to surrounding forms and parent functions, and access the dynamic +environment. The continuation function returns to its caller when that entire +restarted context terminates, whereas a closure returns to its caller as soon +as the closure body terminates. + +.coNP Function @ sys:capture-cont +.synb +.mets (sys:capture-cont < name << error-report-sym ) +.syne +.desc +The +.code sys:capture-cont +function captures a continuation, and also serves as the resume point +for the resulting continuation. Which of these two situations is the +case (capture or resumption) is distinguished by the return value. + +A block named +.meta name +must be visible; the continuation is delimited by the closest +enclosing block of this name. + +The +.meta error-report-sym +argument should be a symbol. It is used in the error message if +.code sys:capture-cont +is incorrectly used. The intent is that higher level constructs built +on this function can pass their own name, so the resulting diagnostic +pertains to these constructs, rather than the lower level interface. + +The +.code sys:capture-cont +function returns a cons cell. The +.code car +field of the cell distinguishes the capture and resume situations. +If the +.code car +is the object +.codn t , +then it indicates capture, and in this case, the +.code cdr +field contains the continuation function. When the continuation +function is called, the +.code sys:capture-cont +function appears to return again. This time the +.code car +of the returned cell is +.code nil +indicating that the +.code cdr +field holds the argument value which was passed to the continuation +function. + +The invoked continuation function will terminate when the resumed context +terminates. If that context terminates normally (by returning from the +delimiting block named by +.metn name ), +then the result value of that block will appear as the return value +of the continuation function. + +.TP* Note: + +The continuation function may be used any time after it is produced, and may be +called more than once, regardless of whether the originally captured dynamic +context is still executing. The underlying continuation stores a copy of the +captured dynamic context. Whenever the continuation function is invoked, a +copy of the captured context is made again and reinstated as if it were a new +context. Thus the apparent additional returns from +.code sys:capture-cont +are not actually made in the original context, but a copy. The copy of the +context is not complete; it only extends up to the enclosing block which was +named in the capturing call. + +.TP* "Example:" + +The following example shows an implementation of the +.meta shift +and +.meta reset +operators which often appear in literature about delimited continuations. +To avoid a clash with the +.code shift +macro, the +.meta shift +operator is named +.codn shft . +Note that the example shows the extended +.meta shift +and +.meta reset +with named prompts. + +.cblk + ;; Definition: + + (defmacro reset (name . body) + ^(block ,name ,*body)) + + (defun shft-helper (name fun) + (let ((val (sys:capture-cont name 'shft))) + (if (car val) + (call fun (lambda (arg) + (call (cdr val) arg))) + (cdr val)))) + + (defmacro shft (name var . body) + ^(shft-helper ',name + (lambda (,var) (return-from ,name ,*body)))) + + ;; Usage: + (reset foo (* 2 (shft foo k [k 3]) (shft foo l [l 4]))) + --> 24 +.cble + .SS* Regular Expression Library .coNP Functions @ search-regex and @ range-regex .synb @@ -50,7 +50,7 @@ static uw_frame_t *uw_env_stack; static uw_frame_t *uw_exit_point; static uw_frame_t toplevel_env; -static val unhandled_hook_s, types_s, jump_s; +static val unhandled_hook_s, types_s, jump_s, sys_cont_s; static val frame_type, catch_frame_type, handle_frame_type; @@ -203,6 +203,20 @@ void uw_pop_frame(uw_frame_t *fr) } } +void uw_pop_block(uw_frame_t *fr, val *pret) +{ + if (uw_stack->uw.type == UW_CAPTURED_BLOCK) { + assert (fr->uw.type == UW_BLOCK || fr->uw.type == UW_CAPTURED_BLOCK); + assert (uw_stack->bl.tag == fr->bl.tag); + + uw_stack = fr->uw.up; + uw_block_return(uw_stack->bl.tag, *pret); + abort(); + } + + uw_pop_frame(fr); +} + void uw_pop_until(uw_frame_t *fr) { while (uw_stack != fr) @@ -614,6 +628,144 @@ void uw_continue(uw_frame_t *current, uw_frame_t *cont) uw_unwind_to_exit_point(); } +struct cont { + uw_frame_t *orig; + cnum size; + val tag; + mem_t *stack; +}; + +static void cont_destroy(val obj) +{ + struct cont *cont = coerce(struct cont *, obj->co.handle); + free(cont->stack); + free(cont); +} + +static void cont_mark(val obj) +{ + struct cont *cont = coerce(struct cont *, obj->co.handle); + val *mem = coerce(val *, cont->stack); + gc_mark_mem(mem, mem + cont->size / sizeof *mem); + gc_mark(cont->tag); +} + +static struct cobj_ops cont_ops = cobj_ops_init(eq, + cobj_print_op, + cont_destroy, + cont_mark, + cobj_hash_op); + +static val revive_cont(val dc, val arg) +{ + const int frame_slack = 32 * sizeof (val); + struct cont *cont = coerce(struct cont *, cobj_handle(dc, sys_cont_s)); + mem_t *space = coerce(mem_t *, alloca(cont->size + frame_slack)) + frame_slack; + uint_ptr_t orig_start = coerce(uint_ptr_t, cont->orig); + uint_ptr_t orig_end = orig_start + cont->size; + cnum delta = space - coerce(mem_t *, cont->orig); + mem_t *ptr; + uw_frame_t *new_uw_stack = coerce(uw_frame_t *, space), *fr; + int env_set = 0; + + memcpy(space, cont->stack, cont->size); + + for (ptr = space; ptr < space + cont->size; ptr += sizeof (cnum)) + { + uint_ptr_t *wordptr = coerce(uint_ptr_t *, ptr); + uint_ptr_t word = *wordptr; + + if (word >= orig_start - frame_slack && + word < orig_end && is_ptr(coerce(val, word))) + *wordptr = word + delta; + } + + uw_block_begin (cont->tag, result); + + for (fr = new_uw_stack; ; fr = fr->uw.up) { + if (!env_set && fr->uw.type == UW_ENV) { + uw_env_stack = fr; + env_set = 1; + } + if (fr->uw.up == 0) { + bug_unless (fr->uw.type == UW_CAPTURED_BLOCK); + bug_unless (fr->bl.tag == cont->tag); + fr->uw.up = uw_stack; + break; + } + } + + uw_stack = new_uw_stack; + + bug_unless (uw_stack->uw.type == UW_BLOCK); + + uw_stack->bl.result = cons(nil, arg); + uw_exit_point = uw_stack; + uw_unwind_to_exit_point(); + abort(); + + uw_block_end; + + return result; +} + +static val capture_cont(val tag, uw_frame_t *block) +{ + uw_block_begin (nil, result); + + bug_unless (uw_stack < block); + + { + cnum bloff = coerce(mem_t *, block) - coerce(mem_t *, uw_stack); + cnum size = bloff + sizeof *block; + mem_t *stack = chk_malloc(size); + uw_frame_t *blcopy = coerce(uw_frame_t *, stack + bloff); + struct cont *cont = coerce(struct cont *, chk_malloc(sizeof *cont)); + + cont->orig = uw_stack; + cont->size = size; + cont->stack = stack; + cont->tag = nil; + + memcpy(stack, uw_stack, size); + + blcopy->uw.up = 0; + blcopy->uw.type = UW_CAPTURED_BLOCK; + + result = cobj(coerce(mem_t *, cont), sys_cont_s, &cont_ops); + + cont->tag = tag; + + result = cons(t, func_f1(result, revive_cont)); + } + + uw_block_end; + + return result; +} + +val uw_capture_cont(val tag, val ctx) +{ + uw_frame_t *fr; + + for (fr = uw_stack; fr != 0; fr = fr->uw.up) { + if (fr->uw.type == UW_BLOCK && fr->bl.tag == tag) + break; + } + + if (!fr) { + if (tag) + uw_throwf(error_s, lit("~s: no block ~s is visible"), + ctx, tag, nao); + else + uw_throwf(error_s, lit("~s: no anonymous block is visible"), + ctx, nao); + abort(); + } + + return capture_cont(tag, fr); +} + void uw_init(void) { protect(&toplevel_env.ev.func_bindings, @@ -638,6 +790,7 @@ void uw_late_init(void) convert(val *, 0)); types_s = intern(lit("types"), user_package); jump_s = intern(lit("jump"), user_package); + sys_cont_s = intern(lit("cont"), system_package); frame_type = make_struct_type(intern(lit("frame"), user_package), nil, nil, nil, nil, nil, nil); catch_frame_type = make_struct_type(intern(lit("catch-frame"), @@ -656,4 +809,5 @@ void uw_late_init(void) reg_fun(intern(lit("find-frame"), user_package), func_n2o(uw_find_frame, 0)); reg_fun(intern(lit("invoke-catch"), user_package), func_n2v(uw_invoke_catch)); + reg_fun(intern(lit("capture-cont"), system_package), func_n2(uw_capture_cont)); } @@ -32,7 +32,7 @@ typedef union uw_frame uw_frame_t; typedef enum uw_frtype { - UW_BLOCK, UW_ENV, UW_CATCH, UW_HANDLE, UW_DBG + UW_BLOCK, UW_CAPTURED_BLOCK, UW_ENV, UW_CATCH, UW_HANDLE, UW_DBG } uw_frtype_t; struct uw_common { @@ -123,12 +123,14 @@ void uw_push_debug(uw_frame_t *, val func, struct args *, val ub_p_a_pairs, val env, val data, val line, val chr); void uw_pop_frame(uw_frame_t *); +void uw_pop_block(uw_frame_t *, val *pret); void uw_pop_until(uw_frame_t *); uw_frame_t *uw_current_frame(void); uw_frame_t *uw_current_exit_point(void); val uw_get_frames(void); val uw_find_frame(val extype, val frtype); val uw_invoke_catch(val catch_frame, val sym, struct args *); +val uw_capture_cont(val tag, val ctx); void uw_init(void); void uw_late_init(void); @@ -147,15 +149,16 @@ noreturn val type_mismatch(val, ...); obj_t *RESULTVAR = nil; \ do { \ uw_frame_t uw_blk; \ + obj_t **uw_rslt = &RESULTVAR; \ uw_push_block(&uw_blk, TAG); \ if (extended_setjmp(uw_blk.bl.jb)) { \ RESULTVAR = uw_blk.bl.result; \ } else { \ do { } while (0) -#define uw_block_end \ - } \ - uw_pop_frame(&uw_blk); \ +#define uw_block_end \ + } \ + uw_pop_block(&uw_blk, uw_rslt); \ } while (0) #define uw_env_begin \ |