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

allow #f argument to continuation-mark-set->{list[*],iterator}

Browse Source 
There's a small performance advantage in avoiding a call to
`(current-continuation-marks)`. CS already allowed #f, but did not
handle it correctly.
This commit is contained in:
Matthew Flatt 2021-01-20 07:08:33 -07:00
parent 9957cdeec1
commit e4518f662d
5 changed files with 94 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
pkgs/racket-doc/scribblings/reference/cont-marks.scrbl
View File

@ -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?]{

18
pkgs/racket-test-core/tests/racket/contmark.rktl
View File

@ -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

4
racket/src/bc/gc2/Makefile.in
View File

@ -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

30
racket/src/bc/src/fun.c
View File

@ -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;

36
racket/src/cs/rumble/control.ss
View File

@ -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]