From 59246a0107ea110b77e2f974a39e0ecbc82b8822 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 30 Dec 2018 05:52:33 -0700 Subject: [PATCH] cs: fix `call-with-immediate-continuation-mark` and chaperones Also, repair `call-with-immediate-continuation-mark` in tail position with respect to a prompt. --- racket/src/cs/rumble/control.ss | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/racket/src/cs/rumble/control.ss b/racket/src/cs/rumble/control.ss index 32bb23c865..253417407c 100644 --- a/racket/src/cs/rumble/control.ss +++ b/racket/src/cs/rumble/control.ss @@ -763,10 +763,10 @@ (define (mark-table-add/replace mt k v) (mark-table-add (mark-table-remove mt k) k v)) -(define (mark-table-ref mt k default) +(define (mark-table-ref mt k default wrapper) (let ([a (#%assq k mt)]) (if a - (cdr a) + (wrapper (cdr a)) default))) (define (mark-table-merge a b) @@ -859,10 +859,16 @@ [else (make-mark-frame (list a) #f #f)])) (define (extract-mark-from-frame a key default-v) - (cond - [(pair? a) (if (eq? key (car a)) (cdr a) default-v)] - [(mark-frame? a) (mark-table-ref (mark-frame-table a) key default-v)] - [else default-v])) + (let-values ([(key wrapper) (extract-continuation-mark-key-and-wrapper 'call-with-immediate-continuation-mark key)]) + (cond + [(pair? a) (if (eq? key (car a)) (wrapper (cdr a)) default-v)] + [(mark-frame? a) (mark-table-ref (mark-frame-table a) key default-v wrapper)] + [(eq? a 'empty) (let ([a (current-mark-splice)]) + (cond + [(pair? a) (if (eq? key (car a)) (wrapper (cdr a)) default-v)] + [(mark-frame? a) (mark-table-ref (mark-frame-table a) key default-v wrapper)] + [else default-v]))] + [else default-v]))) ;; See copy in "expander.sls" (define-syntax with-continuation-mark