suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix merging of marks when applying a composable continuation

Browse Source 
When a composable continuation has continuation marks that should
be merged with marks in the immediate continuation frame when
the continuation is applied, then mergeing did not always work.
It only worked in the case that the merge cadidates are the only
marks, because the merging check used the wrong end of the captured
sequence of marks.
This commit is contained in:
Matthew Flatt 2017-12-10 08:55:08 -07:00
parent e0a8058db5
commit 7aff978a1f
2 changed files with 53 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
pkgs/racket-test-core/tests/racket/prompt-tests.rktl
View File

@ -1129,6 +1129,55 @@
(test #t continuation-mark-set-first #f 'n)
(loop (sub1 n)))))))))
(let ()
(define (check call-with-ignored-composable-continuation)
;; Caputured replacing installed with nested metacontinuations
(let ([k (call-with-continuation-prompt
(lambda ()
(with-continuation-mark
'x
71
(call-with-ignored-composable-continuation
(lambda (k2)
(non-tail
(with-continuation-mark
'x
72
((call-with-composable-continuation
(lambda (k)
(lambda () k)))))))))))])
(test '(72 71)
'nested-mc
(with-continuation-mark
'x 81
(k (lambda ()
(continuation-mark-set->list (current-continuation-marks) 'x))))))
;; Captured not replacing
(let ([k (call-with-continuation-prompt
(lambda ()
(non-tail
(with-continuation-mark
'x
71
(call-with-ignored-composable-continuation
(lambda (k2)
(non-tail
(with-continuation-mark
'x
72
((call-with-composable-continuation
(lambda (k)
(lambda () k))))))))))))])
(test '(72 71 81)
'nested-mc
(with-continuation-mark
'x 81
(k (lambda ()
(continuation-mark-set->list (current-continuation-marks) 'x)))))))
(check call-with-composable-continuation)
(check (lambda (proc) (proc #f))))
;; ----------------------------------------
;; Olivier Danvy's traversal

12
racket/src/racket/src/fun.c
View File

@ -5368,9 +5368,9 @@ void prune_cont_marks(Scheme_Meta_Continuation *resume_mc, Scheme_Cont *cont, Sc
return;
}
for (pos = cont->cont_mark_total, num_coverlap = 0;
pos--;
num_coverlap++) {
for (pos = 0, num_coverlap = 0;
pos < cont->cont_mark_total;
num_coverlap++, pos++) {
if (cont->cont_mark_stack_copied[pos].pos != (cont->cont_mark_pos_bottom + 2))
break;
}
@ -5399,7 +5399,7 @@ void prune_cont_marks(Scheme_Meta_Continuation *resume_mc, Scheme_Cont *cont, Sc
scheme_hash_set(ht, SCHEME_VEC_ELS(extra_marks)[i], val);
}
}
for (pos = cont->cont_mark_total - 1, i = 0; i < num_coverlap; i++, pos--) {
for (pos = 0, i = 0; i < num_coverlap; i++, pos++) {
scheme_hash_set(ht,
cont->cont_mark_stack_copied[pos].key,
NULL);
@ -8456,10 +8456,6 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
while (chain) {
if (chain->key == key)
if (key_arg != key)
/*
* TODO: is this the only name that this procedure is called as
* publicly?
*/
return scheme_chaperone_do_continuation_mark("continuation-mark-set-first",
1, key_arg, chain->val);
else