diff --git a/pkgs/racket-doc/scribblings/reference/cont-marks.scrbl b/pkgs/racket-doc/scribblings/reference/cont-marks.scrbl index dfa1854aad..7bc5396e69 100644 --- a/pkgs/racket-doc/scribblings/reference/cont-marks.scrbl +++ b/pkgs/racket-doc/scribblings/reference/cont-marks.scrbl @@ -77,40 +77,33 @@ other words, it produces the same value as ]} @defproc[(continuation-mark-set->list - [mark-set continuation-mark-set?] + [mark-set (or/c continuation-mark-set? #f)] [key-v any/c] [prompt-tag continuation-prompt-tag? (default-continuation-prompt-tag)]) list?]{ Returns a newly-created list containing the marks for @racket[key-v] in @racket[mark-set], which is a set of marks returned by -@racket[current-continuation-marks]. The result list is truncated at +@racket[current-continuation-marks] or @racket[#f] as a shorthand for +@racket[(current-continuation-marks prompt-tag)]. The result list is truncated at the first point, if any, where continuation frames were originally separated by a prompt tagged with @racket[prompt-tag]. Producing the result takes time proportional to the size of the continuation reflected by -@racket[mark-set].} +@racket[mark-set]. -@defproc*[([(make-continuation-mark-key) continuation-mark-key?] - [(make-continuation-mark-key [sym symbol?]) continuation-mark-key?])]{ -Creates a continuation mark key that is not @racket[equal?] to the result -of any other value (including prior and future results from -@racket[make-continuation-mark-key]). The continuation mark key can be used -as the key argument for @racket[with-continuation-mark] or accessor procedures -like @racket[continuation-mark-set-first]. The mark key can be chaperoned -or impersonated, unlike other values that are used as the mark key. +@history[#:changed "8.0.0.1" @elem{Changed to allow @racket[mark-set] as @racket[#f].}]} -The optional @racket[sym] argument, if provided, is used when printing -the continuation mark. -} @defproc[(continuation-mark-set->list* - [mark-set continuation-mark-set?] + [mark-set (or/c continuation-mark-set? #f)] [key-list (listof any/c)] [none-v any/c #f] [prompt-tag continuation-prompt-tag? (default-continuation-prompt-tag)]) (listof vector?)]{ Returns a newly-created list containing vectors of marks in @racket[mark-set] for the keys in @racket[key-list], up to -@racket[prompt-tag]. The length of each vector in the result list is +@racket[prompt-tag], where a @racket[#f] value for @racket[mark-set] +is equivalent to @racket[(current-continuation-marks prompt-tag)]. +The length of each vector in the result list is the same as the length of @racket[key-list], and a value in a particular vector position is the value for the corresponding key in @racket[key-list]. Values for multiple keys appear in a single vector @@ -118,10 +111,13 @@ only when the marks are for the same continuation frame in @racket[mark-set]. The @racket[none-v] argument is used for vector elements to indicate the lack of a value. Producing the result takes time proportional to the size of the continuation reflected by -@racket[mark-set] times the length of @racket[key-list].} +@racket[mark-set] times the length of @racket[key-list]. + +@history[#:changed "8.0.0.1" @elem{Changed to allow @racket[mark-set] as @racket[#f].}]} + @defproc[(continuation-mark-set->iterator - [mark-set continuation-mark-set?] + [mark-set (or/c continuation-mark-set? #f)] [key-list (listof any/c)] [none-v any/c #f] [prompt-tag continuation-prompt-tag? (default-continuation-prompt-tag)]) @@ -139,7 +135,9 @@ The time required for each step is proportional to the length of reflected by @racket[mark-set] between frames that have keys in @racket[key-list]. -@history[#:added "7.5.0.7"]} +@history[#:added "7.5.0.7" + #:changed "8.0.0.1" @elem{Changed to allow @racket[mark-set] as @racket[#f].}]} + @defproc[(continuation-mark-set-first [mark-set (or/c continuation-mark-set? #f)] @@ -163,6 +161,7 @@ Although @racket[#f] and @racket[(current-continuation-marks prompt-tag)] are equivalent for @racket[mark-set], providing @racket[#f] as @racket[mark-set] can enable shortcuts that make it even faster.} + @defproc[(call-with-immediate-continuation-mark [key-v any/c] [proc (any/c . -> . any)] @@ -198,15 +197,31 @@ continuation. (proc (vector-ref (car vecs) 0))))) ]} + +@defproc*[([(make-continuation-mark-key) continuation-mark-key?] + [(make-continuation-mark-key [sym symbol?]) continuation-mark-key?])]{ +Creates a continuation mark key that is not @racket[equal?] to the result +of any other value (including prior and future results from +@racket[make-continuation-mark-key]). The continuation mark key can be used +as the key argument for @racket[with-continuation-mark] or accessor procedures +like @racket[continuation-mark-set-first]. The mark key can be chaperoned +or impersonated, unlike other values that are used as the mark key. + +The optional @racket[sym] argument, if provided, is used when printing +the continuation mark.} + + @defproc[(continuation-mark-key? [v any/c]) boolean?]{ Returns @racket[#t] if @racket[v] is a mark key created by @racket[make-continuation-mark-key], @racket[#f] otherwise.} + @defproc[(continuation-mark-set? [v any/c]) boolean?]{ Returns @racket[#t] if @racket[v] is a mark set created by @racket[continuation-marks] or @racket[current-continuation-marks], @racket[#f] otherwise.} + @defproc[(continuation-mark-set->context [mark-set continuation-mark-set?]) list?]{ diff --git a/pkgs/racket-test-core/tests/racket/contmark.rktl b/pkgs/racket-test-core/tests/racket/contmark.rktl index 403166661a..edac0e5d6b 100644 --- a/pkgs/racket-test-core/tests/racket/contmark.rktl +++ b/pkgs/racket-test-core/tests/racket/contmark.rktl @@ -90,6 +90,24 @@ x x))))) +;; Check that #f is allowed in place of marks: +(begin + (test '(10) + values + (with-continuation-mark 'key3 10 (continuation-mark-set->list #f 'key3))) + (test '(#(10)) + values + (with-continuation-mark 'key3 10 (continuation-mark-set->list* #f '(key3)))) + (test '#(10) + values + (let-values ([(v proc) ((with-continuation-mark 'key3 10 (continuation-mark-set->iterator #f '(key3))))]) + v)) + + ;; Prompt tag must be present: + (err/rt-test (continuation-mark-set->list #f 'key3 'none (make-continuation-prompt-tag))) + (err/rt-test (continuation-mark-set->list* #f '(key3) 'none (make-continuation-prompt-tag))) + (err/rt-test (continuation-mark-set->iterator #f '(key3) 'none (make-continuation-prompt-tag)))) + (wcm-test '(11) (lambda () (with-continuation-mark 'key 10 (with-continuation-mark 'key 11 diff --git a/racket/src/bc/gc2/Makefile.in b/racket/src/bc/gc2/Makefile.in index c8303ac601..a2d45d7182 100644 --- a/racket/src/bc/gc2/Makefile.in +++ b/racket/src/bc/gc2/Makefile.in @@ -602,6 +602,7 @@ EXTRA_OBJS_L = $(EXTRA_GMP) ../src/unwind.@LTO@ $(@FOREIGN_IF_USED@_OBJSLIB) $(L # path. MZFWMMM = Racket.framework/Versions/$(FWVERSION)_3m/Racket +MZFWMMM_DEST = "../Racket.framework/Versions/$(FWVERSION)_3m/Racket" MACLIBRKT_LIBS = ../libracket3m.@LIBSFX@ $(LIBRKTIO) -framework CoreFoundation @@ -611,7 +612,8 @@ $(MZFWMMM): ../libracket3m.@LIBSFX@ $(LIBRKTIO) rm -f Racket.framework/Racket ln -s Versions/$(FWVERSION)_3m/Racket Racket.framework/Racket mkdir -p "../Racket.framework/Versions/$(FWVERSION)_3m" - cp "Racket.framework/Racket" "../Racket.framework/Versions/$(FWVERSION)_3m/Racket" + rm -f $(MZFWMMM_DEST) + cp "Racket.framework/Racket" $(MZFWMMM_DEST) # Depending on MACLIBRKT_LINK_MODE, use Framework or statically link the framework's code: MACLIBRKT_LINK_fw = -F. -framework Racket diff --git a/racket/src/bc/src/fun.c b/racket/src/bc/src/fun.c index a7e1bfb811..38b7061e5c 100644 --- a/racket/src/bc/src/fun.c +++ b/racket/src/bc/src/fun.c @@ -166,6 +166,7 @@ static Scheme_Object *get_set_cont_mark_by_pos(Scheme_Object *key, Scheme_Meta_Continuation *mc, MZ_MARK_POS_TYPE mpos, Scheme_Object *val); +static Scheme_Cont_Mark_Chain *current_mark_chain(const char *who, Scheme_Object *prompt_tag); static Scheme_Object *jump_to_alt_continuation(); static void reset_cjs(Scheme_Continuation_Jump_State *a); @@ -7692,7 +7693,7 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p, Scheme_Object *econt, Scheme_Meta_Continuation *mc, Scheme_Object *prompt_tag, - char *who, + const char *who, int just_chain, int use_boundary_prompt) /* cont => p is not used */ @@ -8018,6 +8019,13 @@ Scheme_Object *scheme_all_current_continuation_marks() 0, 1); } +Scheme_Cont_Mark_Chain *current_mark_chain(const char *who, Scheme_Object *prompt_tag) { + return (Scheme_Cont_Mark_Chain *)continuation_marks(scheme_current_thread, NULL, NULL, NULL, + prompt_tag, + who, + 1, 1); +} + static Scheme_Object * cc_marks(int argc, Scheme_Object *argv[]) { @@ -8141,8 +8149,9 @@ extract_cc_marks(int argc, Scheme_Object *argv[]) Scheme_Object *pr; int is_chaperoned = 0; - if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_cont_mark_set_type)) { - scheme_wrong_contract("continuation-mark-set->list", "continuation-mark-set?", 0, argc, argv); + if (SCHEME_TRUEP(argv[0]) + && !SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_cont_mark_set_type)) { + scheme_wrong_contract("continuation-mark-set->list", "(or/c continuation-mark-set? #f)", 0, argc, argv); return NULL; } if (argc > 2) { @@ -8160,7 +8169,10 @@ extract_cc_marks(int argc, Scheme_Object *argv[]) } else prompt_tag = scheme_default_prompt_tag; - chain = ((Scheme_Cont_Mark_Set *)argv[0])->chain; + if (SCHEME_FALSEP(argv[0])) + chain = current_mark_chain("continuation-mark-set->list", prompt_tag); + else + chain = ((Scheme_Cont_Mark_Set *)argv[0])->chain; key = argv[1]; if ((key == scheme_parameterization_key) @@ -8294,8 +8306,9 @@ do_extract_cc_markses(const char *who, int argc, Scheme_Object *argv[], int iter Scheme_Object *pr, **keys, *vals, *none, *prompt_tag; intptr_t len, i; - if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_cont_mark_set_type)) { - scheme_wrong_contract(who, "continuation-mark-set?", 0, argc, argv); + if (SCHEME_TRUEP(argv[0]) + && !SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_cont_mark_set_type)) { + scheme_wrong_contract(who, "(or/c continuation-mark-set? #f)", 0, argc, argv); return NULL; } len = scheme_proper_list_length(argv[1]); @@ -8332,7 +8345,10 @@ do_extract_cc_markses(const char *who, int argc, Scheme_Object *argv[], int iter } } - chain = ((Scheme_Cont_Mark_Set *)argv[0])->chain; + if (SCHEME_FALSEP(argv[0])) + chain = current_mark_chain(who, prompt_tag); + else + chain = ((Scheme_Cont_Mark_Set *)argv[0])->chain; if (iterator) { void **clos, **state; diff --git a/racket/src/cs/rumble/control.ss b/racket/src/cs/rumble/control.ss index 8dedf6cfb3..ac2a4e6e7a 100644 --- a/racket/src/cs/rumble/control.ss +++ b/racket/src/cs/rumble/control.ss @@ -721,10 +721,7 @@ [(null? current-mc) (unless (or (eq? tag the-default-continuation-prompt-tag) (eq? tag the-root-continuation-prompt-tag)) - (do-raise-arguments-error '|continuation application| - "continuation includes no prompt with the given tag" - exn:fail:contract:continuation - (list "tag" tag))) + (raise-no-prompt-tag '|continuation application| tag)) (values accum null)] [(eq? tag (strip-impersonator (metacontinuation-frame-tag (car current-mc)))) (values accum current-mc)] @@ -802,9 +799,7 @@ [(null? mc) (unless (or (eq? tag the-root-continuation-prompt-tag) (eq? tag the-default-continuation-prompt-tag)) - (do-raise-arguments-error who "continuation includes no prompt with the given tag" - exn:fail:contract:continuation - (list "tag" tag))) + (raise-no-prompt-tag who tag)) (check-barrier-ok saw-barrier?) '()] [else @@ -823,7 +818,7 @@ (raise-no-prompt-tag who tag))) (define (raise-no-prompt-tag who tag) - (do-raise-arguments-error who "continuation includes no prompt with the given tag" + (do-raise-arguments-error who "no corresponding prompt in the continuation" exn:fail:contract:continuation (list "tag" tag))) @@ -1375,15 +1370,15 @@ (define/who continuation-mark-set->list (case-lambda [(marks key) (continuation-mark-set->list marks key the-default-continuation-prompt-tag)] - [(marks key prompt-tag) + [(marks key prompt-tag-in) (check who continuation-mark-set? :or-false marks) - (check who continuation-prompt-tag? prompt-tag) - (maybe-future-barricade prompt-tag) - (let ([prompt-tag (strip-impersonator prompt-tag)]) + (check who continuation-prompt-tag? prompt-tag-in) + (maybe-future-barricade prompt-tag-in) + (let ([prompt-tag (strip-impersonator prompt-tag-in)]) (let-values ([(key wrapper) (extract-continuation-mark-key-and-wrapper 'continuation-mark-set->list key)]) (let chain-loop ([mark-chain (or (and marks (continuation-mark-set-mark-chain marks)) - (current-mark-chain))]) + (prune-mark-chain-suffix who prompt-tag prompt-tag-in (current-mark-chain)))]) (cond [(null? mark-chain) null] @@ -1427,12 +1422,15 @@ [(v new-next) (values v (lambda () (loop new-next)))])))))])) -(define (do-continuation-mark-set->list* who iterator? marks keys none-v prompt-tag) +(define (do-continuation-mark-set->list* who iterator? marks keys none-v prompt-tag-in) (check who continuation-mark-set? :or-false marks) (check who list? keys) - (check who continuation-prompt-tag? prompt-tag) - (maybe-future-barricade prompt-tag) - (let ([prompt-tag (strip-impersonator prompt-tag)]) + (check who continuation-prompt-tag? prompt-tag-in) + (maybe-future-barricade prompt-tag-in) + (let* ([prompt-tag (strip-impersonator prompt-tag-in)] + [mark-chain (or (and marks + (continuation-mark-set-mark-chain marks)) + (prune-mark-chain-suffix who prompt-tag prompt-tag-in (current-mark-chain)))]) (let-values ([(all-keys all-wrappers) (map/2-values (lambda (k) (extract-continuation-mark-key-and-wrapper who k)) @@ -1440,9 +1438,7 @@ (lambda () (let* ([n (length all-keys)] [tmp (#%make-vector n)]) - (let chain-loop ([mark-chain (or (and marks - (continuation-mark-set-mark-chain marks)) - (current-mark-chain))]) + (let chain-loop ([mark-chain mark-chain]) (cond [(null? mark-chain) null]