diff --git a/pkgs/racket-doc/scribblings/reference/cont.scrbl b/pkgs/racket-doc/scribblings/reference/cont.scrbl index cd527dfc4d..e703d28d9f 100644 --- a/pkgs/racket-doc/scribblings/reference/cont.scrbl +++ b/pkgs/racket-doc/scribblings/reference/cont.scrbl @@ -94,12 +94,16 @@ handler, which accepts a single thunk to apply (with the prompt intact).} @defproc*[([(make-continuation-prompt-tag) continuation-prompt-tag?] - [(make-continuation-prompt-tag [sym symbol?]) continuation-prompt-tag?])]{ + [(make-continuation-prompt-tag [name symbol?]) continuation-prompt-tag?])]{ Creates a prompt tag that is not @racket[equal?] to the result of any other value (including prior or future results from -@racket[make-continuation-prompt-tag]). The optional @racket[sym] -argument, if supplied, is used when printing the prompt tag.} +@racket[make-continuation-prompt-tag]). The optional @racket[name] +argument, if supplied, specifies the name of the prompt tag +for printing or @racket[object-name].} + +@history[#:changed "7.9.0.13" @elem{The @racket[name] argument + gives the name of the prompt tag.}] @defproc[(default-continuation-prompt-tag) continuation-prompt-tag?]{ diff --git a/pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl b/pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl index 8d69ad0920..ee0aa30f0d 100644 --- a/pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl +++ b/pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl @@ -155,7 +155,8 @@ Returns a value for the name of @racket[v] if @racket[v] has a name, @racket[#f] otherwise. The argument @racket[v] can be any value, but only (some) procedures, @tech{structures}, @tech{structure types}, @tech{structure type properties}, @tech{regexp values}, -@tech{ports}, and @tech{loggers} have names. See also @secref["infernames"]. +@tech{ports}, @tech{loggers}, and @tech{prompt tags} have names. +See also @secref["infernames"]. The name (if any) of a procedure is always a symbol. The @racket[procedure-rename] function creates a procedure with a specific @@ -182,7 +183,14 @@ The name of a port can be any value, but many tools use a path or string name as the port's for (to report source locations, for example). -The name of a @tech{logger} is either a symbol or @racket[#f].} +The name of a @tech{logger} is either a symbol or @racket[#f]. + +The name of a @tech{prompt tag} is either the optional symbol +given to @racket[make-continuation-prompt-tag] or @racket[#f]. + + @history[#:changed "7.9.0.13" @elem{Recognize the name of + continuation prompt tags.}] +} @defthing[prop:object-name struct-type-property?]{ diff --git a/pkgs/racket-test-core/tests/racket/prompt.rktl b/pkgs/racket-test-core/tests/racket/prompt.rktl index d8084736d6..111c6d013b 100644 --- a/pkgs/racket-test-core/tests/racket/prompt.rktl +++ b/pkgs/racket-test-core/tests/racket/prompt.rktl @@ -9,6 +9,18 @@ (err/rt-test (break-thread (current-thread)) exn:break?)) +;; ---------------------------------------- +;; the names of prompt tags + +(test 'default object-name (default-continuation-prompt-tag)) +(test #f object-name (make-continuation-prompt-tag)) +(test 'myprompt object-name (make-continuation-prompt-tag 'myprompt)) +(test #t regexp-match? #rx"default" (format "~a" (default-continuation-prompt-tag))) +(test #f regexp-match? #rx":" (format "~a" (make-continuation-prompt-tag))) +(test #t regexp-match? #rx"myprompt" (format "~a" (make-continuation-prompt-tag 'myprompt))) + +;; ---------------------------------------- + (test (void) call-with-continuation-prompt void) (test (void) call-with-continuation-prompt void (default-continuation-prompt-tag)) (test (void) call-with-continuation-prompt void (default-continuation-prompt-tag) list) diff --git a/racket/src/bc/src/fun.c b/racket/src/bc/src/fun.c index f1ccddf29f..591008b16b 100644 --- a/racket/src/bc/src/fun.c +++ b/racket/src/bc/src/fun.c @@ -2753,6 +2753,10 @@ Scheme_Object *scheme_object_name(Scheme_Object *a) Scheme_Logger *logger = (Scheme_Logger *)a; if (logger->name) return logger->name; + } else if (SCHEME_PROMPT_TAGP(a)) { + /* See make_prompt_tag for the structure of continuation prompt tags. */ + if (SCHEME_CDR(a)) + return SCHEME_CDR(a); } return scheme_false; diff --git a/racket/src/cs/rumble/control.ss b/racket/src/cs/rumble/control.ss index da8946d908..8dedf6cfb3 100644 --- a/racket/src/cs/rumble/control.ss +++ b/racket/src/cs/rumble/control.ss @@ -783,7 +783,10 @@ (lambda (c . args) (apply-non-composable-continuation c args))) (struct-property-set! prop:procedure (record-type-descriptor escape-continuation) - (lambda (c . args) (apply-escape-continuation c args)))) + (lambda (c . args) (apply-escape-continuation c args))) + (struct-property-set! prop:object-name + (record-type-descriptor continuation-prompt-tag) + 0)) ;; ---------------------------------------- ;; Metacontinuation operations for continutions diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm index 029a798980..5aa6033b58 100644 --- a/racket/src/cs/schemified/io.scm +++ b/racket/src/cs/schemified/io.scm @@ -22669,26 +22669,34 @@ mode_0 o_0 max-length_0) - (if (unquoted-printing-string? + (if (continuation-prompt-tag? v_0) - (write-string/max - (unquoted-printing-string-value - v_0) + (print-named + "continuation-prompt-tag" + v_0 + mode_0 o_0 max-length_0) - (if (eq? - v_0 - unsafe-undefined) + (if (unquoted-printing-string? + v_0) (write-string/max - "#" - o_0 - max-length_0) - (write-string/max - (format - "~s" + (unquoted-printing-string-value v_0) o_0 - max-length_0)))))))))))))))))))))))))))))))) + max-length_0) + (if (eq? + v_0 + unsafe-undefined) + (write-string/max + "#" + o_0 + max-length_0) + (write-string/max + (format + "~s" + v_0) + o_0 + max-length_0))))))))))))))))))))))))))))))))) (define fail-unreadable (lambda (who_0 v_0) (raise diff --git a/racket/src/io/print/main.rkt b/racket/src/io/print/main.rkt index 05455e3c9a..51f619cdab 100644 --- a/racket/src/io/print/main.rkt +++ b/racket/src/io/print/main.rkt @@ -342,6 +342,8 @@ (print-named "input-port" v mode o max-length)] [(core-output-port? v) (print-named "output-port" v mode o max-length)] + [(continuation-prompt-tag? v) + (print-named "continuation-prompt-tag" v mode o max-length)] [(unquoted-printing-string? v) (write-string/max (unquoted-printing-string-value v) o max-length)] [(eq? v unsafe-undefined)