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

extend {read,peek}-char-or-special

Browse Source 
Support an external implementation of `read-syntax` by exposing
functionality that is currently internal to `read-syntax`: a srcloc
argument to a "special"-producing port function and wrapping special
results to reliably distinguish them from characters.
This commit is contained in:
Matthew Flatt 2017-01-12 08:12:48 -08:00
parent 74909ff06b
commit 08ca76b741
6 changed files with 89 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "6.8.0.1") (define version "6.8.0.2")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

19
pkgs/racket-doc/scribblings/reference/custom-ports.scrbl
View File

@ -381,17 +381,20 @@ The arguments implement the port as follows:
@itemize[ @itemize[
@item{When the special read is triggered by @racket[read-syntax] @item{When the special read is triggered by @racket[read-syntax],
or @racket[read-syntax/recursive], the @racket[read-syntax/recursive] the
procedure is passed four arguments that represent a source procedure is passed four arguments that represent a source
location.} location. Four arguments for a source location are also provided when
the read is triggered by @racket[read-byte-or-special],
@racket[read-char-or-special], @racket[peek-byte-or-special], or
@racket[peek-char-or-special] with a non-@racket[#f] source name.}
@item{When the special read is triggered by @racket[read], @item{When the special read is triggered by @racket[read],
@racket[read-byte-or-special], @racket[read/recursive], or other calls to
@racket[read-char-or-special], @racket[peek-byte-or-special], or @racket[read-byte-or-special], @racket[read-char-or-special],
@racket[peek-char-or-special], the procedure is passed no arguments @racket[peek-byte-or-special], or @racket[peek-char-or-special], the
if it accepts zero arguments, otherwise it is passed four arguments procedure is passed no arguments if it accepts zero arguments,
that are all @racket[#f].} otherwise it is passed four arguments that are all @racket[#f].}
] ]

45
pkgs/racket-doc/scribblings/reference/string-input.scrbl
View File

@ -366,19 +366,32 @@ with @racket[skip-bytes-amt] and @racket[progress] arguments like
@racket[peek-bytes-avail!].} @racket[peek-bytes-avail!].}
@defproc[(read-char-or-special [in input-port? (current-input-port)]) @defproc[(read-char-or-special [in input-port? (current-input-port)]
[source-name any/c #f]
[special-wrap (or/c (any/c -> any/c) #f) #f])
(or/c char? eof-object? any/c)]{ (or/c char? eof-object? any/c)]{
Like @racket[read-char], but if the input port returns a @tech{special} Like @racket[read-char], but if the input port returns a
value (through a value-generating procedure in a custom port; see @tech{special} value (through a value-generating procedure in a custom
@secref["customport"] and @secref["special-comments"] for port, where @racket[source-name] is provided to the procedure; see
details), then the @tech{special} value is returned.} @secref["customport"] and @secref["special-comments"] for details),
then the result of applying @racket[special-wrap] to the
@tech{special} value is returned. A @racket[#f] value for
@racket[special-wrap] is treated the same as the identity function.
@defproc[(read-byte-or-special [in input-port? (current-input-port)]) @history[#:changed "6.8.0.2" @elem{Added the @racket[sourve-name] and
@racket[special-wrap] arguments.}]}
@defproc[(read-byte-or-special [in input-port? (current-input-port)]
[source-name any/c #f]
[special-wrap (or/c (any/c -> any/c) #f) #f])
(or/c byte? eof-object? any/c)]{ (or/c byte? eof-object? any/c)]{
Like @racket[read-char-or-special], but reads and returns a byte Like @racket[read-char-or-special], but reads and returns a byte
instead of a character.} instead of a character.
@history[#:changed "6.8.0.2" @elem{Added the @racket[sourve-name] and
@racket[special-wrap] arguments.}]}
@defproc[(peek-char [in input-port? (current-input-port)] @defproc[(peek-char [in input-port? (current-input-port)]
[skip-bytes-amt exact-nonnegative-integer? 0]) [skip-bytes-amt exact-nonnegative-integer? 0])
@ -396,20 +409,30 @@ Like @racket[peek-char], but @tech{peeks} and returns a byte instead of a
character.} character.}
@defproc[(peek-char-or-special [in input-port? (current-input-port)] @defproc[(peek-char-or-special [in input-port? (current-input-port)]
[skip-bytes-amt exact-nonnegative-integer? 0]) [skip-bytes-amt exact-nonnegative-integer? 0]
[source-name any/c #f]
[special-wrap (or/c (any/c -> any/c) #f) #f])
(or/c char? eof-object? any/c)]{ (or/c char? eof-object? any/c)]{
Like @racket[peek-char], but if the input port returns a non-byte Like @racket[peek-char], but if the input port returns a non-byte
value after @racket[skip-bytes-amt] byte positions, then it is returned.} value after @racket[skip-bytes-amt] byte positions, then it is returned.
@history[#:changed "6.8.0.2" @elem{Added the @racket[sourve-name] and
@racket[special-wrap] arguments.}]}
@defproc[(peek-byte-or-special [in input-port? (current-input-port)] @defproc[(peek-byte-or-special [in input-port? (current-input-port)]
[skip-bytes-amt exact-nonnegative-integer? 0] [skip-bytes-amt exact-nonnegative-integer? 0]
[progress (or/c progress-evt? #f) #f]) [progress (or/c progress-evt? #f) #f]
[source-name any/c #f]
[special-wrap (or/c (any/c -> any/c) #f) #f])
(or/c byte? eof-object? any/c)]{ (or/c byte? eof-object? any/c)]{
Like @racket[peek-char-or-special], but @tech{peeks} and returns a byte Like @racket[peek-char-or-special], but @tech{peeks} and returns a byte
instead of a character, and it supports a @racket[progress] argument instead of a character, and it supports a @racket[progress] argument
like @racket[peek-bytes-avail!].} like @racket[peek-bytes-avail!].
@history[#:changed "6.8.0.2" @elem{Added the @racket[sourve-name] and
@racket[special-wrap] arguments.}]}
@defproc[(port-progress-evt [in (and/c input-port? port-provides-progress-evts?) @defproc[(port-progress-evt [in (and/c input-port? port-provides-progress-evts?)

4
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -37,10 +37,10 @@
(err/rt-test (current-error-port (current-input-port))) (err/rt-test (current-error-port (current-input-port)))
(test #\; peek-char this-file) (test #\; peek-char this-file)
(arity-test peek-char 0 2) (arity-test peek-char 0 2)
(arity-test peek-char-or-special 0 2) (arity-test peek-char-or-special 0 4)
(test #\; read-char this-file) (test #\; read-char this-file)
(arity-test read-char 0 1) (arity-test read-char 0 1)
(arity-test read-char-or-special 0 1) (arity-test read-char-or-special 0 3)
(test '(define cur-section '()) read this-file) (test '(define cur-section '()) read this-file)
(arity-test read 0 1) (arity-test read 0 1)
(test #\( peek-char this-file) (test #\( peek-char this-file)

48
racket/src/racket/src/portfun.c
View File

@ -275,9 +275,9 @@ scheme_init_port_fun(Scheme_Env *env)
GLOBAL_NONCM_PRIM("read-syntax/recursive", read_syntax_recur_f, 0, 5, env); GLOBAL_NONCM_PRIM("read-syntax/recursive", read_syntax_recur_f, 0, 5, env);
GLOBAL_PRIM_W_ARITY2("read-language", read_language, 0, 2, 0, -1, env); GLOBAL_PRIM_W_ARITY2("read-language", read_language, 0, 2, 0, -1, env);
GLOBAL_NONCM_PRIM("read-char", read_char, 0, 1, env); GLOBAL_NONCM_PRIM("read-char", read_char, 0, 1, env);
GLOBAL_NONCM_PRIM("read-char-or-special", read_char_spec, 0, 1, env); GLOBAL_NONCM_PRIM("read-char-or-special", read_char_spec, 0, 3, env);
GLOBAL_NONCM_PRIM("read-byte", read_byte, 0, 1, env); GLOBAL_NONCM_PRIM("read-byte", read_byte, 0, 1, env);
GLOBAL_NONCM_PRIM("read-byte-or-special", read_byte_spec, 0, 1, env); GLOBAL_NONCM_PRIM("read-byte-or-special", read_byte_spec, 0, 3, env);
GLOBAL_NONCM_PRIM("read-bytes-line", read_byte_line, 0, 2, env); GLOBAL_NONCM_PRIM("read-bytes-line", read_byte_line, 0, 2, env);
GLOBAL_NONCM_PRIM("read-line", read_line, 0, 2, env); GLOBAL_NONCM_PRIM("read-line", read_line, 0, 2, env);
GLOBAL_NONCM_PRIM("read-string", sch_read_string, 1, 2, env); GLOBAL_NONCM_PRIM("read-string", sch_read_string, 1, 2, env);
@ -305,9 +305,9 @@ scheme_init_port_fun(Scheme_Env *env)
GLOBAL_NONCM_PRIM("write-special", scheme_write_special, 1, 2, env); GLOBAL_NONCM_PRIM("write-special", scheme_write_special, 1, 2, env);
GLOBAL_NONCM_PRIM("write-special-avail*", scheme_write_special_nonblock, 1, 2, env); GLOBAL_NONCM_PRIM("write-special-avail*", scheme_write_special_nonblock, 1, 2, env);
GLOBAL_NONCM_PRIM("peek-char", peek_char, 0, 2, env); GLOBAL_NONCM_PRIM("peek-char", peek_char, 0, 2, env);
GLOBAL_NONCM_PRIM("peek-char-or-special", peek_char_spec, 0, 2, env); GLOBAL_NONCM_PRIM("peek-char-or-special", peek_char_spec, 0, 4, env);
GLOBAL_NONCM_PRIM("peek-byte", peek_byte, 0, 2, env); GLOBAL_NONCM_PRIM("peek-byte", peek_byte, 0, 2, env);
GLOBAL_NONCM_PRIM("peek-byte-or-special", peek_byte_spec, 0, 3, env); GLOBAL_NONCM_PRIM("peek-byte-or-special", peek_byte_spec, 0, 5, env);
GLOBAL_NONCM_PRIM("byte-ready?", byte_ready_p, 0, 1, env); GLOBAL_NONCM_PRIM("byte-ready?", byte_ready_p, 0, 1, env);
GLOBAL_NONCM_PRIM("char-ready?", char_ready_p, 0, 1, env); GLOBAL_NONCM_PRIM("char-ready?", char_ready_p, 0, 1, env);
GLOBAL_NONCM_PRIM("newline", newline, 0, 1, env); GLOBAL_NONCM_PRIM("newline", newline, 0, 1, env);
@ -3038,7 +3038,8 @@ static Scheme_Object *
do_read_char(char *name, int argc, Scheme_Object *argv[], int peek, int spec, int is_byte) do_read_char(char *name, int argc, Scheme_Object *argv[], int peek, int spec, int is_byte)
{ {
Scheme_Object *port; Scheme_Object *port;
int ch; Scheme_Object *skip, *unless_evt, *src, *spec_wrap;
int ch, pos;
if (argc && !SCHEME_INPUT_PORTP(argv[0])) if (argc && !SCHEME_INPUT_PORTP(argv[0]))
scheme_wrong_contract(name, "input-port?", 0, argc, argv); scheme_wrong_contract(name, "input-port?", 0, argc, argv);
@ -3049,8 +3050,7 @@ do_read_char(char *name, int argc, Scheme_Object *argv[], int peek, int spec, in
port = CURRENT_INPUT_PORT(scheme_current_config()); port = CURRENT_INPUT_PORT(scheme_current_config());
if (peek) { if (peek) {
Scheme_Object *skip, *unless_evt = NULL; unless_evt = NULL;
if (argc > 1) { if (argc > 1) {
skip = argv[1]; skip = argv[1];
if (!(SCHEME_INTP(skip) && (SCHEME_INT_VAL(skip) >= 0)) if (!(SCHEME_INTP(skip) && (SCHEME_INT_VAL(skip) >= 0))
@ -3058,7 +3058,7 @@ do_read_char(char *name, int argc, Scheme_Object *argv[], int peek, int spec, in
scheme_wrong_contract(name, "exact-nonnegative-integer?", 1, argc, argv); scheme_wrong_contract(name, "exact-nonnegative-integer?", 1, argc, argv);
return NULL; return NULL;
} }
if (argc > 2) { if (is_byte && (argc > 2)) {
if (SCHEME_TRUEP(argv[2])) { if (SCHEME_TRUEP(argv[2])) {
unless_evt = argv[2]; unless_evt = argv[2];
if (!SAME_TYPE(SCHEME_TYPE(unless_evt), scheme_progress_evt_type)) { if (!SAME_TYPE(SCHEME_TYPE(unless_evt), scheme_progress_evt_type)) {
@ -3077,7 +3077,31 @@ do_read_char(char *name, int argc, Scheme_Object *argv[], int peek, int spec, in
} }
} else } else
skip = NULL; skip = NULL;
} else {
unless_evt = NULL;
skip = NULL;
}
pos = (peek ? (is_byte ? 3 : 2) : 1);
if (argc > pos) {
spec_wrap = argv[pos];
if (SCHEME_FALSEP(spec_wrap))
spec_wrap = NULL;
else
scheme_check_proc_arity2(name, 1, pos, argc, argv, 1);
pos++;
if (argc > pos) {
src = argv[pos++];
if (SCHEME_FALSEP(src))
src = NULL;
} else
src = NULL;
} else {
src = NULL;
spec_wrap = NULL;
}
if (peek) {
if (spec) { if (spec) {
if (is_byte) { if (is_byte) {
ch = scheme_peek_byte_special_ok_skip(port, skip, unless_evt); ch = scheme_peek_byte_special_ok_skip(port, skip, unless_evt);
@ -3104,7 +3128,13 @@ do_read_char(char *name, int argc, Scheme_Object *argv[], int peek, int spec, in
} }
if (ch == SCHEME_SPECIAL) { if (ch == SCHEME_SPECIAL) {
return scheme_get_ready_special(port, NULL, peek); src = scheme_get_ready_special(port, src, peek);
if (spec_wrap) {
Scheme_Object *a[1];
a[0] = src;
return _scheme_tail_apply(spec_wrap, 1, a);
} else
return src;
} else if (ch == EOF) } else if (ch == EOF)
return scheme_eof; return scheme_eof;
else if (is_byte) else if (is_byte)

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "6.8.0.1" #define MZSCHEME_VERSION "6.8.0.2"
#define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 8 #define MZSCHEME_VERSION_Y 8
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 1 #define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)