fix continuation-mark splicing across composable combinations
Although splicing was set up for applying a composable comtinuation to most kinds of continuations, it was not set up right for applying a composable continaution in tail position for a just-applied composable continuation. Thanks to Spencer Florence for the report and example.
This commit is contained in:
parent
531c422652
commit
07473865a6
|
@ -2395,3 +2395,32 @@
|
||||||
(λ () #f))
|
(λ () #f))
|
||||||
(λ (x) x)))))
|
(λ (x) x)))))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
(test
|
||||||
|
'(2)
|
||||||
|
'dont-double-continuation-mark
|
||||||
|
(let ()
|
||||||
|
(define tag (make-continuation-prompt-tag))
|
||||||
|
|
||||||
|
(define k
|
||||||
|
(call-with-continuation-prompt
|
||||||
|
(lambda ()
|
||||||
|
(with-continuation-mark 'test 2
|
||||||
|
(#%app (call-with-composable-continuation (lambda (k) (abort-current-continuation tag k)) tag))))
|
||||||
|
tag
|
||||||
|
values))
|
||||||
|
|
||||||
|
(define (compose-continuations k1 k2)
|
||||||
|
(call-with-continuation-prompt
|
||||||
|
(lambda ()
|
||||||
|
(k1 (lambda ()
|
||||||
|
(k2 (lambda () (#%app (call-with-composable-continuation (lambda (k) (abort-current-continuation tag k)) tag)))))))
|
||||||
|
tag
|
||||||
|
values))
|
||||||
|
|
||||||
|
(continuation-mark-set->list
|
||||||
|
(continuation-marks (let ([c1 (compose-continuations k k)])
|
||||||
|
(compose-continuations c1 c1))
|
||||||
|
tag)
|
||||||
|
'test)))
|
||||||
|
|
|
@ -5468,6 +5468,7 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
|
||||||
/* Prune resume_mc continuation marks that have replacements
|
/* Prune resume_mc continuation marks that have replacements
|
||||||
in the deepest frame of cont, and add extra_marks */
|
in the deepest frame of cont, and add extra_marks */
|
||||||
prune_cont_marks(resume_mc, cont, extra_marks);
|
prune_cont_marks(resume_mc, cont, extra_marks);
|
||||||
|
p->cont_mark_pos_bottom = cont->cont_mark_pos_bottom;
|
||||||
}
|
}
|
||||||
|
|
||||||
mc = clone_meta_cont(cont->meta_continuation, NULL, -1, NULL, NULL, resume_mc, 0);
|
mc = clone_meta_cont(cont->meta_continuation, NULL, -1, NULL, NULL, resume_mc, 0);
|
||||||
|
@ -5624,6 +5625,8 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
meta_prompt->boundary_mark_pos = cont->cont_mark_pos_bottom; /* for mark splicing */
|
||||||
|
|
||||||
p->meta_prompt = meta_prompt;
|
p->meta_prompt = meta_prompt;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user