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

fix interaction of `port-commit-peeked' and port positions

Browse Source 
--- includes a small hack to the `make-input-port' protocol
     to specially handle a byte-string result as "true"
     from the `commit' proc
This commit is contained in:
Matthew Flatt 2011-06-16 08:15:59 -06:00
parent 80bd949531
commit 83d002a9aa
16 changed files with 299 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/mzlib/port.rkt
View File

@ -130,6 +130,7 @@
(define special-peeked null)
(define special-peeked-tail #f)
(define progress-requested? #f)
(define line-counting? #f)
(define use-manager? #f)
(define manager-th #f)
(define manager-ch (make-channel))
@ -313,11 +314,15 @@
#f
(let* ([avail (pipe-content-length peeked-r)]
[p-commit (min avail amt)])
(let loop ([amt (- amt p-commit)] [l special-peeked])
(let loop ([amt (- amt p-commit)]
[l special-peeked]
;; result is either bytes (if needed for line ounting)
;; or an integer count (for on-consumed)
[result (if line-counting? null 0)])
(cond
[(amt . <= . 0)
;; Enough has been peeked. Do commit...
(actual-commit p-commit l unless-evt done-evt)]
(actual-commit p-commit l unless-evt done-evt result)]
[(null? l)
;; Requested commit was larger than previous peeks
#f]
@ -330,21 +335,39 @@
(set-mcdr! l next)
(when (eq? l special-peeked-tail)
(set! special-peeked-tail next))
(loop 0 (mcdr l)))
(loop 0 (mcdr l) (if line-counting?
(cons (subbytes (mcar l) 0 amt) result)
(+ amt result))))
;; Consume this string...
(loop (- amt bl) (mcdr l))))]
(loop (- amt bl) (mcdr l) (if line-counting?
(cons (mcar l) result)
(+ bl result)))))]
[else
(loop (sub1 amt) (mcdr l))])))))
(define (actual-commit p-commit l unless-evt done-evt)
(loop (sub1 amt) (mcdr l) (if line-counting?
(cons #"." result)
(add1 result)))])))))
(define (actual-commit p-commit l unless-evt done-evt result)
;; The `finish' proc finally, actually, will commit...
(define (finish)
(unless (zero? p-commit)
(peek-byte peeked-r (sub1 p-commit))
(port-commit-peeked p-commit unless-evt always-evt peeked-r))
(set! special-peeked l)
(when (null? special-peeked) (set! special-peeked-tail #f))
(when (and progress-requested? (zero? p-commit)) (make-progress))
#t)
(let ([result (if line-counting?
(cons (peek-bytes p-commit 0 peeked-r) result)
(+ p-commit result))])
(unless (zero? p-commit)
(peek-byte peeked-r (sub1 p-commit))
(port-commit-peeked p-commit unless-evt always-evt peeked-r))
(set! special-peeked l)
(when (null? special-peeked) (set! special-peeked-tail #f))
(when (and progress-requested? (zero? p-commit)) (make-progress))
(if line-counting?
;; bytes representation of committed text allows line counting
;; to be updated correctly (when line counting is implemented
;; automatically)
(let ([bstr (apply bytes-append (reverse result))])
(when on-consumed (on-consumed (bytes-length bstr)))
bstr)
(begin
(when on-consumed (on-consumed result))
#t))))
;; If we can sync done-evt immediately, then finish.
(if (sync/timeout 0 (wrap-evt done-evt (lambda (x) #t)))
(finish)
@ -429,7 +452,9 @@
(port-progress-evt peeked-r))
commit-it
location-proc
count-lines!-proc
(lambda ()
(set! line-counting? #t)
(count-lines!-proc))
init-position
(and buffer-mode-proc
(case-lambda

56
collects/scribblings/inside/ports.scrbl
View File

@ -479,7 +479,15 @@ The functions are as follows.
argument to @scheme[make-input-port]. Use
@cpp{scheme_peeked_read_via_get} for the default implementation of
commits when @var{progress_evt_fun} is
@cpp{scheme_progress_evt_via_get}.}
@cpp{scheme_progress_evt_via_get}.
The @var{peeked_read_fun} function must call
@cpp{scheme_port_count_lines} on a successful commit to adjust the
port's position. If line counting is enabled for the port and if
line counting uses the default implementation,
@var{peeked_read_fun} should supply a non-@cpp{NULL} byte-string
argument to @cpp{scheme_port_count_lines}, so that character and
line counts can be tracked correctly.}
@subfunction[(int char_ready_fun
[Scheme_Input_Port* port])]{
@ -634,6 +642,52 @@ The functions are as follows.
}
@function[(void scheme_set_port_location_fun [Scheme_Port* port]
[Scheme_Location_Fun location_fun])]{
Sets the implementation of @racket[port-next-location] for @var{port},
which is used when line counting is enabled for @var{port}.
@subfunction[(Scheme_Object* location_fun
[Scheme_Port* port])]{
Returns three values: a positive exact integer or @racket[#f] for a line number,
a non-negative exact integer or @racket[#f] for a column (which must be @racket[#f]
if and only if the line number is @racket[#f]), and
a positive exact integer or @racket[#f] for a character position.
}
}
@function[(void scheme_set_port_count_lines_fun [Scheme_Port* port]
[Scheme_Count_Lines_Fun count_lines_fun])]{
Installs a notification callback that is invoked if line counting is subsequently
enabled for @var{port}.
@subfunction[(void count_lines_fun
[Scheme_Port* port])]
}
@function[(void scheme_port_count_lines [Scheme_Port* port]
[const-char* buffer]
[intptr_t offset]
[intptr_t got])]{
Updates the position of @var{port} as reported by
@racket[file-position] as well as the locations reported by
@racket[port-next-location] when the default implement of character
and line counting is used. This function is intended for use by a
peek-commit implementation in an input port.
The @var{got} argument indicates the number of bytes read from or
written to @var{port}. The @var{buffer} argument is used only when
line counting is enabled, and it represents specific bytes read or
written for the purposes of character and line coutning. The
@var{buffer} argument can be @cpp{NULL}, in which case @var{got}
non-newline characters are assumed. The @var{offset} argument
indicates a starting offset into @var{buffer}, so @racket{buffer} must
be at least @var{offset} plus @var{got} bytes long.}
@function[(Scheme_Object* scheme_make_file_input_port
[FILE* fp])]{

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

@ -286,6 +286,15 @@ The arguments implement the port as follows:
progress event must be ready (perhaps because data has just been
committed).}
@item{It should return a byte string as a true result when line
counting is enabled and @racket[get-location] is @racket[#f] (so
that line counting is implemented the default way); the result
byte string represents the data that was committed for the
purposes of character and line counting. If any other true result
is returned when a byte string is expected, it is treated like a
byte string where each byte corresponds to a non-newline
character.}
@item{It must raise an exception if no data (including
@scheme[eof]) has been peeked from the beginning of the port's
stream, or if it would have to block indefinitely to wait for the

12
collects/scribblings/reference/port-lib.scrbl
View File

@ -189,11 +189,11 @@ input ports as it becomes available.}
#f)
#f]
[buffering? any/c #f]
[on-consume (or/c ((or/c exact-nonnegative-integer? eof-object?
procedure? evt?)
. -> . any)
#f)
#f])
[on-consumed (or/c ((or/c exact-nonnegative-integer? eof-object?
procedure? evt?)
. -> . any)
#f)
#f])
input-port?]{
Similar to @racket[make-input-port], but if the given @racket[read-in]
@ -225,7 +225,7 @@ then @racket[buffering?] determines the initial buffer mode, and
new mode is @racket['block].
If @racket[on-consumed] is not @racket[#f], it is called when data is
read from the port, as opposed to merely peeked. The argument to
read (or committed) from the port, as opposed to merely peeked. The argument to
@racket[on-consumed] is the result value of the port's reading
procedure, so it can be an integer or any result from
@racket[read-in].}

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

@ -626,6 +626,54 @@
(with-handlers ([exn:break? (lambda (exn) 'ok)])
(write-byte 0 p))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test port-commit-peeked and position counting
(let ([check
(lambda (in [d 0] [first-three-bytes #"123"] [char-len 3])
(test d file-position in)
(let-values ([(l c p) (port-next-location in)])
(test p add1 d)
(test first-three-bytes peek-bytes 3 0 in)
(test d file-position in)
(let-values ([(l2 c2 p2) (port-next-location in)])
(test (list l c p) list l2 c2 p2))
(port-commit-peeked 3 (port-progress-evt in) always-evt in)
(test (+ d 3) file-position in)
(let-values ([(l2 c2 p2) (port-next-location in)])
(test (list l (and c (+ c char-len)) (+ p (if c char-len 3)))
list l2 c2 p2))
(test #\4 read-char in)))])
(define (check-all count-lines!)
(let ()
(define s (open-input-string "12345"))
(count-lines! s)
(check s))
(let ()
(define s (open-input-string "012345"))
(count-lines! s)
(read-byte s)
(check s 1))
(let ()
(define s (open-input-string "1\u03BB45"))
(count-lines! s)
(check s 0 (string->bytes/utf-8 "1\u3BB") 2))
(let ()
(define-values (in out) (make-pipe))
(display "12345" out)
(count-lines! in)
(check in))
(let ()
(with-output-to-file "tmp8"
#:exists 'truncate/replace
(lambda () (display "12345")))
(define in (open-input-file "tmp8"))
(count-lines! in)
(check in)
(delete-file "tmp8")))
(check-all void)
(check-all port-count-lines!))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

64
collects/tests/racket/portlib.rktl
View File

@ -5,7 +5,7 @@
(define SLEEP-TIME 0.1)
(require scheme/port)
(require racket/port)
;; ----------------------------------------
@ -740,6 +740,68 @@
(display "x " out)
(test 'x read in)))
;; --------------------------------------------------
;; Test port-commit-peeked and position counting
(let ([check
(lambda (in [d 0] [first-three-bytes (bytes->list #"123")] [char-len 3])
(test d file-position in)
(let-values ([(l c p) (port-next-location in)])
(test p add1 d)
(test (car first-three-bytes) peek-byte-or-special in 0)
(test (cadr first-three-bytes) peek-byte-or-special in 1)
(test (caddr first-three-bytes) peek-byte-or-special in 2)
(test d file-position in)
(let-values ([(l2 c2 p2) (port-next-location in)])
(test (list l c p) list l2 c2 p2))
(port-commit-peeked 3 (port-progress-evt in) always-evt in)
(test (+ d 3) file-position in)
(let-values ([(l2 c2 p2) (port-next-location in)])
(test (list l (and c (+ c char-len)) (+ p (if c char-len 3)))
list l2 c2 p2))
(test #\4 read-char in)))])
(define (check-all count-lines!)
(define (check-made first-three-bytes char-len
[get-loc #f] [on-consume void]
[init-pos 1])
(define stream (append first-three-bytes (list (char->integer #\4))))
(define p (make-input-port/read-to-peek
'made
(lambda (bstr)
(let ([b (car stream)])
(set! stream (cdr stream))
(if (byte? b)
(begin
(bytes-set! bstr 0 b)
1)
(lambda (srcloc line col pos) b))))
#f
void
get-loc
void
init-pos
#f
#f
on-consume))
(count-lines! p)
(check p (sub1 init-pos) first-three-bytes char-len))
(check-made (bytes->list #"123") 3)
(check-made (list (char->integer #\1) 'special (char->integer #\3)) 3)
(check-made (bytes->list (string->bytes/utf-8 "1\u3BB")) 2)
(let ()
(define line 1) (define col 0) (define pos 1)
(check-made (bytes->list (string->bytes/utf-8 "123"))
1 ;; claim that "123" is a single character
(lambda () (values line col pos))
(lambda (n)
(let ([n (if (= col 0)
1 ;; "123" is a single character
n)])
(set! col (+ col n))
(set! pos (+ pos n))))))
(void))
(check-all void)
(check-all port-count-lines!))
;; --------------------------------------------------

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

@ -209,7 +209,7 @@ EXPORTS
scheme_dont_gc_ptr
scheme_gc_ptr_ok
scheme_collect_garbage
scheme_disable_garbage_collection
scheme_enable_garbage_collection
scheme_malloc_immobile_box
scheme_free_immobile_box
scheme_add_gc_callback
@ -423,6 +423,7 @@ EXPORTS
scheme_set_next_port_custodian
scheme_set_port_location_fun
scheme_set_port_count_lines_fun
scheme_port_count_lines
scheme_progress_evt_via_get
scheme_peeked_read_via_get
scheme_write_evt_via_write

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

@ -218,7 +218,7 @@ EXPORTS
scheme_dont_gc_ptr
scheme_gc_ptr_ok
scheme_collect_garbage
scheme_disable_garbage_collection
scheme_enable_garbage_collection
GC_variable_stack
GC_register_traversers
GC_resolve
@ -438,6 +438,7 @@ EXPORTS
scheme_set_next_port_custodian
scheme_set_port_location_fun
scheme_set_port_count_lines_fun
scheme_port_count_lines
scheme_progress_evt_via_get
scheme_peeked_read_via_get
scheme_write_evt_via_write

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

@ -221,7 +221,7 @@ scheme_remove_all_finalization
scheme_dont_gc_ptr
scheme_gc_ptr_ok
scheme_collect_garbage
scheme_disable_garbage_collection
scheme_enable_garbage_collection
GC_register_traversers
GC_resolve
GC_mark
@ -440,6 +440,7 @@ scheme_make_output_port
scheme_set_next_port_custodian
scheme_set_port_location_fun
scheme_set_port_count_lines_fun
scheme_port_count_lines
scheme_progress_evt_via_get
scheme_peeked_read_via_get
scheme_write_evt_via_write

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

@ -226,7 +226,7 @@ scheme_remove_all_finalization
scheme_dont_gc_ptr
scheme_gc_ptr_ok
scheme_collect_garbage
scheme_disable_garbage_collection
scheme_enable_garbage_collection
GC_variable_stack
GC_register_traversers
GC_resolve
@ -446,6 +446,7 @@ scheme_make_output_port
scheme_set_next_port_custodian
scheme_set_port_location_fun
scheme_set_port_count_lines_fun
scheme_port_count_lines
scheme_progress_evt_via_get
scheme_peeked_read_via_get
scheme_write_evt_via_write

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

@ -1646,6 +1646,15 @@ XFORM_NONGCING static void do_count_lines(Scheme_Port *ip, const char *buffer, i
mzAssert(ip->position >= 0);
}
void scheme_port_count_lines(Scheme_Port *ip, const char *buffer, intptr_t offset, intptr_t got)
{
if (ip->position >= 0)
ip->position += got;
if (ip->count_lines)
do_count_lines(ip, buffer, offset, got);
}
intptr_t scheme_get_byte_string_unless(const char *who,
Scheme_Object *port,
char *buffer, intptr_t offset, intptr_t size,
@ -2133,6 +2142,9 @@ static int complete_peeked_read_via_get(Scheme_Input_Port *ip,
{
Scheme_Get_String_Fun gs;
int did;
char *buf, _buf[16];
int buf_size = 16;
buf = _buf;
did = 0;
@ -2140,12 +2152,30 @@ static int complete_peeked_read_via_get(Scheme_Input_Port *ip,
/* First remove ungotten_count chars */
if (ip->ungotten_count) {
if (ip->ungotten_count > size)
int i, amt;
if (ip->ungotten_count > size) {
amt = size;
ip->ungotten_count -= size;
else {
} else {
amt = ip->ungotten_count;
size -= ip->ungotten_count;
ip->ungotten_count = 0;
}
if (ip->p.position >= 0)
ip->p.position += amt;
if (ip->p.count_lines) {
if (buf_size < amt) {
buf = scheme_malloc_atomic(amt);
buf_size = amt;
}
for (i = 0; i < amt; i++) {
buf[i] = ip->ungotten[ip->ungotten_count + amt - i - 1];
}
do_count_lines((Scheme_Port *)ip, buf, 0, amt);
}
if (ip->progress_evt)
post_progress(ip);
did = 1;
@ -2176,10 +2206,21 @@ static int complete_peeked_read_via_get(Scheme_Input_Port *ip,
}
if (gs) {
size = gs(pip, NULL, 0, size, 1, NULL);
if (ip->p.count_lines) {
if (buf_size < size) {
buf = scheme_malloc_atomic(size);
buf_size = size;
}
} else
buf = NULL;
size = gs(pip, buf, 0, size, 1, NULL);
if (size > 0) {
if (ip->progress_evt)
post_progress(ip);
if (ip->p.position >= 0)
ip->p.position += size;
if (buf)
do_count_lines((Scheme_Port *)ip, buf, 0, size);
did = 1;
}
}

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

@ -1049,6 +1049,25 @@ user_peeked_read(Scheme_Input_Port *port,
scheme_pop_break_enable(&cframe, 1);
if (SCHEME_TRUEP(val)) {
char *buf;
if (SCHEME_BYTE_STRINGP(val)) {
size = SCHEME_BYTE_STRLEN_VAL(val);
buf = SCHEME_BYTE_STR_VAL(val);
} else
buf = NULL;
if (port->p.count_lines) {
if (!buf) {
buf = scheme_malloc_atomic(size);
memset(buf, 'x', size);
}
}
scheme_port_count_lines((Scheme_Port *)port, buf, 0, size);
}
return SCHEME_TRUEP(val);
}

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

@ -848,6 +848,8 @@ MZ_EXTERN void scheme_set_port_location_fun(Scheme_Port *port,
Scheme_Location_Fun location_fun);
MZ_EXTERN void scheme_set_port_count_lines_fun(Scheme_Port *port,
Scheme_Count_Lines_Fun count_lines_fun);
MZ_EXTERN void scheme_port_count_lines(Scheme_Port *ip, const char *buffer,
intptr_t offset, intptr_t got);
MZ_EXTERN Scheme_Object *scheme_progress_evt_via_get(Scheme_Input_Port *port);
MZ_EXTERN int scheme_peeked_read_via_get(Scheme_Input_Port *port,

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

@ -698,6 +698,8 @@ void (*scheme_set_port_location_fun)(Scheme_Port *port,
Scheme_Location_Fun location_fun);
void (*scheme_set_port_count_lines_fun)(Scheme_Port *port,
Scheme_Count_Lines_Fun count_lines_fun);
void (*scheme_port_count_lines)(Scheme_Port *ip, const char *buffer,
intptr_t offset, intptr_t got);
Scheme_Object *(*scheme_progress_evt_via_get)(Scheme_Input_Port *port);
int (*scheme_peeked_read_via_get)(Scheme_Input_Port *port,
intptr_t size,

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

@ -247,7 +247,7 @@
scheme_extension_table->scheme_dont_gc_ptr = scheme_dont_gc_ptr;
scheme_extension_table->scheme_gc_ptr_ok = scheme_gc_ptr_ok;
scheme_extension_table->scheme_collect_garbage = scheme_collect_garbage;
scheme_extension_table->scheme_disable_garbage_collection = scheme_disable_garbage_collection;
scheme_extension_table->scheme_enable_garbage_collection = scheme_enable_garbage_collection;
#ifdef MZ_PRECISE_GC
# ifndef USE_THREAD_LOCAL
scheme_extension_table->GC_variable_stack = GC_variable_stack;
@ -488,6 +488,7 @@
scheme_extension_table->scheme_set_next_port_custodian = scheme_set_next_port_custodian;
scheme_extension_table->scheme_set_port_location_fun = scheme_set_port_location_fun;
scheme_extension_table->scheme_set_port_count_lines_fun = scheme_set_port_count_lines_fun;
scheme_extension_table->scheme_port_count_lines = scheme_port_count_lines;
scheme_extension_table->scheme_progress_evt_via_get = scheme_progress_evt_via_get;
scheme_extension_table->scheme_peeked_read_via_get = scheme_peeked_read_via_get;
scheme_extension_table->scheme_write_evt_via_write = scheme_write_evt_via_write;

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

@ -247,7 +247,7 @@
#define scheme_dont_gc_ptr (scheme_extension_table->scheme_dont_gc_ptr)
#define scheme_gc_ptr_ok (scheme_extension_table->scheme_gc_ptr_ok)
#define scheme_collect_garbage (scheme_extension_table->scheme_collect_garbage)
#define scheme_disable_garbage_collection (scheme_extension_table->scheme_disable_garbage_collection)
#define scheme_enable_garbage_collection (scheme_extension_table->scheme_enable_garbage_collection)
#ifdef MZ_PRECISE_GC
# ifndef USE_THREAD_LOCAL
#define GC_variable_stack (scheme_extension_table->GC_variable_stack)
@ -488,6 +488,7 @@
#define scheme_set_next_port_custodian (scheme_extension_table->scheme_set_next_port_custodian)
#define scheme_set_port_location_fun (scheme_extension_table->scheme_set_port_location_fun)
#define scheme_set_port_count_lines_fun (scheme_extension_table->scheme_set_port_count_lines_fun)
#define scheme_port_count_lines (scheme_extension_table->scheme_port_count_lines)
#define scheme_progress_evt_via_get (scheme_extension_table->scheme_progress_evt_via_get)
#define scheme_peeked_read_via_get (scheme_extension_table->scheme_peeked_read_via_get)
#define scheme_write_evt_via_write (scheme_extension_table->scheme_write_evt_via_write)