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

Format the name of continuation prompt tags

Browse Source 
This change recovers Racket-BC style formatting
of continuation prompt tags for Racket CS.
This commit is contained in:
shuhung 2020-12-13 17:29:14 -06:00 committed by GitHub
parent b4a3c7d3da
commit 2c26dc1e1a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 61 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -94,12 +94,16 @@ handler, which accepts a single thunk to apply (with the prompt
intact).} intact).}
@defproc*[([(make-continuation-prompt-tag) continuation-prompt-tag?] @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 Creates a prompt tag that is not @racket[equal?] to the result of any
other value (including prior or future results from other value (including prior or future results from
@racket[make-continuation-prompt-tag]). The optional @racket[sym] @racket[make-continuation-prompt-tag]). The optional @racket[name]
argument, if supplied, is used when printing the prompt tag.} 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?]{ @defproc[(default-continuation-prompt-tag) continuation-prompt-tag?]{

12
pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl
View File

@ -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 @racket[#f] otherwise. The argument @racket[v] can be any value, but
only (some) procedures, @tech{structures}, @tech{structure types}, only (some) procedures, @tech{structures}, @tech{structure types},
@tech{structure type properties}, @tech{regexp values}, @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 The name (if any) of a procedure is always a symbol. The
@racket[procedure-rename] function creates a procedure with a specific @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 string name as the port's for (to report source locations, for
example). 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?]{ @defthing[prop:object-name struct-type-property?]{

12
pkgs/racket-test-core/tests/racket/prompt.rktl
View File

@ -9,6 +9,18 @@
(err/rt-test (break-thread (current-thread)) exn:break?)) (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)
(test (void) call-with-continuation-prompt void (default-continuation-prompt-tag)) (test (void) call-with-continuation-prompt void (default-continuation-prompt-tag))
(test (void) call-with-continuation-prompt void (default-continuation-prompt-tag) list) (test (void) call-with-continuation-prompt void (default-continuation-prompt-tag) list)

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

@ -2753,6 +2753,10 @@ Scheme_Object *scheme_object_name(Scheme_Object *a)
Scheme_Logger *logger = (Scheme_Logger *)a; Scheme_Logger *logger = (Scheme_Logger *)a;
if (logger->name) if (logger->name)
return 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; return scheme_false;

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

@ -783,7 +783,10 @@
(lambda (c . args) (apply-non-composable-continuation c args))) (lambda (c . args) (apply-non-composable-continuation c args)))
(struct-property-set! prop:procedure (struct-property-set! prop:procedure
(record-type-descriptor escape-continuation) (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 ;; Metacontinuation operations for continutions

36
racket/src/cs/schemified/io.scm
View File

@ -22669,26 +22669,34 @@
mode_0 mode_0
o_0 o_0
max-length_0) max-length_0)
(if (unquoted-printing-string? (if (continuation-prompt-tag?
v_0) v_0)
(write-string/max (print-named
(unquoted-printing-string-value "continuation-prompt-tag"
v_0) v_0
mode_0
o_0 o_0
max-length_0) max-length_0)
(if (eq? (if (unquoted-printing-string?
v_0 v_0)
unsafe-undefined)
(write-string/max (write-string/max
"#<unsafe-undefined>" (unquoted-printing-string-value
o_0
max-length_0)
(write-string/max
(format
"~s"
v_0) v_0)
o_0 o_0
max-length_0)))))))))))))))))))))))))))))))) max-length_0)
(if (eq?
v_0
unsafe-undefined)
(write-string/max
"#<unsafe-undefined>"
o_0
max-length_0)
(write-string/max
(format
"~s"
v_0)
o_0
max-length_0)))))))))))))))))))))))))))))))))
(define fail-unreadable (define fail-unreadable
(lambda (who_0 v_0) (lambda (who_0 v_0)
(raise (raise

2
racket/src/io/print/main.rkt
View File

@ -342,6 +342,8 @@
(print-named "input-port" v mode o max-length)] (print-named "input-port" v mode o max-length)]
[(core-output-port? v) [(core-output-port? v)
(print-named "output-port" v mode o max-length)] (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) [(unquoted-printing-string? v)
(write-string/max (unquoted-printing-string-value v) o max-length)] (write-string/max (unquoted-printing-string-value v) o max-length)]
[(eq? v unsafe-undefined) [(eq? v unsafe-undefined)