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

add `port-set-next-location!'; make prompt read handler use it

Browse Source 
Closes PR 12035
This commit is contained in:
Matthew Flatt 2011-07-10 08:22:40 -06:00
parent ebe9453e73
commit cc6f3f69ab
21 changed files with 1108 additions and 974 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/readline/pread.rkt
View File

@ -100,7 +100,7 @@
(define (readline-bytes/hist p force-keep?)
(when (eq? readline-output-port (current-output-port))
(let-values ([(line col pos) (port-next-location readline-output-port)])
(when (< 0 col) (newline readline-output-port))))
(when (and col (positive? col)) (newline readline-output-port))))
(let ([s (readline-bytes p)]) (add-to-history s force-keep?) s))
(exit-handler

2
collects/scribblings/reference/custom-ports.scrbl
View File

@ -4,7 +4,7 @@
@title[#:tag "customport"]{Custom Ports}
The @racket[make-input-port] and @racket[make-output-port] procedures
create custom ports with arbitrary control procedures (much like
create @deftech{custom ports} with arbitrary control procedures (much like
implementing a device driver). Custom ports are mainly useful to
obtain fine control over the action of committing bytes as read or
written.

9
collects/scribblings/reference/eval.scrbl
View File

@ -329,7 +329,14 @@ result of
@racketblock[
(let ([in ((current-get-interaction-input-port))])
((current-read-interaction) (object-name in) in))
]}
]
If the input and output ports are both terminals (in the sense of
@racket[terminal-port?]) and if the output port appears to be counting
lines (because @racket[port-next-location] returns a non-@racket[#f]
line and column), then the output port's line is incremented and its
column is reset to @racket[0] via @racket[set-port-next-location!]
before returning the read result.}
@defparam[current-get-interaction-input-port proc (-> input-port?)]{

17
collects/scribblings/reference/port-line-counting.scrbl
View File

@ -38,6 +38,11 @@ the port becomes unknown, and line and column tacking is disabled.
Return-linefeed combinations are treated as a single character
position only when line and column counting is enabled.
@tech{Custom ports} can define their own counting functions, which are
not subject to the rules above, except that the counting functions are
invoked only when tracking is specifically enabled with
@racket[port-count-lines!].
@;------------------------------------------------------------------------
@defproc[(port-count-lines! [port port?]) void?]{
@ -81,6 +86,18 @@ Even with line counting enabled, a port may return @racket[#f] values
if it somehow cannot keep track of lines, columns, or positions.}
@defproc[(set-port-next-location! [port port?]
[line (or/c exact-positive-integer? #f)]
[column (or/c exact-nonnegative-integer? #f)]
[position (or/c exact-positive-integer? #f)])
void?]{
Sets the next line, column, and position for @racket[port]. If line
counting has not been enabled for @racket[port] or if @racket[port] is
a @tech{custom port} that defines its own counting function, then
@racket[set-port-next-location!] has no effect.}
@defboolparam[port-count-lines-enabled on?]{
A parameter that determines whether line counting is enabled

5
collects/scribblings/reference/pretty-print.scrbl
View File

@ -14,7 +14,10 @@ default @racket[print] mode, but with newlines and whitespace inserted
to avoid lines longer than @racket[(pretty-print-columns)], as
controlled by @racket[(pretty-print-current-style-table)]. The printed
form ends in a newline, unless the @racket[pretty-print-columns]
parameter is set to @racket['infinity].
parameter is set to @racket['infinity]. When @racket[port] has line
counting enabled (see @secref["linecol"]), then printing is sensitive
to the column when printing starts---both for determining an initial
line break and indenting subsequent lines.
In addition to the parameters defined in this section,
@racket[pretty-print] conforms to the @racket[print-graph],

24
collects/tests/racket/port.rktl
View File

@ -514,7 +514,7 @@
(adjust-locs line col pos))))])
(port-count-lines! p2)
p2)))])
(let ([plain (let ([p (open-input-string "Hello\n\n world")])
(let ([plain (let ([p (open-input-string "Hello\n\n world 1\n2")])
(port-count-lines! p)
p)]
[double (mk (lambda (l c p)
@ -536,6 +536,14 @@
(test-values '(#f #f #f) (lambda () (port-next-location none)))
(err/rt-test (port-next-location bad))
;; `set-port-next-location!' should have no effect on custom ports:
(set-port-next-location! double 1 1 1)
(test-values '(2 10 12) (lambda () (port-next-location double)))
(set-port-next-location! none 1 1 1)
(test-values '(#f #f #f) (lambda () (port-next-location none)))
(set-port-next-location! bad 1 1 1)
(err/rt-test (port-next-location bad))
(let ([stx (read-syntax #f plain)])
(test 3 syntax-line stx)
(test 1 syntax-column stx)
@ -555,7 +563,19 @@
(test-values '(3 6 14) (lambda () (port-next-location plain)))
(test-values '(6 12 28) (lambda () (port-next-location double)))
(test-values '(#f #f #f) (lambda () (port-next-location none)))))
(test-values '(#f #f #f) (lambda () (port-next-location none)))
;; Check `set-port-next-location!':
(set-port-next-location! plain 100 13 1023)
(test-values '(100 13 1023) (lambda () (port-next-location plain)))
(let ([stx (read-syntax #f plain)])
(test 100 syntax-line stx)
(test 14 syntax-column stx)
(test 1024 syntax-position stx))
(let ([stx (read-syntax #f plain)])
(test 101 syntax-line stx)
(test 0 syntax-column stx)
(test 1026 syntax-position stx))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that if the initial commit thread is killed, then

5
doc/release-notes/racket/HISTORY.txt
View File

@ -1,6 +1,11 @@
Version 5.1.2.3
Added set-port-next-location! and changed the default prompt
read handler to use it when input and output ar terminals
Version 5.1.2.2
Changed the location-creation semantics of internal definitions
and `letrec-syntaxes+values'
Added unsafe-list-ref and unsafe-list-tail
Version 5.1.2, July 2011
Replaced syntax certificates with syntax taints:

1
src/racket/include/mzwin.def
View File

@ -408,6 +408,7 @@ EXPORTS
scheme_tell_line
scheme_tell_column
scheme_tell_all
scheme_set_port_location
scheme_count_lines
scheme_close_input_port
scheme_close_output_port

1
src/racket/include/mzwin3m.def
View File

@ -423,6 +423,7 @@ EXPORTS
scheme_tell_line
scheme_tell_column
scheme_tell_all
scheme_set_port_location
scheme_count_lines
scheme_close_input_port
scheme_close_output_port

1
src/racket/include/racket.exp
View File

@ -425,6 +425,7 @@ scheme_output_tell
scheme_tell_line
scheme_tell_column
scheme_tell_all
scheme_set_port_location
scheme_count_lines
scheme_close_input_port
scheme_close_output_port

1
src/racket/include/racket3m.exp
View File

@ -431,6 +431,7 @@ scheme_output_tell
scheme_tell_line
scheme_tell_column
scheme_tell_all
scheme_set_port_location
scheme_count_lines
scheme_close_input_port
scheme_close_output_port

1846
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

28
src/racket/src/fun.c
View File

@ -8548,7 +8548,7 @@ scheme_default_prompt_read_handler(int argc, Scheme_Object *argv[])
{
Scheme_Config *config;
Scheme_Object *port, *reader, *getter;
Scheme_Object *inport, *name, *a[2];
Scheme_Object *inport, *name, *a[4], *v;
config = scheme_current_config();
port = scheme_get_param(config, MZCONFIG_OUTPUT_PORT);
@ -8569,7 +8569,31 @@ scheme_default_prompt_read_handler(int argc, Scheme_Object *argv[])
a[0] = name;
a[1] = inport;
return _scheme_apply(reader, 2, a);
v = _scheme_apply(reader, 2, a);
a[0] = inport;
if (SCHEME_TRUEP(scheme_terminal_port_p(1, a))) {
a[0] = port;
if (SCHEME_TRUEP(scheme_terminal_port_p(1, a))) {
intptr_t line, col, pos;
scheme_tell_all(port, &line, &col, &pos);
if ((col > 0) && (line > 0)) {
/* input and output are terminals (assume the same one),
and the output port counts lines: tell output port
that it's on a new line: */
a[0] = port;
a[1] = scheme_make_integer(line + 1);
a[2] = scheme_make_integer(0);
if (pos > 0)
a[3] = scheme_make_integer(pos + 2); /* incremet plus 0-adjust */
else
a[3] = scheme_false;
scheme_set_port_location(4, a);
}
}
}
return v;
}
Scheme_Object *

111
src/racket/src/port.c
View File

@ -3386,19 +3386,69 @@ scheme_tell_column (Scheme_Object *port)
return col;
}
static void extract_next_location(const char *who, int argc, Scheme_Object **a, int delta,
intptr_t *_line, intptr_t *_col, intptr_t *_pos)
{
int i, j;
intptr_t v;
intptr_t line = -1, col = -1, pos = -1;
for (j = 0; j < 3; j++) {
v = -1;
i = j + delta;
if (SCHEME_TRUEP(a[i])) {
if (scheme_nonneg_exact_p(a[i])) {
if (SCHEME_INTP(a[i])) {
v = SCHEME_INT_VAL(a[i]);
if ((j != 1) && !v) {
v = -1;
}
}
}
if (v == -1) {
if (argc < 0)
a[0] = a[i];
scheme_wrong_type(who,
((j == 1) ? "non-negative exact integer or #f" : "positive exact integer or #f"),
((argc > 0) ? i : -1), argc, a);
return;
}
}
switch (j) {
case 0:
line = v;
break;
case 1:
col = v;
break;
case 2:
pos = v;
break;
}
}
/* Internally, positions count from 0 instead of 1 */
if (pos > -1)
pos--;
if (_line) *_line = line;
if (_col) *_col = col;
if (_pos) *_pos = pos;
}
void
scheme_tell_all (Scheme_Object *port, intptr_t *_line, intptr_t *_col, intptr_t *_pos)
{
Scheme_Port *ip;
intptr_t line = -1, col = -1, pos = -1;
ip = scheme_port_record(port);
if (ip->count_lines && ip->location_fun) {
Scheme_Location_Fun location_fun;
Scheme_Object *r, *a[3];
intptr_t v;
int got, i;
int got;
location_fun = ip->location_fun;
r = location_fun(ip);
@ -3416,48 +3466,37 @@ scheme_tell_all (Scheme_Object *port, intptr_t *_line, intptr_t *_col, intptr_t
a[1] = scheme_multiple_array[1];
a[2] = scheme_multiple_array[2];
for (i = 0; i < 3; i++) {
v = -1;
if (SCHEME_TRUEP(a[i])) {
if (scheme_nonneg_exact_p(a[i])) {
if (SCHEME_INTP(a[i])) {
v = SCHEME_INT_VAL(a[i]);
if ((i != 1) && !v) {
a[0] = a[i];
scheme_wrong_type("user port next-location",
((i == 1) ? "non-negative exact integer or #f" : "positive exact integer or #f"),
-1, -1, a);
return;
}
}
}
}
switch(i) {
case 0:
line = v;
break;
case 1:
col = v;
break;
case 2:
pos = v;
break;
}
}
/* Internally, positions count from 0 instead of 1 */
if (pos > -1)
pos--;
extract_next_location("user port next-location", -1, a, 0, _line, _col, _pos);
} else {
intptr_t line, col, pos;
line = scheme_tell_line(port);
col = scheme_tell_column(port);
pos = scheme_tell(port);
}
if (_line) *_line = line;
if (_col) *_col = col;
if (_pos) *_pos = pos;
}
}
void scheme_set_port_location(int argc, Scheme_Object **argv)
{
Scheme_Port *ip;
intptr_t line, col, pos;
extract_next_location("set-port-next-location!", argc, argv,
1, &line, &col, &pos);
ip = scheme_port_record(argv[0]);
if (ip->count_lines) {
ip->readpos = pos;
ip->lineNumber = line;
ip->column = col;
}
}
void
scheme_count_lines (Scheme_Object *port)

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

@ -125,6 +125,7 @@ static Scheme_Object *global_port_print_handler(int, Scheme_Object **args);
static Scheme_Object *global_port_count_lines(int, Scheme_Object **args);
static Scheme_Object *port_count_lines(int, Scheme_Object **args);
static Scheme_Object *port_next_location(int, Scheme_Object **args);
static Scheme_Object *set_port_next_location(int, Scheme_Object **args);
static Scheme_Object *sch_default_read_handler(void *ignore, int argc, Scheme_Object *argv[]);
static Scheme_Object *sch_default_display_handler(int argc, Scheme_Object *argv[]);
@ -254,7 +255,7 @@ scheme_init_port_fun(Scheme_Env *env)
GLOBAL_PRIM_W_ARITY2("load", load, 1, 1, 0, -1, env);
GLOBAL_PRIM_W_ARITY2("make-pipe", sch_pipe, 0, 3, 2, 2, env);
GLOBAL_PRIM_W_ARITY2("port-next-location", port_next_location, 1, 1, 3, 3, env);
GLOBAL_PRIM_W_ARITY("set-port-next-location!", set_port_next_location, 4, 4, env);
GLOBAL_NONCM_PRIM("read", read_f, 0, 1, env);
GLOBAL_NONCM_PRIM("read/recursive", read_recur_f, 0, 4, env);
@ -4094,6 +4095,16 @@ static Scheme_Object *port_next_location(int argc, Scheme_Object *argv[])
return scheme_values(3, a);
}
static Scheme_Object *set_port_next_location(int argc, Scheme_Object *argv[])
{
if (!SCHEME_INPUT_PORTP(argv[0]) && !SCHEME_OUTPUT_PORTP(argv[0]))
scheme_wrong_type("set-port-next-location!", "port", 0, argc, argv);
scheme_set_port_location(argc, argv);
return scheme_void;
}
typedef struct {
MZTAG_IF_REQUIRED
Scheme_Config *config;

1
src/racket/src/schemef.h
View File

@ -807,6 +807,7 @@ MZ_EXTERN intptr_t scheme_output_tell(Scheme_Object *port);
MZ_EXTERN intptr_t scheme_tell_line(Scheme_Object *port);
MZ_EXTERN intptr_t scheme_tell_column(Scheme_Object *port);
MZ_EXTERN void scheme_tell_all(Scheme_Object *port, intptr_t *line, intptr_t *col, intptr_t *pos);
MZ_EXTERN void scheme_set_port_location(int argc, Scheme_Object **argv);
MZ_EXTERN void scheme_count_lines(Scheme_Object *port);
MZ_EXTERN void scheme_close_input_port(Scheme_Object *port);
MZ_EXTERN void scheme_close_output_port(Scheme_Object *port);

1
src/racket/src/schemex.h
View File

@ -662,6 +662,7 @@ intptr_t (*scheme_output_tell)(Scheme_Object *port);
intptr_t (*scheme_tell_line)(Scheme_Object *port);
intptr_t (*scheme_tell_column)(Scheme_Object *port);
void (*scheme_tell_all)(Scheme_Object *port, intptr_t *line, intptr_t *col, intptr_t *pos);
void (*scheme_set_port_location)(int argc, Scheme_Object **argv);
void (*scheme_count_lines)(Scheme_Object *port);
void (*scheme_close_input_port)(Scheme_Object *port);
void (*scheme_close_output_port)(Scheme_Object *port);

1
src/racket/src/schemex.inc
View File

@ -473,6 +473,7 @@
scheme_extension_table->scheme_tell_line = scheme_tell_line;
scheme_extension_table->scheme_tell_column = scheme_tell_column;
scheme_extension_table->scheme_tell_all = scheme_tell_all;
scheme_extension_table->scheme_set_port_location = scheme_set_port_location;
scheme_extension_table->scheme_count_lines = scheme_count_lines;
scheme_extension_table->scheme_close_input_port = scheme_close_input_port;
scheme_extension_table->scheme_close_output_port = scheme_close_output_port;

1
src/racket/src/schemexm.h
View File

@ -473,6 +473,7 @@
#define scheme_tell_line (scheme_extension_table->scheme_tell_line)
#define scheme_tell_column (scheme_extension_table->scheme_tell_column)
#define scheme_tell_all (scheme_extension_table->scheme_tell_all)
#define scheme_set_port_location (scheme_extension_table->scheme_set_port_location)
#define scheme_count_lines (scheme_extension_table->scheme_count_lines)
#define scheme_close_input_port (scheme_extension_table->scheme_close_input_port)
#define scheme_close_output_port (scheme_extension_table->scheme_close_output_port)

2
src/racket/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1026
#define EXPECTED_PRIM_COUNT 1027
#define EXPECTED_UNSAFE_COUNT 78
#define EXPECTED_FLFXNUM_COUNT 68
#define EXPECTED_FUTURES_COUNT 11

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.1.2.2"
#define MZSCHEME_VERSION "5.1.2.3"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 2
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)