From 174eb84534009c1e80d82f1cec9591f382a45c76 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 2 Jul 2007 08:07:55 +0000 Subject: [PATCH] doc work, especially ports in reference svn: r6795 --- collects/scribble/comment-reader.ss | 48 + collects/scribble/eval.ss | 5 +- collects/scribble/manual.ss | 13 +- collects/scribble/scheme.ss | 14 +- .../scribblings/reference/custodians.scrbl | 4 +- .../scribblings/reference/custom-ports.scrbl | 1035 +++++++++++++++++ collects/scribblings/reference/exns.scrbl | 2 +- .../scribblings/reference/file-ports.scrbl | 10 +- collects/scribblings/reference/pipes.scrbl | 10 +- .../reference/port-line-counting.scrbl | 95 ++ .../scribblings/reference/port-procs.scrbl | 6 + collects/scribblings/reference/ports.scrbl | 26 +- .../scribblings/reference/prop-port.scrbl | 35 + .../scribblings/reference/semaphores.scrbl | 2 +- .../scribblings/reference/string-ports.scrbl | 69 ++ collects/scribblings/reference/struct.scrbl | 8 +- 16 files changed, 1348 insertions(+), 34 deletions(-) create mode 100644 collects/scribble/comment-reader.ss create mode 100644 collects/scribblings/reference/custom-ports.scrbl create mode 100644 collects/scribblings/reference/port-line-counting.scrbl create mode 100644 collects/scribblings/reference/prop-port.scrbl create mode 100644 collects/scribblings/reference/string-ports.scrbl diff --git a/collects/scribble/comment-reader.ss b/collects/scribble/comment-reader.ss new file mode 100644 index 0000000000..c8a4c94a43 --- /dev/null +++ b/collects/scribble/comment-reader.ss @@ -0,0 +1,48 @@ + +(module comment-reader mzscheme + (require (lib "kw.ss")) + + (provide (rename *read read) + (rename *read-syntax read-syntax)) + + (define/kw (*read #:optional [inp (current-input-port)]) + (parameterize ([current-readtable (make-comment-readtable)]) + (read/recursive inp))) + + (define/kw (*read-syntax #:optional src [port (current-input-port)]) + (parameterize ([current-readtable (make-comment-readtable)]) + (read-syntax/recursive src port))) + + (define (make-comment-readtable) + (make-readtable (current-readtable) + #\; 'terminating-macro + (case-lambda + [(char port) + (do-comment port (lambda () (read/recursive port #\@)))] + [(char port src line col pos) + (let ([v (do-comment port (lambda () (read-syntax/recursive src port #\@)))]) + (let-values ([(eline ecol epos) (port-next-location port)]) + (datum->syntax-object + #f + v + (list src line col pos (and pos epos (- epos pos))))))]))) + + (define (do-comment port recur) + (let loop () + (when (equal? #\; (peek-char port)) + (read-char port) + (loop))) + `(code:comment + (unsyntax + (t + ,@(let loop () + (let ([c (read-char port)]) + (cond + [(or (eof-object? c) + (char=? c #\newline)) + null] + [(char=? c #\@) + (cons (recur) (loop))] + [else (cons (string c) + (loop))])))))))) + \ No newline at end of file diff --git a/collects/scribble/eval.ss b/collects/scribble/eval.ss index fb36237203..c041dd1e60 100644 --- a/collects/scribble/eval.ss +++ b/collects/scribble/eval.ss @@ -115,6 +115,8 @@ (syntax-case s (code:comment eval:alts) [(code:line v (code:comment . rest)) (do-eval #'v)] + [(code:comment . rest) + (list (list (void)) "" "")] [(eval:alts p e) (do-eval #'e)] [else @@ -214,13 +216,14 @@ (eval `(define eval-example-string ,eval-example-string))) (define-syntax schemeinput* - (syntax-rules (eval-example-string eval:alts) + (syntax-rules (eval-example-string eval:alts code:comment) [(_ (eval-example-string s)) (make-paragraph (list (hspace 2) (tt "> ") (span-class "schemevalue" (schemefont s))))] + [(_ (code:comment . rest)) (schemeblock (code:comment . rest))] [(_ (eval:alts a b)) (schemeinput* a)] [(_ e) (schemeinput e)])) diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index a1fa24838d..13e97d6380 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -241,10 +241,12 @@ (lambda () (list desc ...)))])) (define-syntax defstruct (syntax-rules () + [(_ name fields #:immutable #:inspector #f desc ...) + (*defstruct (quote-syntax name) 'name 'fields #t #t (lambda () (list desc ...)))] [(_ name fields #:immutable desc ...) - (*defstruct (quote-syntax name) 'name 'fields #t (lambda () (list desc ...)))] + (*defstruct (quote-syntax name) 'name 'fields #t #f (lambda () (list desc ...)))] [(_ name fields desc ...) - (*defstruct (quote-syntax name) 'name 'fields #f (lambda () (list desc ...)))])) + (*defstruct (quote-syntax name) 'name 'fields #f #f (lambda () (list desc ...)))])) (define-syntax (defform*/subs stx) (syntax-case stx () [(_ #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...) @@ -638,7 +640,7 @@ (map symbol->string (car wrappers))))))) (cdr wrappers)))) - (define (*defstruct stx-id name fields immutable? content-thunk) + (define (*defstruct stx-id name fields immutable? transparent? content-thunk) (define spacer (hspace 1)) (make-splice (cons @@ -670,7 +672,8 @@ (list 'set- name '- (car f) '!)) fields)))))) ,(map car fields) - ,@(if immutable? '(#:immutable) null)))))))) + ,@(if immutable? '(#:immutable) null) + ,@(if transparent? '(#:inspector #f) null)))))))) (map (lambda (v) (cond [(pair? v) @@ -904,7 +907,7 @@ (cond [(string? i) (cond - [(regexp-match #rx"^(.*)([()])(.*)$" i) + [(regexp-match #rx"^(.*)([()0-9])(.*)$" i) => (lambda (m) (append (loop (cadr m)) (list (caddr m)) diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss index 16dd478f7e..ac59fc5c39 100644 --- a/collects/scribble/scheme.ss +++ b/collects/scribble/scheme.ss @@ -183,6 +183,10 @@ (- (cdar m) (caar m)) (literalize-spaces (substring i (cdar m)))) i))) + (define (no-fancy-chars s) + (cond + [(eq? s 'rsquo) "'"] + [else s])) (define (loop init-line! quote-depth) (lambda (c) (cond @@ -194,11 +198,13 @@ (out "; " comment-color) (let ([v (syntax-object->datum (cadr (syntax->list c)))]) (if (paragraph? v) - (map (lambda (v) (if (string? v) - (out v comment-color) - (out v #f))) + (map (lambda (v) + (let ([v (no-fancy-chars v)]) + (if (string? v) + (out v comment-color) + (out v #f)))) (paragraph-content v)) - (out v comment-color)))] + (out (no-fancy-chars v) comment-color)))] [(and (pair? (syntax-e c)) (eq? (syntax-e (car (syntax-e c))) 'code:contract)) (advance c init-line!) diff --git a/collects/scribblings/reference/custodians.scrbl b/collects/scribblings/reference/custodians.scrbl index 88c088cb66..710baac19b 100644 --- a/collects/scribblings/reference/custodians.scrbl +++ b/collects/scribblings/reference/custodians.scrbl @@ -47,7 +47,7 @@ which is the main variant of PLT Scheme, and not normally available in PLT Scheme CGC.}} @defproc[(custodian-require-memory [limit-cust custodian?] - [need-amt non-negative-exact-integer?] + [need-amt nonnegative-exact-integer?] [stop-cust custodian?]) void?]{ Registers a require check if PLT Scheme is compiled with support for @@ -60,7 +60,7 @@ garbage collection (see @secref["mz:gc-model"]) where allocating tigger some shutdown, then @scheme[stop-cust] is shut down.} @defproc[(custodian-limit-memory [limit-cust custodian?] - [limit-amt non-negative-exact-integer?] + [limit-amt nonnegative-exact-integer?] [stop-cust custodian? limit-cust]) void?]{ Registers a limit check if PLT Scheme is compiled with support for diff --git a/collects/scribblings/reference/custom-ports.scrbl b/collects/scribblings/reference/custom-ports.scrbl new file mode 100644 index 0000000000..635244ae74 --- /dev/null +++ b/collects/scribblings/reference/custom-ports.scrbl @@ -0,0 +1,1035 @@ +#reader(lib "docreader.ss" "scribble") +@require["mz.ss"] + +@require[(lib "list.ss")] + +@title[#:tag "mz:customport"]{Custom Ports} + +The @scheme[make-input-port] and @scheme[make-output-port] procedures +create 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. + +@defproc[(make-input-port [name any/c] + [read-in (bytes? + . -> . (one-of/c nonnegative-exact-integer? + eof-object? + procedure? + evt?))] + [peek (bytes? nonnegative-exact-integer? (or/c evt? false/c) + . -> . (one-of/c nonnegative-exact-integer? + eof-object? + procedure? + evt? + false/c))] + [close (-> any)] + [get-progress-evt (or/c (-> evt?) false/c) #f] + [commit (or/c (positive-exact-integer? evt? evt? . -> . any) + false/c) + #f] + [get-location (or/c + (() + . ->* . + ((or/c positive-exact-integer? false/c) + (or/c nonnegative-exact-integer? false/c) + (or/c positive-exact-integer? false/c))) + false/c) + #f] + [count-lines! (-> any) void] + [init-position positive-exact-integer? 1] + [buffer-mode (or/c (case-> ((one-of/c 'block 'none) . -> . any) + (-> (one-of/c 'block 'none #f))) + false/c) + #f]) + input-port?]{ + +Creates an input port, which is immediately open for reading. If +@scheme[close] procedure has no side effects, then the port need not +be explicitly closed. + +The arguments implement the port as follows: + +@itemize{ + + @item{@scheme[name] --- the name for the input port.} + + @item{@scheme[read-in] --- a procedure that takes a single argument: + a mutable byte string to receive read bytes. The procedure's + result is one of the following: +% + @itemize{ + + @item{the number of bytes read, as an exact, non-negative integer;} + + @item{@scheme[eof];} + + @item{a procedure of arity four (representing a ``special'' + result, as discussed further below) and optionally of arity zero, + but a procedure result is allowed only when + @scheme[peek] is not @scheme[#f]; or} + + @item{a @tech{synchronizable event} (see @secref["mz:sync"]) + that becomes ready when the read is complete (roughly): the + event's value can one of the above three results or another + event like itself; in the last case, a reading process loops + with @scheme[sync] until it gets a non-event result.} + + } + + The @scheme[read-in] procedure must not block indefinitely. If no + bytes are immediately available for reading, the @scheme[read-in] + must return @scheme[0] or an event, and preferably an event (to + avoid busy waits). The @scheme[read-in] should not return + @scheme[0] (or an event whose value is @scheme[0]) when data is + available in the port, otherwise polling the port will behave + incorrectly. An event result from an event can also break polling. + + If the result of a @scheme[read-in] call is not one of the above + values, the @exnraise[exn:fail:contract]. If a returned integer is + larger than the supplied byte string's length, the + @exnraise[exn:fail:contract]. If @scheme[peek] is + @scheme[#f] and a procedure for a special result is returned, the + @exnraise[exn:fail:contract]. + + The @scheme[read-in] procedure can report an error by raising an + exception, but only if no bytes are read. Similarly, no bytes + should be read if @scheme[eof], an event, or a procedure is + returned. In other words, no bytes should be lost due to spurious + exceptions or non-byte data. + + A port's reading procedure may be called in multiple threads + simultaneously (if the port is accessible in multiple threads), + and the port is responsible for its own internal + synchronization. Note that improper implementation of such + synchronization mechanisms might cause a non-blocking read + procedure to block indefinitely. + + If @scheme[peek], @scheme[get-progress-evt], and + @scheme[commit] are all provided and + non-@scheme[#f], then the following is an acceptable implementation + of @scheme[read-in]: + +@schemeblock[ +(code:line + (lambda (bstr) + (let* ([progress-evt (get-progress-evt)] + [v (peek bstr 0 progress-evt)]) + (cond + [(sync/timeout 0 progress-evt) 0] (code:comment #,(t "try again")) + [(evt? v) (wrap-evt v (lambda (x) 0))] (code:comment #,(t "sync, try again")) + [(and (number? v) (zero? v)) 0] (code:comment #,(t "try again")) + [else + (if (commit (if (number? v) v 1) + progress-evt + always-evt) + v (code:comment #,(t "got a result")) + 0)]))) (code:comment #,(t "try again")) +)] + + An implementor may choose not to implement the @scheme[peek], + @scheme[get-progress-evt], and @scheme[commit] + procedures, however, and even an implementor who does supply + them may provide a different @scheme[read-in] + that uses a fast path for non-blocking reads.} + + + @item{@scheme[peek] --- either @scheme[#f] or a procedure + that takes three arguments: + + @itemize{ + + @item{a mutable byte string to receive peeked bytes;} + + @item{a non-negative number of bytes (or specials) to skip before + peeking; and} + + @item{either @scheme[#f] or a progress event produced by + @scheme[get-progress-evt].} + + } + + The results and conventions for @scheme[peek] are + mostly the same as for @scheme[read-in]. The main difference is in + the handling of the progress event, if it is not @scheme[#f]. If + the given progress event becomes ready, the + @scheme[peek] must abort any skip attempts and not peek + any values. In particular, @scheme[peek] must not peek + any values if the progress event is initially ready. + + Unlike @scheme[read-proc], @scheme[peek] should produce + @scheme[#f] (or an event whose value is @scheme[#f]) if no bytes + were peeked because the progress event became ready. Like + @scheme[read-in], a @scheme[0] result indicates that another + attempt is likely to succeed, so @scheme[0] is inappropriate when + the progress event is ready. Also like @scheme[read-in], + @scheme[peek] must not block indefinitely. + + The skip count provided to @scheme[peek] is a number of + bytes (or specials) that must remain present in the port---in + addition to the peek results---when the peek results are + reported. If a progress event is supplied, then the peek is + effectively canceled when another process reads data before the + given number can be skipped. If a progress event is not supplied + and data is read, then the peek must effectively restart with the + original skip count. + + The system does not check that multiple peeks return consistent + results, or that peeking and reading produce consistent results. + + If @scheme[peek] is @scheme[#f], then peeking for the + port is implemented automatically in terms of reads, but with + several limitations. First, the automatic implementation is not + thread-safe. Second, the automatic implementation cannot handle + special results (non-byte and non-eof), so @scheme[read-in] cannot + return a procedure for a special when @scheme[peek] is + @scheme[#f]. Finally, the automatic peek implementation is + incompatible with progress events, so if @scheme[peek] + is @scheme[#f], then @scheme[progress-evt] and + @scheme[commit] must be @scheme[#f]. See also + @scheme[make-input-port/peek-to-read].} + + @item{@scheme[close] --- a procedure of zero arguments that is + called to close the port. The port is not considered closed until + the closing procedure returns. The port's procedures will never be + used again via the port after it is closed. However, the closing + procedure can be called simultaneously in multiple threads (if the + port is accessible in multiple threads), and it may be called + during a call to the other procedures in another thread; in the + latter case, any outstanding reads and peeks should be terminated + with an error.} + + @item{@scheme[get-progress-evt] --- either @scheme[#f] (the + default), or a procedure that takes no arguments and returns an + event. The event must become ready only after data is next read + from the port or the port is closed. After the event becomes + ready, it must remain so. (See also @scheme[semaphore-peek-evt].) + + If @scheme[get-progress-evt] is @scheme[#f], then + @scheme[port-provides-progress-evts?] applied to the port will + produce @scheme[#f], and the port will not be a valid argument to + @scheme[port-progress-evt].} + + @item{@scheme[commit] --- either @scheme[#f] (the + default), or a procedure that takes three arguments: + + @itemize{ + + @item{an exact, positive integer @math{k_r};} + + @item{a progress event produced by @scheme[get-progress-evt];} + + @item{an event, @scheme[done], that is either a channel-put + event, channel, semaphore, semaphore-peek event, always + event, or never event.} + + } + + A @defterm{commit} corresponds to removing data from the stream + that was previously peeked, but only if no other process removed + data first. (The removed data does not need to be reported, + because it has been peeked already.) More precisely, assuming + that @math{k_p} bytes, specials, and mid-stream @scheme[eof]s have + been previously peeked or skipped at the start of the port's + stream, @scheme[commit] must satisfy the following + constraints: + + @itemize{ + + @item{It must return only when the commit is complete or when the + given progress event becomes ready.} + + @item{It must commit only if @math{k_p} is positive.} + + @item{If it commits, then it must do so with either @math{k_r} items + or @math{k_p} items, whichever is smaller, and only if @math{k_p} is + positive.} + + @item{It must never choose @scheme[done] in a synchronization + after the given progress event is ready, or after @scheme[done] + has been synchronized once.} + + @item{It must not treat any data as read from the port unless + @scheme[done] is chosen in a synchronization.} + + @item{It must not block indefinitely if @scheme[done] is ready; + it must return soon after the read completes or soon after the + given progress event is ready, whichever is first.} + + @item{It can report an error by raising an exception, but only if + no data is committed. In other words, no data should be lost due to + an exception, including a break exception.} + + @item{It must return a true value if data is committed, + @scheme[#f] otherwise. When it returns a value, the given + progress event must be ready (perhaps because data was just + committed).} + + @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 + given progress event to become ready.} + + } + + A call to @scheme[commit] is @scheme[parameterize-break]ed to + disable breaks.} + + @item{@scheme[get-location] --- either @scheme[#f] (the + default), or a procedure that takes no arguments and returns three + values: the line number for the next item in the port's stream (a + positive number or @scheme[#f]), the column number for the next + item in the port's stream (a non-negative number or @scheme[#f]), + and the position for the next item in the port's stream (a + positive number or @scheme[#f]). See also @secref["mz:linecol"]. + + This procedure is only called if line counting is enabled for the + port via @scheme[port-count-lines!] (in which case + @scheme[count-lines!] is called). The @scheme[read], + @scheme[read-syntax], @scheme[read-honu], and + @scheme[read-honu-syntax] procedures assume that reading a + non-whitespace character increments the column and position by + one.} + + @item{@scheme[count-lines!] --- a procedure of no arguments + that is called if and when line counting is enabled for the port. + The default procedure is @scheme[void].} + + @item{@scheme[init-position] --- an exact, positive integer that + determines the position of the port's first item, used when line + counting is @italic{not} enabled for the port. The default is + @scheme[1].} + + @item{@scheme[buffer-mode] --- either @scheme[#f] (the default) or a + procedure that accepts zero or one arguments. If + @scheme[buffer-mode] is @scheme[#f], then the resulting port does + not support a buffer-mode setting. Otherwise, the procedure is + called with one symbol argument (@scheme['block] or + @scheme['none]) to set the buffer mode, and it is called with zero + arguments to get the current buffer mode. In the latter case, the + result must be @scheme['block], @scheme['none], or @scheme[#f] + (unknown). See @secref["mz:port-buffers"] for more information on + buffer modes.} + + } + + When @scheme[read-in] or @scheme[peek] (or an event produced by one of + these) returns a procedure, and the procedure is used to obtain a + non-byte result. (This non-byte result is @italic{not} intended to + return a character or @scheme[eof]; in particular, @scheme[read-char] + raises an exception if it encounters a non-byte from a port.) The + procedure is called by @scheme[read], @scheme[read-syntax], + @scheme[read-honu], @scheme[read-honu-syntax], + @scheme[read-byte-or-special], @scheme[read-char-or-special], + @scheme[peek-byte-or-special], or @scheme[peek-char-or-special]---or, + more precisely, by the default port read handler (see + @secref["mz:portreadhandler"]). The special-value procedure can return + an arbitrary value, and it will be called zero or one times (not + necessarily before further reads or peeks from the port). See + @secref["mz:reader-procs"] for more details on the procedure's + arguments and result. + + If @scheme[read-in] or @scheme[peek] returns a special + procedure when called by any reading procedure other than + @scheme[read], @scheme[read-syntax], @scheme[read-honu], + @scheme[read-honu-syntax], @scheme[read-char-or-special], + @scheme[peek-char-or-special], @scheme[read-byte-or-special], or + @scheme[peek-byte-or-special], then the @exnraise[exn:fail:contract].} + +@begin[ +#reader(lib "comment-reader.ss" "scribble") +[examples +;; A port with no input... +;; Easy: @scheme[(open-input-bytes #"")] +;; Hard: +(define /dev/null-in + (make-input-port 'null + (lambda (s) eof) + (lambda (skip s progress-evt) eof) + void + (lambda () never-evt) + (lambda (k progress-evt done-evt) + (error "no successful peeks!")))) +(read-char /dev/null-in) +(peek-char /dev/null-in) +(read-byte-or-special /dev/null-in) +(peek-byte-or-special /dev/null-in 100) + +;; A port that produces a stream of 1s: +(define infinite-ones + (make-input-port + 'ones + (lambda (s) + (bytes-set! s 0 (char->integer #\1)) 1) + #f + void)) +(read-string 5 infinite-ones) + +;; But we can't peek ahead arbitrarily far, because the +;; automatic peek must record the skipped bytes, so +;; we'd run out of memory. + +;; An infinite stream of 1s with a specific peek procedure: +(define infinite-ones + (let ([one! (lambda (s) + (bytes-set! s 0 (char->integer #\1)) 1)]) + (make-input-port + 'ones + one! + (lambda (s skip progress-evt) (one! s)) + void))) +(read-string 5 infinite-ones) + +;; Now we can peek ahead arbitrarily far: +(peek-string 5 (expt 2 5000) infinite-ones) + +;; The port doesn't supply procedures to implement progress events: +(port-provides-progress-evts? infinite-ones) +(port-progress-evt infinite-ones) + +;; Non-byte port results: +(define infinite-voids + (make-input-port + 'voids + (lambda (s) (lambda args 'void)) + (lambda (skip s evt) (lambda args 'void)) + void)) +(read-char infinite-voids) +(read-char-or-special infinite-voids) + +;; This port produces 0, 1, 2, 0, 1, 2, etc., but it is not +;; thread-safe, because multiple threads might read and change @scheme[n]. +(define mod3-cycle/one-thread + (let* ([n 2] + [mod! (lambda (s delta) + (bytes-set! s 0 (+ 48 (modulo (+ n delta) 3))) + 1)]) + (make-input-port + 'mod3-cycle/not-thread-safe + (lambda (s) + (set! n (modulo (add1 n) 3)) + (mod! s 0)) + (lambda (s skip evt) + (mod! s skip)) + void))) +(read-string 5 mod3-cycle/one-thread) +(peek-string 5 (expt 2 5000) mod3-cycle/one-thread) + +;; Same thing, but thread-safe and kill-safe, and with progress +;; events. Only the server thread touches the stateful part +;; directly. (See the output port examples for a simpler thread-safe +;; example, but this one is more general.) +(define (make-mod3-cycle) + (define read-req-ch (make-channel)) + (define peek-req-ch (make-channel)) + (define progress-req-ch (make-channel)) + (define commit-req-ch (make-channel)) + (define close-req-ch (make-channel)) + (define closed? #f) + (define n 0) + (define progress-sema #f) + (define (mod! s delta) + (bytes-set! s 0 (+ 48 (modulo (+ n delta) 3))) + 1) + ;; ---------------------------------------- + ;; The server has a list of outstanding commit requests, + ;; and it also must service each port operation (read, + ;; progress-evt, etc.) + (define (serve commit-reqs response-evts) + (apply + sync + (handle-evt read-req-ch + (handle-read commit-reqs response-evts)) + (handle-evt progress-req-ch + (handle-progress commit-reqs response-evts)) + (handle-evt commit-req-ch + (add-commit commit-reqs response-evts)) + (handle-evt close-req-ch + (handle-close commit-reqs response-evts)) + (append + (map (make-handle-response commit-reqs response-evts) + response-evts) + (map (make-handle-commit commit-reqs response-evts) + commit-reqs)))) + ;; Read/peek request: fill in the string and commit + (define ((handle-read commit-reqs response-evts) r) + (let ([s (car r)] + [skip (cadr r)] + [ch (caddr r)] + [nack (cadddr r)] + [evt (car (cddddr r))] + [peek? (cdr (cddddr r))]) + (let ([fail? (and evt + (sync/timeout 0 evt))]) + (unless (or closed? fail?) + (mod! s skip) + (unless peek? + (commit! 1))) + ;; Add an event to respond: + (serve commit-reqs + (cons (choice-evt + nack + (channel-put-evt ch (if closed? + 0 + (if fail? #f 1)))) + response-evts))))) + ;; Progress request: send a peek evt for the current + ;; progress-sema + (define ((handle-progress commit-reqs response-evts) r) + (let ([ch (car r)] + [nack (cdr r)]) + (unless progress-sema + (set! progress-sema (make-semaphore (if closed? 1 0)))) + ;; Add an event to respond: + (serve commit-reqs + (cons (choice-evt + nack + (channel-put-evt + ch + (semaphore-peek-evt progress-sema))) + response-evts)))) + ;; Commit request: add the request to the list + (define ((add-commit commit-reqs response-evts) r) + (serve (cons r commit-reqs) response-evts)) + ;; Commit handling: watch out for progress, in which case + ;; the response is a commit failure; otherwise, try + ;; to sync for a commit. In either event, remove the + ;; request from the list + (define ((make-handle-commit commit-reqs response-evts) r) + (let ([k (car r)] + [progress-evt (cadr r)] + [done-evt (caddr r)] + [ch (cadddr r)] + [nack (cddddr r)]) + ;; Note: we don't check that k is $\leq$ the sum of + ;; previous peeks, because the entire stream is actually + ;; known, but we could send an exception in that case. + (choice-evt + (handle-evt progress-evt + (lambda (x) + (sync nack (channel-put-evt ch #f)) + (serve (remq r commit-reqs) response-evts))) + ;; Only create an event to satisfy done-evt if progress-evt + ;; isn't already ready. + ;; Afterward, if progress-evt becomes ready, then this + ;; event-making function will be called again, because + ;; the server controls all posts to progress-evt. + (if (sync/timeout 0 progress-evt) + never-evt + (handle-evt done-evt + (lambda (v) + (commit! k) + (sync nack (channel-put-evt ch #t)) + (serve (remq r commit-reqs) + response-evts))))))) + ;; Response handling: as soon as the respondee listens, + ;; remove the response + (define ((make-handle-response commit-reqs response-evts) evt) + (handle-evt evt + (lambda (x) + (serve commit-reqs + (remq evt response-evts))))) + ;; Close handling: post the progress sema, if any, and set + ;; the @scheme[closed?] flag + (define ((handle-close commit-reqs response-evts) r) + (let ([ch (car r)] + [nack (cdr r)]) + (set! closed? #t) + (when progress-sema + (semaphore-post progress-sema)) + (serve commit-reqs + (cons (choice-evt nack + (channel-put-evt ch (void))) + response-evts)))) + ;; Helper for reads and post-peek commits: + (define (commit! k) + (when progress-sema + (semaphore-post progress-sema) + (set! progress-sema #f)) + (set! n (+ n k))) + ;; Start the server thread: + (define server-thread (thread (lambda () (serve null null)))) + ;; ---------------------------------------- + ;; Client-side helpers: + (define (req-evt f) + (nack-guard-evt + (lambda (nack) + ;; Be sure that the server thread is running: + (thread-resume server-thread (current-thread)) + ;; Create a channel to hold the reply: + (let ([ch (make-channel)]) + (f ch nack) + ch)))) + (define (read-or-peek-evt s skip evt peek?) + (req-evt (lambda (ch nack) + (channel-put read-req-ch + (list* s skip ch nack evt peek?))))) + ;; Make the port: + (make-input-port 'mod3-cycle + ;; Each handler for the port just sends + ;; a request to the server + (lambda (s) (read-or-peek-evt s 0 #f #f)) + (lambda (s skip evt) + (read-or-peek-evt s skip evt #t)) + (lambda () ; close + (sync (req-evt + (lambda (ch nack) + (channel-put progress-req-ch + (list* ch nack)))))) + (lambda () ; progress-evt + (sync (req-evt + (lambda (ch nack) + (channel-put progress-req-ch + (list* ch nack)))))) + (lambda (k progress-evt done-evt) ; commit + (sync (req-evt + (lambda (ch nack) + (channel-put + commit-req-ch + (list* k progress-evt done-evt ch + nack)))))))) + +(define mod3-cycle (make-mod3-cycle)) +(let ([result1 #f] + [result2 #f]) + (let ([t1 (thread + (lambda () + (set! result1 (read-string 5 mod3-cycle))))] + [t2 (thread + (lambda () + (set! result2 (read-string 5 mod3-cycle))))]) + (thread-wait t1) + (thread-wait t2) + (string-append result1 "," result2))) + +(define s (make-bytes 1)) +(define progress-evt (port-progress-evt mod3-cycle)) +(peek-bytes-avail! s 0 progress-evt mod3-cycle) +s +(port-commit-peeked 1 progress-evt (make-semaphore 1) + mod3-cycle) +(sync/timeout 0 progress-evt) +(peek-bytes-avail! s 0 progress-evt mod3-cycle) +(port-commit-peeked 1 progress-evt (make-semaphore 1) + mod3-cycle) +(close-input-port mod3-cycle) +]] + +@;------------------------------------------------------------------------ +@;------------------------------------------------------------------------ + +@defproc[(make-output-port [name any/c] + [evt evt?] + [write-out (bytes? nonnegative-exact-integer? + nonnegative-exact-integer? + boolean? + boolean? + . -> . + (or/c nonnegative-exact-integer? + false/c + evt?))] + [close (-> any)] + [write-out-special (or/c (any/c boolean? boolean? + . -> . + (or/c any/c + #f + evt?)) + false/c) + #f] + [get-write-evt (or/c + (bytes? nonnegative-exact-integer? + nonnegative-exact-integer? + . -> . + evt?) + false/c) + #f] + [get-write-special-evt (or/c + (any/c . -> . evt?) + false/c) + #f] + [get-location (or/c + (() + . ->* . + ((or/c positive-exact-integer? false/c) + (or/c nonnegative-exact-integer? false/c) + (or/c positive-exact-integer? false/c))) + false/c) + #f] + [count-lines! (-> any) void] + [init-position positive-exact-integer? 1] + [buffer-mode (or/c (case-> + ((one-of/c 'block 'line 'none) . -> . any) + (-> (one-of/c 'block 'line 'none #f))) + false/c)]) + output-port?]{ + +Creates an output port, which is immediately open for +writing. If @scheme[close] procedure has no side effects, then +the port need not be explicitly closed. The port can buffer data +within its @scheme[write-out] and @scheme[write-out-special] +procedures. + + @itemize{ + + @item{@scheme[name] --- the name for the output port.} + + @item{@scheme[evt] --- a synchronization event (see @secref["mz:sync"]; + e.g., a semaphore or another port). The event is used in place of + the output port when the port is supplied to synchronization + procedures like @scheme[sync]. Thus, the event should be + unblocked when the port is ready for writing at least one byte + without blocking, or ready to make progress in flushing an + internal buffer without blocking. The event must not unblock + unless the port is ready for writing; otherwise, the guarantees of + @scheme[sync] will be broken for the output port. Use + @scheme[always-evt] if writes to the port always succeed without + blocking.} + + @item{@scheme[write-out] --- a procedure of five arguments: + + @itemize{ + + @item{an immutable byte string containing bytes to write;} + + @item{a non-negative exact integer for a starting offset + (inclusive) into the byte string;} + + @item{a non-negative exact integer for an ending offset + (exclusive) into the byte string;} + + @item{a boolean; @scheme[#f] indicates that the port is allowed + to keep the written bytes in a buffer, and that it is + allowed to block indefinitely; @scheme[#t] indicates that the + write should not block, and that the port should attempt to flush + its buffer and completely write new bytes instead of + buffering them;} + + @item{a boolean; @scheme[#t] indicates that if the port blocks + for a write, then it should enable breaks while blocking (e.g., + using @scheme[sync/enable-break]; this argument is always + @scheme[#f] if the fourth argument is @scheme[#t].} + + } + + The procedure returns one of the following: + + @itemize{ + + @item{a non-negative exact integer representing the number of + bytes written or buffered;} + + @item{@scheme[#f] if no bytes could be written, perhaps because + the internal buffer could not be completely flushed;} + + @item{a synchronizable event (see @secref["mz:sync"]) that acts like + the result of @scheme[write-bytes-avail-evt] to complete the + write.} + + } + + Since @scheme[write-out] can produce an event, an acceptable + implementation of @scheme[write-out] is to pass its first three + arguments to the port's @scheme[get-write-evt]. Some port + implementors, however, may choose not to provide + @scheme[get-write-evt] (perhaps because writes cannot be + made atomic), or may implement @scheme[write-proc] to + enable a fast path for non-blocking writes or to + enable buffering. + + From a user's perspective, the difference between buffered and + completely written data is (1) buffered data can be lost in the + future due to a failed write, and (2) @scheme[flush-output] forces + all buffered data to be completely written. Under no circumstances + is buffering required. + + If the start and end indices are the same, then the fourth + argument to @scheme[write-out] will be @scheme[#f], and the write + request is actually a flush request for the port's buffer (if + any), and the result should be @scheme[0] for a successful flush + (or if there is no buffer). + + The result should never be @scheme[0] if the start and end indices + are different, otherwise the @exnraise[exn:fail:contract]. + If a returned integer is larger than the supplied byte-string + range, the @exnraise[exn:fail:contract]. + + The @scheme[#f] result should be avoided, unless the next write + attempt is likely to work. Otherwise, if data cannot be written, + return an event instead. + + An event returned by @scheme[write-out] can return @scheme[#f] or + another event like itself, in contrast to events produced by + @scheme[write-bytes-avail-evt] or @scheme[get-write-evt]. + A writing process loops with @scheme[sync] until it obtains a + non-event result. + + The @scheme[write-out] procedure is always called with breaks + disabled, independent of whether breaks were enabled when the write + was requested by a client of the port. If breaks were enabled for + a blocking operation, then the fifth argument to @scheme[write-out] + will be @scheme[#t], which indicates that @scheme[write-out] should + re-enable breaks while blocking. + + If the writing procedure raises an exception, due either to write + or commit operations, it must not have committed any bytes + (though it may have committed previously buffered bytes). + + A port's writing procedure may be called in multiple threads + simultaneously (if the port is accessible in multiple + threads). The port is responsible for its own internal + synchronization. Note that improper implementation of such + synchronization mechanisms might cause a non-blocking write + procedure to block.} + + @item{@scheme[close] --- a procedure of zero arguments that is + called to close the port. The port is not considered closed until + the closing procedure returns. The port's procedures will never be + used again via the port after it is closed. However, the closing + procedure can be called simultaneously in multiple threads (if the + port is accessible in multiple threads), and it may be called + during a call to the other procedures in another thread; in the + latter case, any outstanding writes or flushes should be + terminated immediately with an error.} + + @item{@scheme[write-out-special] --- either @scheme[#f] (the + default), or a procedure to handle @scheme[write-special] calls + for the port. If @scheme[#f], then the port does not support + special output, and @scheme[port-writes-special?] will return + @scheme[#f] when applied to the port. + + If a procedure is supplied, it takes three arguments: the special + value to write, a boolean that is @scheme[#f] if the procedure can + buffer the special value and block indefinitely, and a boolean + that is @scheme[#t] if the procedure should enable breaks while + blocking. The result is one of the following: + + @itemize{ + + @item{a non-event true value, which indicates that the special is + written;} + + @item{@scheme[#f] if the special could not be written, perhaps + because an internal buffer could not be completely flushed;} + + @item{a synchronizable event (see @secref["mz:sync"]) that acts like + the result of @scheme[get-write-special-evt] to complete the write.} + + } + + Since @scheme[write-out-special] can return an event, + passing the first argument to an implementation of + @scheme[get-write-special-evt] is acceptable as an + @scheme[write-out-special]. + + As for @scheme[write-out], the @scheme[#f] result is discouraged, + since it can lead to busy waiting. Also as for @scheme[write-out], + an event produced by @scheme[write-out-special] is allowed + to produce @scheme[#f] or another event like itself. The + @scheme[write-out-special] procedure is always called with + breaks disabled, independent of whether breaks were enabled when + the write was requested by a client of the port.} + + @item{@scheme[get-write-evt] --- either @scheme[#f] (the + default) or a procedure of three arguments: + + @itemize{ + + @item{an immutable byte string containing bytes to write;} + + @item{a non-negative exact integer for a starting offset + (inclusive) into the byte string, and} + + @item{a non-negative exact integer for an ending offset + (exclusive) into the byte string.} + + } + + The result is a synchronizable event (see @secref["mz:sync"]) to act as + the result of @scheme[write-bytes-avail-evt] for the port (i.e., + to complete a write or flush), which becomes available only as + data is committed to the port's underlying device, and whose + result is the number of bytes written. + + If @scheme[get-write-evt] is @scheme[#f], then + @scheme[port-writes-atomic?] will produce @scheme[#f] with applied + to the port, and the port will not be a valid argument to + procedures such as @scheme[write-bytes-avail-evt]. + + Otherwise, an event returned by @scheme[get-write-evt] must + not cause data to be written to the port unless the event is + chosen in a synchronization, and it must write to the port if the + event is chosen (i.e., the write must appear atomic with respect + to the synchronization). + + If the event's result integer is larger than the supplied + byte-string range, the @exnraise[exn:fail:contract] by a wrapper + on the event. If the start and end indices are the same (i.e., no + bytes are to be written), then the event should produce @scheme[0] + when the buffer is completely flushed. (If the port has no buffer, + then it is effectively always flushed.) + + If the event raises an exception, due either to write or commit + operations, it must not have committed any new bytes (though it + may have committed previously buffered bytes). + + Naturally, a port's events may be used in multiple threads + simultaneously (if the port is accessible in multiple + threads). The port is responsible for its own internal + synchronization.} + + @item{@scheme[get-write-special-evt] --- either @scheme[#f] + (the default), or a procedure to handle @scheme[write-special-evt] + calls for the port. This argument must be @scheme[#f] if either + @scheme[write-out-special] or @scheme[get-write-evt] + is @scheme[#f], and it must be a procedure if both of those + arguments are procedures. + + If it is a procedure, it takes one argument: the special value to + write. The resulting event (with its constraints) is analogous to + the result of @scheme[get-write-evt]. + + If the event raises an exception, due either to write or commit + operations, it must not have committed the special value (though + it may have committed previously buffered bytes and values).} + + + + @item{@scheme[get-location] --- either @scheme[#f] (the + default), or a procedure that takes no arguments and returns three + values: the line number for the next item written to the port's + stream (a positive number or @scheme[#f]), the column number for + the next item written to port's stream (a non-negative number or + @scheme[#f]), and the position for the next item written to port's + stream (a positive number or @scheme[#f]). See also + @secref["mz:linecol"]. + + This procedure is only called if line counting is enabled for the + port via @scheme[port-count-lines!] (in which case + @scheme[count-lines!] is called).} + + @item{@scheme[count-lines!] --- a procedure of no arguments + that is called if and when line counting is enabled for the port. + The default procedure is @scheme[void].} + + @item{@scheme[init-position] --- an exact, positive integer that + determines the position of the port's first output item, used when + line counting is @italic{not} enabled for the port. The default is + @scheme[1].} + + @item{@scheme[buffer-mode] --- either @scheme[#f] (the + default) or a procedure that accepts zero or one arguments. If + @scheme[buffer-mode] is @scheme[#f], then the resulting + port does not support a buffer-mode setting. Otherwise, the + procedure is called with one symbol argument (@scheme['block], + @scheme['line], or @scheme['none]) to set the buffer mode, and it is + called with zero arguments to get the current buffer mode. In the + latter case, the result must be @scheme['block], @scheme['line], + @scheme['none], or @scheme[#f] (unknown). See @secref["mz:port-buffers"] + for more information on buffer modes.} + + } +} + +@begin[ +#reader(lib "comment-reader.ss" "scribble") +[examples +;; A port that writes anything to nowhere: +(define /dev/null-out + (make-output-port + 'null + always-evt + (lambda (s start end non-block? breakable?) (- end start)) + void + (lambda (special non-block? breakable?) #t) + (lambda (s start end) (wrap-evt + always-evt + (lambda (x) + (- end start)))) + (lambda (special) always-evt))) +(display "hello" /dev/null-out) +(write-bytes-avail #"hello" /dev/null-out) +(write-special 'hello /dev/null-out) +(sync (write-bytes-avail-evt #"hello" /dev/null-out)) + +;; A part that accumulates bytes as characters in a list, +;; but not in a thread-safe way: +(define accum-list null) +(define accumulator/not-thread-safe + (make-output-port + 'accum/not-thread-safe + always-evt + (lambda (s start end non-block? breakable?) + (set! accum-list + (append accum-list + (map integer->char + (bytes->list (subbytes s start end))))) + (- end start)) + void)) +(display "hello" accumulator/not-thread-safe) +accum-list + +;; Same as before, but with simple thread-safety: +(define accum-list null) +(define accumulator + (let* ([lock (make-semaphore 1)] + [lock-peek-evt (semaphore-peek-evt lock)]) + (make-output-port + 'accum + lock-peek-evt + (lambda (s start end non-block? breakable?) + (if (semaphore-try-wait? lock) + (begin + (set! accum-list + (append accum-list + (map integer->char + (bytes->list + (subbytes s start end))))) + (semaphore-post lock) + (- end start)) + ;; Cheap strategy: block until the list is unlocked, + ;; then return 0, so we get called again + (wrap-evt + lock-peek + (lambda (x) 0)))) + void))) +(display "hello" accumulator) +accum-list + +;; A port that transforms data before sending it on +;; to another port. Atomic writes exploit the +;; underlying port's ability for atomic writes. +(define (make-latin-1-capitalize port) + (define (byte-upcase s start end) + (list->bytes + (map (lambda (b) (char->integer + (char-upcase + (integer->char b)))) + (bytes->list (subbytes s start end))))) + (make-output-port + 'byte-upcase + ;; This port is ready when the original is ready: + port + ;; Writing procedure: + (lambda (s start end non-block? breakable?) + (let ([s (byte-upcase s start end)]) + (if non-block? + (write-bytes-avail* s port) + (begin + (display s port) + (bytes-length s))))) + ;; Close procedure --- close original port: + (lambda () (close-output-port port)) + #f + ;; Write event: + (and (port-writes-atomic? port) + (lambda (s start end) + (write-bytes-avail-evt + (byte-upcase s start end) + port))))) +(define orig-port (open-output-string)) +(define cap-port (make-latin-1-capitalize orig-port)) +(display "Hello" cap-port) +(get-output-string orig-port) +(sync (write-bytes-avail-evt #"Bye" cap-port)) +(get-output-string orig-port) +]] diff --git a/collects/scribblings/reference/exns.scrbl b/collects/scribblings/reference/exns.scrbl index a35aeec46c..86dc22b910 100644 --- a/collects/scribblings/reference/exns.scrbl +++ b/collects/scribblings/reference/exns.scrbl @@ -83,7 +83,7 @@ for end users.} @defproc*[([(raise-type-error [name symbol?][expected string?][v any/c]) any] - [(raise-type-error [name symbol?][expected string?][bad-pos non-negative-exact-integer?][v any/c]) any])]{ + [(raise-type-error [name symbol?][expected string?][bad-pos nonnegative-exact-integer?][v any/c]) any])]{ Creates an @scheme[exn:fail:contract] value and @scheme[raise]s it as an exception. The @scheme[name] argument is used as the source diff --git a/collects/scribblings/reference/file-ports.scrbl b/collects/scribblings/reference/file-ports.scrbl index 461fafea2b..39be321964 100644 --- a/collects/scribblings/reference/file-ports.scrbl +++ b/collects/scribblings/reference/file-ports.scrbl @@ -56,7 +56,10 @@ closed, either though @scheme[close-input-port] or indirectly via handle. The input port will not closed automatically if it is otherwise available for garbage collection (see @secref["mz:gc-model"]); a @tech{will} could be associated input port -to close it more automatically (see @secref["mz:wills"]). } +to close it more automatically (see @secref["mz:wills"]). + +A @tech{path} value that is the expanded version of @scheme[path] is +used as the name of the opened port.} @defproc[(open-output-file [path path-string?] [#:mode mode-flag (one-of/c 'binary 'text) 'binary] @@ -119,7 +122,10 @@ closed, either though @scheme[close-output-port] or indirectly via handle. The output port will not closed automatically if it is otherwise available for garbage collection (see @secref["mz:gc-model"]); a @tech{will} could be associated input port -to close it more automatically (see @secref["mz:wills"]).} +to close it more automatically (see @secref["mz:wills"]). + +A @tech{path} value that is the expanded version of @scheme[path] is +used as the name of the opened port.} @defproc[(open-input-output-file [path path-string?] [#:mode mode-flag (one-of/c 'binary 'text) 'binary] diff --git a/collects/scribblings/reference/pipes.scrbl b/collects/scribblings/reference/pipes.scrbl index 3532457642..2dde5f1800 100644 --- a/collects/scribblings/reference/pipes.scrbl +++ b/collects/scribblings/reference/pipes.scrbl @@ -8,8 +8,8 @@ OS-level pipes (which are @tech{file-stream ports}) for communicating between different processes. @defproc[(make-pipe [limit positive-exact-integer? #f] - [input-name-v any/c #f] - [output-name-v any/c #f]) + [input-name any/c 'pipe] + [output-name any/c 'pipe]) any]{ Returns two port values: the first port is an input port and the @@ -25,10 +25,8 @@ pipe's output port thereafter will block until a read or peek from the input port makes more space available. (Peeks effectively extend the port's capacity until the peeked bytes are read.) -The optional @scheme[input-name-v] and @scheme[output-name-v] are used -as the names for the returned input and out ports, respectively, if -they are supplied. (See also @scheme[object-name].) Otherwise, the -name of each port is @scheme['pipe].} +The optional @scheme[input-name] and @scheme[output-name] are used +as the names for the returned input and out ports, respectively.} @defproc[(pipe-content-length [pipe-port port?]) any]{ diff --git a/collects/scribblings/reference/port-line-counting.scrbl b/collects/scribblings/reference/port-line-counting.scrbl new file mode 100644 index 0000000000..d05d4d607b --- /dev/null +++ b/collects/scribblings/reference/port-line-counting.scrbl @@ -0,0 +1,95 @@ +#reader(lib "docreader.ss" "scribble") +@require["mz.ss"] + +@title[#:tag "mz:linecol"]{Counting Positions, Lines, and Columns} + +@index['("line numbers")]{ +@index['("column numbers")]{ +@index['("port positions")]{ +By}}} default, Scheme keeps track of the @deftech{position} in a port as the +number of bytes that have been read from or written to any port +(independent of the read/write position, which is accessed or changed +with @scheme[file-position]). Optionally, however, Scheme can track +the position in terms of characters (after UTF-8 decoding), instead of +bytes, and it can track @deftech{line locations} and @deftech{column +locations}; this optional tracking must be specifically enabled for a +port via @scheme[port-count-lines!] or the +@scheme[port-count-lines-enabled] parameter. Position, line, and +column locations for a port are used by @scheme[read-syntax] and +@scheme[read-honu-syntax]. Position and line locations are numbered +from @math{1}; column locations are numbered from @math{0}. + +When counting lines, Scheme treats linefeed, return, and +return-linefeed combinations as a line terminator and as a single +position (on all platforms). Each tab advances the column count to one +before the next multiple of @math{8}. When a sequence of bytes in the +range 128 to 253 forms a UTF-8 encoding of a character, the +position/column is incremented is incremented once for each byte, and +then decremented appropriately when a complete encoding sequence is +discovered. See also @secref["mz:ports"] for more information on UTF-8 +decoding for ports. + +A position is known for any port as long as its value can be expressed +as a fixnum (which is more than enough tracking for realistic +applications in, say, syntax-error reporting). If the position for a +port exceeds the value of the largest fixnum, then the position for +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. + +Certain kinds of exceptions (see @secref["mz:exns"]) encapsulate + source-location information using a @scheme[srcloc] structure. + +@;------------------------------------------------------------------------ + +@defproc[(port-count-lines! [port port?]) void?]{ + +Turns on line and column counting for a port. Counting can be turned +on at any time, though generally it is turned on before any data is +read from or written to a port. When a port is created, if the value +of the @scheme[port-count-lines-enabled] parameter is true, then line +counting is automatically enabled for the port. Line counting cannot +be disabled for a port after it is enabled.} + +@defproc[(port-next-location [port port?]) + (values (or/c positive-exact-integer? false/c) + (or/c nonnegative-exact-integer? false/c) + (or/c positive-exact-integer? false/c))]{ + +Returns three values: an integer or @scheme[#f] for the line number of +the next read/written item, an integer or @scheme[#f] for the next +item's column, and an integer or @scheme[#f] for the next item's +position. The next column and position normally increases as bytes are +read from or written to the port, but if line/character counting is +enabled for @scheme[port], the column and position results can +decrease after reading or writing a byte that ends a UTF-8 encoding +sequence.} + +@defstruct[srcloc ([source any/c] + [line (or/c positive-exact-integer? false/c)] + [column (or/c nonnegative-exact-integer? false/c)] + [position (or/c positive-exact-integer? false/c)] + [span (or/c nonnegative-exact-integer? false/c)]) + #:immutable + #:inspector #f]{ + +The fields of an @scheme[srcloc] instance are as follows: + +@itemize{ + + @item{@scheme[source] --- An arbitrary value identifying the source, + often a path (see @secref["mz:pathutils"]).} + + @item{@scheme[line] --- The line number (counts from 1) or + @scheme[#f] (unknown).} + + @item{@scheme[column] --- The column number (counts from 0) or + @scheme[#f] (unknown).} + + @item{@scheme[position] --- The starting position (counts from 1) or + @scheme[#f] (unknown).} + + @item{@scheme[span] --- The number of covered positions (counts from + 0) or @scheme[#f] (unknown).} + +}} diff --git a/collects/scribblings/reference/port-procs.scrbl b/collects/scribblings/reference/port-procs.scrbl index 00b49e1ecf..7b55ffd6c8 100644 --- a/collects/scribblings/reference/port-procs.scrbl +++ b/collects/scribblings/reference/port-procs.scrbl @@ -49,3 +49,9 @@ Returns @scheme[#t] if the given port is a file-stream port (see @defproc[(terminal-port? [port port?]) boolean?]{ Returns @scheme[#t] if the given port is attached to an interactive terminal, @scheme[#f] otherwise.} + +@defthing[eof eof-object?]{A value (distinct from all other values) +that represents an end-of-file.} + +@defproc[(eof-object [a any/c]) boolean?]{Returns @scheme[#t] is +@scheme[v] is @scheme[eof], @scheme[#f] otherwise.} diff --git a/collects/scribblings/reference/ports.scrbl b/collects/scribblings/reference/ports.scrbl index f7bb38bda2..ce9d4d5daa 100644 --- a/collects/scribblings/reference/ports.scrbl +++ b/collects/scribblings/reference/ports.scrbl @@ -33,19 +33,29 @@ conversions using UTF-8 or other encodings. See also obtaining a UTF-8-based port from one that uses a different encoding of characters. -The global variable @scheme[eof] is bound to the end-of-file -value. The standard predicate @scheme[eof-object?] returns @scheme[#t] -only when applied to this value. Reading from a port produces an -end-of-file result when the port has no more data, but some ports may -also return end-of-file mid-stream. For example, a port connected to a -Unix terminal returns an end-of-file when the user types control-D; if -the user provides more input, the port returns additional bytes after -the end-of-file. +The global variable @scheme[eof] is bound to the end-of-file value, +and @scheme[eof-object?] returns @scheme[#t] only when applied to this +value. Reading from a port produces an end-of-file result when the +port has no more data, but some ports may also return end-of-file +mid-stream. For example, a port connected to a Unix terminal returns +an end-of-file when the user types control-D; if the user provides +more input, the port returns additional bytes after the end-of-file. + +Every port has a name, as reported by @scheme[object-name]. The name +can be any value, and it is used mostly for error-reporting +purposes. The @scheme[read-syntax] procedure uses the name of an input +port as the default source location for the @tech{syntax objects} that +it produces. @;------------------------------------------------------------------------ @local-table-of-contents[] @include-section["port-procs.scrbl"] +@include-section["port-buffers.scrbl"] +@include-section["port-line-counting.scrbl"] @include-section["file-ports.scrbl"] +@include-section["string-ports.scrbl"] @include-section["pipes.scrbl"] +@include-section["prop-port.scrbl"] +@include-section["custom-ports.scrbl"] diff --git a/collects/scribblings/reference/prop-port.scrbl b/collects/scribblings/reference/prop-port.scrbl new file mode 100644 index 0000000000..c4c39c79c9 --- /dev/null +++ b/collects/scribblings/reference/prop-port.scrbl @@ -0,0 +1,35 @@ +#reader(lib "docreader.ss" "scribble") +@require["mz.ss"] + +@title[#:tag "mz:portstructs"]{Structures as Ports} + +@defthing[prop:input-port struct-type-property?] +@defthing[prop:output-port struct-type-property?] + +The @scheme[prop:input-port] and @scheme[prop:output-port] structure type +properties identify structure types whose instances can serve as input +and output ports, respectively. + +Each property value can be either of the following: + +@itemize{ + + @item{An input port (for @scheme[prop:input-port]) or output port + (for @scheme[prop:input-port]): In this case, using the structure + as port is equivalent to using the given one.} + + @item{An exact, non-negative integer between @scheme[0] (inclusive) and + number of non-automatic fields in the structure type (exclusive, not + counting supertype fields): The integer identifies a field in + the structure, and the field must be designated as immutable. If the + field contains an input port (for @scheme[prop:input-port]) or + output port (for @scheme[prop:input-port]), the port is used. + Otherwise, an empty string input port is used for @scheme[prop:input-port], + and a port that discards all data is used for @scheme[prop:output-port].} + +} + +Some procedures, such as @scheme[file-position], work on both input +and output ports. When given an instance of a structure type with both +the @scheme[prop:input-port] and @scheme[prop:output-port] properties, +the instance is used as an input port. diff --git a/collects/scribblings/reference/semaphores.scrbl b/collects/scribblings/reference/semaphores.scrbl index 96c94a1135..9ffec911c8 100644 --- a/collects/scribblings/reference/semaphores.scrbl +++ b/collects/scribblings/reference/semaphores.scrbl @@ -20,7 +20,7 @@ thread is eventually unblocked. In addition to its use with semaphore-specific procedures, semaphores can be used as events; see @secref["mz:sync"]. -@defproc[(make-semaphore [init non-negative-exact-integer? 0]) semaphore?]{ +@defproc[(make-semaphore [init nonnegative-exact-integer? 0]) semaphore?]{ Creates and returns a new semaphore with the counter initially set to @scheme[init]. If @scheme[init-k] is larger than a semaphore's maximum diff --git a/collects/scribblings/reference/string-ports.scrbl b/collects/scribblings/reference/string-ports.scrbl new file mode 100644 index 0000000000..25c9530782 --- /dev/null +++ b/collects/scribblings/reference/string-ports.scrbl @@ -0,0 +1,69 @@ +#reader(lib "docreader.ss" "scribble") +@require["mz.ss"] + +@title[#:tag "mz:stringport"]{String Ports} + +String input and output ports do not need to be explicitly closed. The +@scheme[file-position] procedure works for string ports in +position-setting mode. + +@defproc[(open-input-bytes [bstr bytes?][name any/c 'string]) input-port?]{ + +Creates an input port that reads characters from @scheme[bstr] (see +@secref["mz:bytestrings"]). Modifying @scheme[bstr] afterward does not +affect the byte stream produced by the port. The optional +@scheme[name] argument is used as the name for the returned port.} + +@defproc[(open-input-string [str string?][name any/c 'string]) input-port?]{ + +Creates an input port that reads bytes from the UTF-8 encoding (see +@secref["mz:encodings"]) of @scheme[str]. The optional @scheme[name] +argument is used as the name for the returned port.} + +@defproc[(open-output-bytes [name any/c 'string]) output-port?]{ + +Creates an output port that accumulates the output into a byte +string. The optional @scheme[name] argument is used as the name for +the returned port.} + +@defproc[(open-output-string [name any/c 'string]) output-port?]{The +same as @scheme[open-output-bytes].} + +@defproc[(get-output-bytes [out output-port?] + [reset? any/c #f] + [start-pos nonnegative-exact-integer? 0] + [end-pos nonnegative-exact-integer? #f]) + bytes?]{ + +Returns the bytes accumulated in @scheme[out] so far in a +freshly-allocated byte string (including any bytes written after the +port's current position, if any). the @scheme[out] port must be a +string output port produced by @scheme[open-output-bytes] (or +@scheme[open-output-string]) or a structure whose +@scheme[prop:output-port] property refers to such an output port +(transitively). + +If @scheme[reset?] is true, then all bytes are removed from the port, +and the port's position is reset to @scheme[0]; if @scheme[reset?] is +@scheme[#f], then all bytes remain in the port for further +accumulation (so they are returned for later calls to +@scheme[get-output-bytes] or @scheme[get-output-string]), and the +port's position is unchanged. + +The @scheme[start-pos] and @scheme[end-pos] arguments specify the +range of bytes in the port to return; supplying @scheme[start-pos] and +@scheme[end-pos] is the same as using @scheme[subbytes] on the result +of @scheme[get-output-bytes], but supplying them to +@scheme[get-output-bytes] can avoid an allocation. The +@scheme[end-pos] argument can be @scheme[#f], which corresponds to not +passing a second argument to @scheme[subbytes].} + +@defproc[(get-output-string [out output-port?]) string?]{ +Returns @scheme[(bytes->string/utf-8 (get-output-bytes out) #\?)].} + +@examples[ +(define i (open-input-string "hello world")) +(define o (open-output-string)) +(write (read i) o) +(get-output-string o) +] diff --git a/collects/scribblings/reference/struct.scrbl b/collects/scribblings/reference/struct.scrbl index 0cf73c222c..295c27e745 100644 --- a/collects/scribblings/reference/struct.scrbl +++ b/collects/scribblings/reference/struct.scrbl @@ -61,8 +61,8 @@ depends on the current inspector.) @defproc[(make-struct-type [name symbol?] [super-type (or/c struct-type? false/c)] - [init-field-cnt non-negative-exact-integer?] - [auto-field-cnt non-negative-exact-integer?] + [init-field-cnt nonnegative-exact-integer?] + [auto-field-cnt nonnegative-exact-integer?] [auto-v any/c #f] [props (listof (cons/c struct-type-property? any/c)) @@ -70,10 +70,10 @@ depends on the current inspector.) [inspector (or/c inspector? false/c) (current-inspector)] [proc-spec (or/c procedure? - non-negative-exact-integer? + nonnegative-exact-integer? false/c) #f] - [immutables (listof non-negative-exact-integer?) + [immutables (listof nonnegative-exact-integer?) null] [guard (or/c procedure? false/c) #f]) (values struct-type?