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

Merge branch 'master' of pltgit:plt

Browse Source
This commit is contained in:
James Swaine 2011-02-10 14:38:50 -06:00
commit 22d6ad7d03
18 changed files with 412 additions and 296 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/compiler/commands/make.rkt
View File

@ -16,6 +16,8 @@
(define assume-primitives (make-parameter #t))
(define worker-count (make-parameter 1))
(define mzc-symbol (string->symbol (short-program+command-name)))
(define source-files
(command-line
#:program (short-program+command-name)
@ -67,9 +69,9 @@
(printf " making ~s\n" (path->string p))))])
(for ([file source-files])
(unless (file-exists? file)
(error 'mzc "file does not exist: ~a" file))
(error mzc-symbol "file does not exist: ~a" file))
(set! did-one? #f)
(let ([name (extract-base-filename/ss file 'mzc)])
(let ([name (extract-base-filename/ss file mzc-symbol)])
(when (verbose)
(printf "\"~a\":\n" file))
(parameterize ([compile-context-preservation-enabled

4
collects/compiler/commands/pack.rkt
View File

@ -19,6 +19,8 @@
(define plt-setup-collections (make-parameter null))
(define plt-include-compiled (make-parameter #f))
(define mzc-symbol (string->symbol (short-program+command-name)))
(define-values (plt-output source-files)
(command-line
#:program (short-program+command-name)
@ -53,7 +55,7 @@
(begin
(for ([fd source-files])
(unless (relative-path? fd)
(error 'mzc
(error mzc-symbol
"file/directory is not relative to the current directory: \"~a\""
fd)))
(pack-plt plt-output

23
collects/drracket/drracket.rkt
View File

@ -36,14 +36,12 @@
[debugging?
(flprintf "PLTDRDEBUG: loading CM to load/create errortrace zos\n")
(let-values ([(zo-compile
make-compilation-manager-load/use-compiled-handler
manager-trace-handler)
make-compilation-manager-load/use-compiled-handler)
(parameterize ([current-namespace (make-base-empty-namespace)]
[use-compiled-file-paths '()])
(values
(dynamic-require 'errortrace/zo-compile 'zo-compile)
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
(dynamic-require 'compiler/cm 'manager-trace-handler)))])
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)))])
(flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
(current-compile zo-compile)
(use-compiled-file-paths (list (build-path "compiled" "errortrace")))
@ -55,12 +53,9 @@
(run-trace-thread)))]
[install-cm?
(flprintf "PLTDRCM: loading compilation manager\n")
(let-values ([(make-compilation-manager-load/use-compiled-handler
manager-trace-handler)
(parameterize ([current-namespace (make-base-empty-namespace)])
(values
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
(dynamic-require 'compiler/cm 'manager-trace-handler)))])
(let ([make-compilation-manager-load/use-compiled-handler
(parameterize ([current-namespace (make-base-empty-namespace)])
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler))])
(flprintf "PLTDRCM: installing compilation manager\n")
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(when cm-trace?
@ -74,11 +69,9 @@
(filter
(λ (x) (regexp-match #rx"rkt$" (path->string x)))
(directory-list dir))))
(define-values (make-compilation-manager-load/use-compiled-handler manager-trace-handler)
(define make-compilation-manager-load/use-compiled-handler
(parameterize ([current-namespace (make-base-empty-namespace)])
(values
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
(dynamic-require 'compiler/cm 'manager-trace-handler))))
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)))
(when cm-trace?
(flprintf "PLTDRPAR: enabling CM tracing\n")
(run-trace-thread))
@ -93,7 +86,7 @@
(case handler-type
[(done) (void)]
[else
(printf "msg: ~s\n" msg)
(printf "~a\n" msg)
(printf "stdout from compiling ~a:\n~a\n" path out)
(flush-output)
(fprintf (current-error-port) "stderr from compiling ~a:\n~a\n" path err)])))

2
collects/framework/private/color.rkt
View File

@ -320,7 +320,7 @@ added get-regions
(sp (+ in-start-pos (sub1 new-token-start)))
(ep (+ in-start-pos (sub1 new-token-end))))
(λ ()
(change-style color sp ep #f)))
(change-style color sp ep #f)))
colors)))
;; Using the non-spec version takes 3 times as long as the spec
;; version. In other words, the new greatly outweighs the tree

2
collects/framework/private/keymap.rkt
View File

@ -1127,7 +1127,7 @@
(add "make-read-only" make-read-only)
(add "beginning-of-line" beginning-of-line)
(add "selec-to-beginning-of-line" select-to-beginning-of-line)
(add "select-to-beginning-of-line" select-to-beginning-of-line)
; Map keys to functions

31
collects/framework/private/text.rkt
View File

@ -3720,7 +3720,7 @@ designates the character that triggers autocompletion
;; draws line numbers on the left hand side of a text% object
(define line-numbers-mixin
(mixin ((class->interface text%)) (line-numbers<%>)
(mixin ((class->interface text%) editor:standard-style-list<%>) (line-numbers<%>)
(inherit get-visible-line-range
get-visible-position-range
last-line
@ -3732,7 +3732,7 @@ designates the character that triggers autocompletion
set-padding
get-padding)
(init-field [line-numbers-color "black"])
(init-field [line-numbers-color #f])
(init-field [show-line-numbers? #t])
;; whether the numbers are aligned on the left or right
;; only two values should be 'left or 'right
@ -3774,9 +3774,12 @@ designates the character that triggers autocompletion
(define style-change-notify
(lambda (style) (unless style (setup-padding))))
(define/private (get-style-font)
(let* ([style-list (send this get-style-list)]
[std (or (send style-list find-named-style "Standard")
(define/private (get-style)
(let* ([style-list (editor:get-standard-style-list)]
[std (or (send style-list
find-named-style
(editor:get-default-color-style-name))
(send style-list find-named-style "Standard")
(send style-list basic-style))])
;; If the style changes, we should re-check the width of
;; drawn line numbers:
@ -3785,8 +3788,13 @@ designates the character that triggers autocompletion
(send style-list notify-on-change style-change-notify)
;; Avoid registering multiple notifications:
(set! notify-registered-in-list style-list))
;; Extract the font from the style:
(send std get-font)))
std))
(define/private (get-style-foreground)
(send (get-style) get-foreground))
(define/private (get-style-font)
(send (get-style) get-font))
(define-struct saved-dc-state (pen font foreground-color))
(define/private (save-dc-state dc)
@ -3799,11 +3807,16 @@ designates the character that triggers autocompletion
(send dc set-font (saved-dc-state-font dc-state))
(send dc set-text-foreground (saved-dc-state-foreground-color dc-state)))
(define/private (get-foreground)
(if line-numbers-color
(make-object color% line-numbers-color)
(get-style-foreground)))
;; set the dc stuff to values we want
(define/private (setup-dc dc)
(send dc set-pen "black" 1 'solid)
(send dc set-font (get-style-font))
(send dc set-text-foreground (make-object color% line-numbers-color)))
(send dc set-text-foreground (get-foreground)))
(define/private (lighter-color color)
(define (integer number)
@ -3914,7 +3927,7 @@ designates the character that triggers autocompletion
(begin
(send dc set-text-foreground (lighter-color (send dc get-text-foreground)))
(draw-text view final-x final-y)
(send dc set-text-foreground (make-object color% line-numbers-color)))
(send dc set-text-foreground (get-foreground)))
(draw-text view final-x final-y)))
(set! last-paragraph (line-paragraph line))))

2
collects/mred/private/wx/cocoa/frame.rkt
View File

@ -549,7 +549,7 @@
(define/public (on-activate on?) (void))
(define/public (set-icon bm1 bm2 [mode 'both]) (void)) ;; FIXME
(define/public (set-icon bm1 [bm2 #f] [mode 'both]) (void)) ;; FIXME
(define/override (call-pre-on-event w e)
(pre-on-event w e))

2
collects/mred/private/wx/gtk/clipboard.rkt
View File

@ -25,7 +25,6 @@
(define _GtkClipboard (_cpointer 'GtkClipboard))
(define _GtkDisplay _pointer)
(define _GtkSelectionData (_cpointer 'GtkSelectionData))
;; Recent versions of Gtk provide function calls to
;; access data, but use structure when the functions are
@ -38,6 +37,7 @@
[length _int]
[display _GtkDisplay]))
(define _GtkSelectionData _GtkSelectionDataT-pointer)
(define-gdk gdk_atom_intern (_fun _string _gboolean -> _GdkAtom))

2
collects/mred/private/wx/gtk/frame.rkt
View File

@ -334,7 +334,7 @@
(define big-icon #f)
(define small-icon #f)
(define/public (set-icon bm mask [mode 'both])
(define/public (set-icon bm [mask #f] [mode 'both])
(let ([bm (if mask
(let* ([nbm (make-object bitmap%
(send bm get-width)

2
collects/mred/private/wx/win32/canvas.rkt
View File

@ -116,7 +116,7 @@
(if hscroll? WS_HSCROLL 0)
(if vscroll? WS_VSCROLL 0))
0 0 w h
(or panel-hwnd (send parent get-hwnd))
(or panel-hwnd (send parent get-client-hwnd))
#f
hInstance
#f))

2
collects/mred/private/wx/win32/frame.rkt
View File

@ -527,7 +527,7 @@
(define small-hicon #f)
(define big-hicon #f)
(define/public (set-icon bm mask [mode 'both])
(define/public (set-icon bm [mask #f] [mode 'both])
(let* ([bg-hbitmap
(let* ([bm (make-object bitmap% (send bm get-width) (send bm get-height))]
[dc (make-object bitmap-dc% bm)])

30
collects/racket/contract/private/guts.rkt
View File

@ -322,6 +322,24 @@
([p (in-list (cdr projs))])
(λ (v) (p (proj v))))))))
(define (first-order-and-proj ctc)
(λ (blame)
(λ (val)
(let loop ([predicates (first-order-and/c-predicates ctc)]
[ctcs (base-and/c-ctcs ctc)])
(cond
[(null? predicates) val]
[else
(if ((car predicates) val)
(loop (cdr predicates) (cdr ctcs))
(raise-blame-error
blame
val
"expected <~s>, given ~a, which isn't ~s"
(contract-name ctc)
val
(contract-name (car ctcs))))])))))
(define (and-stronger? this that)
(and (base-and/c? that)
(let ([this-ctcs (base-and/c-ctcs this)]
@ -332,6 +350,13 @@
that-ctcs)))))
(define-struct base-and/c (ctcs))
(define-struct (first-order-and/c base-and/c) (predicates)
#:property prop:flat-contract
(build-flat-contract-property
#:projection first-order-and-proj
#:name and-name
#:first-order and-first-order
#:stronger and-stronger?))
(define-struct (chaperone-and/c base-and/c) ()
#:property prop:chaperone-contract
(build-chaperone-contract-property
@ -347,15 +372,14 @@
#:first-order and-first-order
#:stronger and-stronger?))
(define/subexpression-pos-prop (and/c . raw-fs)
(let ([contracts (coerce-contracts 'and/c raw-fs)])
(cond
[(null? contracts) any/c]
[(andmap flat-contract? contracts)
(let ([preds (map flat-contract-predicate contracts)])
(flat-named-contract
(apply build-compound-type-name 'and/c contracts)
(λ (x) (for/and ([pred (in-list preds)]) (pred x)))))]
(make-first-order-and/c contracts preds))]
[(andmap chaperone-contract? contracts)
(make-chaperone-and/c contracts)]
[else (make-impersonator-and/c contracts)])))

15
collects/racket/private/misc.rkt
View File

@ -22,10 +22,17 @@
(lambda (user-stx)
(syntax-case** dr #t user-stx () free-identifier=?
[(_ . pattern) (syntax/loc user-stx template)]
[_ (let*-values ([(sexpr) (syntax->datum user-stx)]
[(msg) (format
"~.s did not match pattern ~.s"
sexpr (cons (car sexpr) 'pattern))])
[_ (let*-values
([(sexpr) (syntax->datum user-stx)]
[(msg)
(if (pair? sexpr)
(format "~.s did not match pattern ~.s"
sexpr (cons (car sexpr) 'pattern))
(if (symbol? sexpr)
(format "must be used in a pattern ~.s"
(cons sexpr 'pattern))
(error 'internal-error
"something bad happened")))])
(raise-syntax-error #f msg user-stx))]))))]
[(_ (name . ptrn) tmpl) (err "expected an identifier" #'name)]
[(_ (name . ptrn)) (err "missing template")]

18
collects/scribblings/drracket/extending.scrbl
View File

@ -1,6 +1,7 @@
#lang scribble/doc
@(require "common.ss"
(for-label compiler/cm
setup/parallel-build
racket/promise))
@title[#:tag "extending-drracket"]{Extending DrRacket}
@ -125,11 +126,20 @@ Several environment variables can affect DrRacket's behavior:
@item{@indexed-envvar{PLTDRCM} : When this environment variable is
set, DrRacket installs the compilation manager before starting
up, which means that the @filepath{.zo} files are automatically
kept up to date, as DrRacket's (or a tools) source is modified.
kept up to date, as DrRacket's (or a tool's) source is modified.
If the variable is set to @litchar{trace} then the compilation
manager's output is traced, using the
@racket[manager-trace-handler] procedure.}
If the variable is set to @litchar{trace} then the files that are
actually recompiled are shown.}
@item{@indexed-envvar{PLTDRPAR} : When this environment variable is
set, DrRacket uses @racket[parallel-compile-files] to compile
the framework and the drracket collections in parallel and then
installs the compilation manager before starting
up, which means that the @filepath{.zo} files are automatically
kept up to date, as DrRacket's (or a tool's) source is modified.
If the variable is set to @litchar{trace} then the files that are
actually recompiled are shown.}
@item{@indexed-envvar{PLTDRDEBUG} : When this environment variable is
set, DrRacket starts up with errortrace enabled. If the

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

@ -14,8 +14,8 @@
@defproc[(port->list [r (input-port? . -> . any/c) read] [in input-port? (current-input-port)])
(listof any/c)]{
Returns a list whose elements are produced by calling @scheme[r]
on @scheme[in] until it produces @scheme[eof].
Returns a list whose elements are produced by calling @racket[r]
on @racket[in] until it produces @racket[eof].
@examples[#:eval port-eval
(define (read-number input-port)
@ -28,14 +28,14 @@ on @scheme[in] until it produces @scheme[eof].
@defproc[(port->string [in input-port? (current-input-port)]) string?]{
Reads all characters from @scheme[in] and returns them as a string.
Reads all characters from @racket[in] and returns them as a string.
@examples[#:eval port-eval
(port->string (open-input-string "hello world"))
]}
@defproc[(port->bytes [in input-port? (current-input-port)]) bytes?]{
Reads all bytes from @scheme[in] and returns them as a @tech{byte string}.
Reads all bytes from @racket[in] and returns them as a @tech{byte string}.
@examples[#:eval port-eval
(port->bytes (open-input-string "hello world"))
@ -45,10 +45,10 @@ Reads all bytes from @scheme[in] and returns them as a @tech{byte string}.
[#:line-mode line-mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one) 'any])
(listof string?)]{
Read all characters from @scheme[in], breaking them into lines. The
@scheme[line-mode] argument is the same as the second argument to
@scheme[read-line], but the default is @scheme['any] instead of
@scheme['linefeed].
Read all characters from @racket[in], breaking them into lines. The
@racket[line-mode] argument is the same as the second argument to
@racket[read-line], but the default is @racket['any] instead of
@racket['linefeed].
@examples[#:eval port-eval
(port->lines
@ -59,8 +59,8 @@ Read all characters from @scheme[in], breaking them into lines. The
[#:line-mode line-mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one) 'any])
(listof bytes?)]{
Like @scheme[port->lines], but reading bytes and collecting them into
lines like @scheme[read-bytes-line].
Like @racket[port->lines], but reading bytes and collecting them into
lines like @racket[read-bytes-line].
@examples[#:eval port-eval
(port->bytes-lines
@ -72,35 +72,35 @@ lines like @scheme[read-bytes-line].
[#:separator separator any/c #"\n"])
void?]{
Use @scheme[display] to each each element of @scheme[lst] to @scheme[out], adding
@scheme[separator] after each element.}
Use @racket[display] to each each element of @racket[lst] to @racket[out], adding
@racket[separator] after each element.}
@defproc[(call-with-output-string [proc (output-port? . -> . any)]) string?]{
Calls @scheme[proc] with an output port that accumulates all output
Calls @racket[proc] with an output port that accumulates all output
into a string, and returns the string.
The port passed to @scheme[proc] is like the one created by
@scheme[open-output-string], except that it is wrapped via
@scheme[dup-output-port], so that @scheme[proc] cannot access the
port's content using @scheme[get-output-string]. If control jumps back
into @scheme[proc], the port continues to accumulate new data, and
@scheme[call-with-output-string] returns both the old data and newly
The port passed to @racket[proc] is like the one created by
@racket[open-output-string], except that it is wrapped via
@racket[dup-output-port], so that @racket[proc] cannot access the
port's content using @racket[get-output-string]. If control jumps back
into @racket[proc], the port continues to accumulate new data, and
@racket[call-with-output-string] returns both the old data and newly
accumulated data.}
@defproc[(call-with-output-bytes [proc (output-port? . -> . any)]) bytes?]{
Like @scheme[call-with-output-string], but returns accumulated results
Like @racket[call-with-output-string], but returns accumulated results
in a @tech{byte string} instead of a string. Furthermore, the port's
content is emptied when @scheme[call-with-output-bytes] returns, so
that if control jumps back into @scheme[proc] and returns a second
content is emptied when @racket[call-with-output-bytes] returns, so
that if control jumps back into @racket[proc] and returns a second
time, only the newly accumulated bytes are returned.}
@defproc[(with-output-to-string [proc (-> any)]) string?]{
Equivalent to
@schemeblock[(call-with-output-string
@racketblock[(call-with-output-string
(lambda (p) (parameterize ([current-output-port p])
(proc))))]}
@ -108,30 +108,30 @@ Equivalent to
Equivalent to
@schemeblock[(call-with-output-bytes
@racketblock[(call-with-output-bytes
(lambda (p) (parameterize ([current-output-port p])
(proc))))]}
@defproc[(call-with-input-string [str string?] [proc (input-port? . -> . any)]) any]{
Equivalent to @scheme[(proc (open-input-string str))].}
Equivalent to @racket[(proc (open-input-string str))].}
@defproc[(call-with-input-bytes [bstr bytes?] [proc (input-port? . -> . any)]) any]{
Equivalent to @scheme[(proc (open-input-bytes bstr))].}
Equivalent to @racket[(proc (open-input-bytes bstr))].}
@defproc[(with-input-from-string [str string?] [proc (-> any)]) any]{
Equivalent to
@schemeblock[(parameterize ([current-input-port (open-input-string str)])
@racketblock[(parameterize ([current-input-port (open-input-string str)])
(proc))]}
@defproc[(with-input-from-bytes [bstr bytes?] [proc (-> any)]) any]{
Equivalent to
@schemeblock[(parameterize ([current-input-port (open-input-bytes str)])
@racketblock[(parameterize ([current-input-port (open-input-bytes str)])
(proc))]}
@ -143,13 +143,13 @@ Equivalent to
Takes any number of input ports and returns an input port. Reading
from the input port draws bytes (and special non-byte values) from the
given input ports in order. If @scheme[close-at-eof?] is true, then
given input ports in order. If @racket[close-at-eof?] is true, then
each port is closed when an end-of-file is encountered from the port,
or when the result input port is closed. Otherwise, data not read from
the returned input port remains available for reading in its original
input port.
See also @scheme[merge-input], which interleaves data from multiple
See also @racket[merge-input], which interleaves data from multiple
input ports as it becomes available.}
@ -196,39 +196,39 @@ input ports as it becomes available.}
#f])
input-port?]{
Similar to @scheme[make-input-port], but if the given @scheme[read-in]
returns an event, the event's value must be @scheme[0]. The resulting
Similar to @racket[make-input-port], but if the given @racket[read-in]
returns an event, the event's value must be @racket[0]. The resulting
port's peek operation is implemented automatically (in terms of
@scheme[read-in]) in a way that can handle special non-byte
@racket[read-in]) in a way that can handle special non-byte
values. The progress-event and commit operations are also implemented
automatically. The resulting port is thread-safe, but not kill-safe
(i.e., if a thread is terminated or suspended while using the port,
the port may become damaged).
The @scheme[read-in], @scheme[close], @scheme[get-location],
@scheme[count-lines!], @scheme[init-position], and
@scheme[buffer-mode] procedures are the same as for
@scheme[make-input-port].
The @racket[read-in], @racket[close], @racket[get-location],
@racket[count-lines!], @racket[init-position], and
@racket[buffer-mode] procedures are the same as for
@racket[make-input-port].
The @scheme[fast-peek] argument can be either @scheme[#f] or a
The @racket[fast-peek] argument can be either @racket[#f] or a
procedure of three arguments: a byte string to receive a peek, a skip
count, and a procedure of two arguments. The @scheme[fast-peek]
count, and a procedure of two arguments. The @racket[fast-peek]
procedure can either implement the requested peek, or it can dispatch
to its third argument to implement the peek. The @scheme[fast-peek] is
to its third argument to implement the peek. The @racket[fast-peek] is
not used when a peek request has an associated progress event.
The @scheme[buffering?] argument determines whether @scheme[read-in]
The @racket[buffering?] argument determines whether @racket[read-in]
can be called to read more characters than are immediately demanded by
the user of the new port. If @scheme[buffer-mode] is not @scheme[#f],
then @scheme[buffering?] determines the initial buffer mode, and
@scheme[buffering?] is enabled after a buffering change only if the
new mode is @scheme['block].
the user of the new port. If @racket[buffer-mode] is not @racket[#f],
then @racket[buffering?] determines the initial buffer mode, and
@racket[buffering?] is enabled after a buffering change only if the
new mode is @racket['block].
If @scheme[on-consumed] is not @scheme[#f], it is called when data is
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
@scheme[on-consumed] is the result value of the port's reading
@racket[on-consumed] is the result value of the port's reading
procedure, so it can be an integer or any result from
@scheme[read-in].}
@racket[read-in].}
@defproc[(make-limited-input-port [in input-port?]
@ -236,17 +236,17 @@ procedure, so it can be an integer or any result from
[close-orig? any/c #t])
input-port?]{
Returns a port whose content is drawn from @scheme[in], but where an
end-of-file is reported after @scheme[limit] bytes (and non-byte
special values) are read. If @scheme[close-orig?] is true, then the
Returns a port whose content is drawn from @racket[in], but where an
end-of-file is reported after @racket[limit] bytes (and non-byte
special values) are read. If @racket[close-orig?] is true, then the
original port is closed if the returned port is closed.
Bytes are consumed from @scheme[in] only when they are consumed from
Bytes are consumed from @racket[in] only when they are consumed from
the returned port. In particular, peeking into the returned port peeks
into the original port.
If @scheme[in] is used directly while the resulting port is also used,
then the @scheme[limit] bytes provided by the port need not be
If @racket[in] is used directly while the resulting port is also used,
then the @racket[limit] bytes provided by the port need not be
contiguous parts of the original port's stream.}
@ -257,17 +257,17 @@ contiguous parts of the original port's stream.}
(values input-port? output-port?)]{
Returns two ports: an input port and an output port. The ports behave
like those returned by @scheme[make-pipe], except that the ports
like those returned by @racket[make-pipe], except that the ports
support non-byte values written with procedures such as
@scheme[write-special] and read with procedures such as
@scheme[get-byte-or-special].
@racket[write-special] and read with procedures such as
@racket[get-byte-or-special].
The @scheme[limit] argument determines the maximum capacity of the
The @racket[limit] argument determines the maximum capacity of the
pipe in bytes, but this limit is disabled if special values are
written to the pipe before @scheme[limit] is reached. The limit is
written to the pipe before @racket[limit] is reached. The limit is
re-enabled after the special value is read from the pipe.
The optional @scheme[in-name] and @scheme[out-name] arguments
The optional @racket[in-name] and @racket[out-name] arguments
determine the names of the result ports.}
@ -285,15 +285,15 @@ new port. After an end-of-file has been read from both original ports,
the new port returns end-of-file. Closing the merged port does not
close the original ports.
The optional @scheme[buffer-limit] argument limits the number of bytes
to be buffered from @scheme[a-in] and @scheme[b-in], so that the merge
The optional @racket[buffer-limit] argument limits the number of bytes
to be buffered from @racket[a-in] and @racket[b-in], so that the merge
process does not advance arbitrarily beyond the rate of consumption of
the merged data. A @scheme[#f] value disables the limit. As for
@scheme[make-pipe-with-specials], @scheme[buffer-limit] does not apply
the merged data. A @racket[#f] value disables the limit. As for
@racket[make-pipe-with-specials], @racket[buffer-limit] does not apply
when a special value is produced by one of the input ports before the
limit is reached.
See also @scheme[input-port-append], which concatenates input streams
See also @racket[input-port-append], which concatenates input streams
instead of interleaving them.}
@ -304,9 +304,9 @@ instead of interleaving them.}
'("Opening a null output port")]{
Creates} and returns an output port that discards all output sent to it
(without blocking). The @scheme[name] argument is used as the port's
name. If the @scheme[special-ok?] argument is true, then the
resulting port supports @scheme[write-special], otherwise it does not.}
(without blocking). The @racket[name] argument is used as the port's
name. If the @racket[special-ok?] argument is true, then the
resulting port supports @racket[write-special], otherwise it does not.}
@defproc[(peeking-input-port [in input-port?]
@ -315,14 +315,37 @@ resulting port supports @scheme[write-special], otherwise it does not.}
input-port]{
Returns an input port whose content is determined by peeking into
@scheme[in]. In other words, the resulting port contains an internal
skip count, and each read of the port peeks into @scheme[in] with the
@racket[in]. In other words, the resulting port contains an internal
skip count, and each read of the port peeks into @racket[in] with the
internal skip count, and then increments the skip count according to
the amount of data successfully peeked.
The optional @scheme[name] argument is the name of the resulting
port. The @scheme[skip] argument is the port initial skip count, and
it defaults to @scheme[0].}
The optional @racket[name] argument is the name of the resulting
port. The @racket[skip] argument is the port initial skip count, and
it defaults to @racket[0].
The resulting port's initial position is @racket[0], no matter the
position of @racket[in].
For example, when you read from a peeking port, you
see the same answers as when you read from the original port.
@examples[#:eval port-eval
(define an-original-port (open-input-string "123456789"))
(define a-peeking-port (peeking-input-port an-original-port))
(read-string 3 a-peeking-port)
(read-string 3 an-original-port)]
But beware, the read from the original port is invisible to the peeking
port, which keeps its own separate internal counter, and thus
interleaving reads on the two ports can produce confusing results.
Continuing the example before, if we read three more characters from
the peeking port, we end up skipping over the @litchar{456} in the port.
@examples[#:eval port-eval
(read-string 3 a-peeking-port)
]
}
@ -336,24 +359,24 @@ it defaults to @scheme[0].}
(lambda (msg port) (error ...))])
input-port?]{
Produces an input port that draws bytes from @scheme[in], but converts
the byte stream using @scheme[(bytes-open-converter encoding-str
"UTF-8")]. In addition, if @scheme[convert-newlines?] is true, then
decoded sequences that correspond to UTF-8 encodings of @scheme["\r\n"],
@scheme["\r\x85"], @scheme["\r"], @scheme["\x85"], and @scheme["\u2028"]
are all converted to the UTF-8 encoding of @scheme["\n"].
Produces an input port that draws bytes from @racket[in], but converts
the byte stream using @racket[(bytes-open-converter encoding-str
"UTF-8")]. In addition, if @racket[convert-newlines?] is true, then
decoded sequences that correspond to UTF-8 encodings of @racket["\r\n"],
@racket["\r\x85"], @racket["\r"], @racket["\x85"], and @racket["\u2028"]
are all converted to the UTF-8 encoding of @racket["\n"].
If @scheme[error-bytes] is provided and not @scheme[#f], then the
given byte sequence is used in place of bytes from @scheme[in] that
If @racket[error-bytes] is provided and not @racket[#f], then the
given byte sequence is used in place of bytes from @racket[in] that
trigger conversion errors. Otherwise, if a conversion is encountered,
@scheme[enc-error] is called, which must raise an exception.
@racket[enc-error] is called, which must raise an exception.
If @scheme[close?] is true, then closing the result input port also
closes @scheme[in]. The @scheme[name] argument is used as the name of
If @racket[close?] is true, then closing the result input port also
closes @racket[in]. The @racket[name] argument is used as the name of
the result input port.
In non-buffered mode, the resulting input port attempts to draw bytes
from @scheme[in] only as needed to satisfy requests. Toward that end,
from @racket[in] only as needed to satisfy requests. Toward that end,
the input port assumes that at least @math{n} bytes must be read to
satisfy a request for @math{n} bytes. (This is true even if the port
has already drawn some bytes, as long as those bytes form an
@ -370,30 +393,30 @@ incomplete encoding sequence.)}
(lambda (msg port) (error ...))])
output-port?]{
Produces an output port that directs bytes to @scheme[out], but
converts its byte stream using @scheme[(bytes-open-converter "UTF-8"
encoding-str)]. In addition, if @scheme[newline-bytes] is not
@scheme[#f], then byets written to the port that are the UTF-8
encoding of @scheme["\n"] are first converted to
@scheme[newline-bytes] (before applying the convert from UTF-8 to
@scheme[encoding-str]).
Produces an output port that directs bytes to @racket[out], but
converts its byte stream using @racket[(bytes-open-converter "UTF-8"
encoding-str)]. In addition, if @racket[newline-bytes] is not
@racket[#f], then byets written to the port that are the UTF-8
encoding of @racket["\n"] are first converted to
@racket[newline-bytes] (before applying the convert from UTF-8 to
@racket[encoding-str]).
If @scheme[error-bytes] is provided and not @scheme[#f], then the
If @racket[error-bytes] is provided and not @racket[#f], then the
given byte sequence is used in place of bytes send to the output port
that trigger conversion errors. Otherwise, @scheme[enc-error] is
that trigger conversion errors. Otherwise, @racket[enc-error] is
called, which must raise an exception.
If @scheme[close?] is true, then closing the result output port also
closes @scheme[out]. The @scheme[name] argument is used as the name of
If @racket[close?] is true, then closing the result output port also
closes @racket[out]. The @racket[name] argument is used as the name of
the result output port.
The resulting port supports buffering, and the initial buffer mode is
@scheme[(or (file-stream-buffer-mode out) 'block)]. In @scheme['block]
@racket[(or (file-stream-buffer-mode out) 'block)]. In @racket['block]
mode, the port's buffer is flushed only when it is full or a flush is
requested explicitly. In @scheme['line] mode, the buffer is flushed
requested explicitly. In @racket['line] mode, the buffer is flushed
whenever a newline or carriage-return byte is written to the port. In
@scheme['none] mode, the port's buffer is flushed after every write.
Implicit flushes for @scheme['line] or @scheme['none] leave bytes in
@racket['none] mode, the port's buffer is flushed after every write.
Implicit flushes for @racket['line] or @racket['none] leave bytes in
the buffer when they are part of an incomplete encoding sequence.
The resulting output port does not support atomic writes. An explicit
@ -405,13 +428,13 @@ recently written bytes form an incomplete encoding sequence.}
[close? any/c #f])
input-port?]{
Returns an input port that draws directly from @scheme[in]. Closing
the resulting port closes @scheme[in] only if @scheme[close?] is
@scheme[#t].
Returns an input port that draws directly from @racket[in]. Closing
the resulting port closes @racket[in] only if @racket[close?] is
@racket[#t].
The new port is initialized with the @tech{port read handler} of
@scheme[in], but setting the handler on the result port does not
affect reading directly from @scheme[in].}
@racket[in], but setting the handler on the result port does not
affect reading directly from @racket[in].}
@defproc[(dup-output-port [out output-port?]
@ -419,12 +442,12 @@ affect reading directly from @scheme[in].}
output-port?]{
Returns an output port that propagates data directly to
@scheme[out]. Closing the resulting port closes @scheme[out] only if
@scheme[close?] is @scheme[#t].
@racket[out]. Closing the resulting port closes @racket[out] only if
@racket[close?] is @racket[#t].
The new port is initialized with the @tech{port display handler} and
@tech{port write handler} of @scheme[out], but setting the handlers on
the result port does not affect writing directly to @scheme[out].}
@tech{port write handler} of @racket[out], but setting the handlers on
the result port does not affect writing directly to @racket[out].}
@ -435,27 +458,27 @@ the result port does not affect writing directly to @scheme[out].}
[close? any/c #t])
input-port?]{
Produces an input port that is equivalent to @scheme[in] except in how
Produces an input port that is equivalent to @racket[in] except in how
it reports location information. The resulting port's content starts
with the remaining content of @scheme[in], and it starts at the given
line, column, and position. A @scheme[#f] for the line or column means
that the line and column will always be reported as @scheme[#f].
with the remaining content of @racket[in], and it starts at the given
line, column, and position. A @racket[#f] for the line or column means
that the line and column will always be reported as @racket[#f].
The @scheme[line] and @scheme[column] values are used only if line
counting is enabled for @scheme[in] and for the resulting port,
typically through @scheme[port-count-lines!]. The @scheme[column]
The @racket[line] and @racket[column] values are used only if line
counting is enabled for @racket[in] and for the resulting port,
typically through @racket[port-count-lines!]. The @racket[column]
value determines the column for the first line (i.e., the one numbered
@scheme[line]), and later lines start at column @scheme[0]. The given
@scheme[position] is used even if line counting is not enabled.
@racket[line]), and later lines start at column @racket[0]. The given
@racket[position] is used even if line counting is not enabled.
When line counting is on for the resulting port, reading from
@scheme[in] instead of the resulting port increments location reports
@racket[in] instead of the resulting port increments location reports
from the resulting port. Otherwise, the resulting port's position does
not increment when data is read from @scheme[in].
not increment when data is read from @racket[in].
If @scheme[close?] is true, then closing the resulting port also
closes @scheme[in]. If @scheme[close?] is @scheme[#f], then closing
the resulting port does not close @scheme[in].}
If @racket[close?] is true, then closing the resulting port also
closes @racket[in]. If @racket[close?] is @racket[#f], then closing
the resulting port does not close @racket[in].}
@defproc[(relocate-output-port [out output-port?]
@ -465,7 +488,7 @@ the resulting port does not close @scheme[in].}
[close? any/c #t])
output-port?]{
Like @scheme[relocate-input-port], but for output ports.}
Like @racket[relocate-input-port], but for output ports.}
@defproc[(transplant-input-port [in input-port?]
@ -481,15 +504,15 @@ Like @scheme[relocate-input-port], but for output ports.}
[count-lines! (-> any) void])
input-port?]{
Like @scheme[relocate-input-port], except that arbitrary position
Like @racket[relocate-input-port], except that arbitrary position
information can be produced (when line counting is enabled) via
@scheme[get-location], which used as for @scheme[make-input-port]. If
@scheme[get-location] is @scheme[#f], then the port counts lines in
the usual way starting from @scheme[init-pos], independent of
locations reported by @scheme[in].
@racket[get-location], which used as for @racket[make-input-port]. If
@racket[get-location] is @racket[#f], then the port counts lines in
the usual way starting from @racket[init-pos], independent of
locations reported by @racket[in].
If @scheme[count-lines!] is supplied, it is called when line counting
is enabled for the resulting port. The default is @scheme[void].}
If @racket[count-lines!] is supplied, it is called when line counting
is enabled for the resulting port. The default is @racket[void].}
@defproc[(transplant-output-port [in input-port?]
[get-location (or/c
@ -504,7 +527,7 @@ is enabled for the resulting port. The default is @scheme[void].}
[count-lines! (-> any) void])
output-port?]{
Like @scheme[transplant-input-port], but for output ports.}
Like @racket[transplant-input-port], but for output ports.}
@defproc[(filter-read-input-port [in input-port?]
[read-wrap (bytes? (or/c exact-nonnegative-integer?
@ -549,10 +572,10 @@ closes @racket[in].}
[close? any/c #t])
input-port?]{
Produces an input port that that is equivalent to @scheme[in], except
that when @scheme[in] produces a procedure to access a special value,
@scheme[proc] is applied to the procedure to allow the special value
to be replaced with an alternative. The @scheme[proc] is called with
Produces an input port that that is equivalent to @racket[in], except
that when @racket[in] produces a procedure to access a special value,
@racket[proc] is applied to the procedure to allow the special value
to be replaced with an alternative. The @racket[proc] is called with
the special-value procedure and the byte string that was given to the
port's read or peek function (see @racket[make-input-port]), and the
result is used as te read or peek function's result. The
@ -560,7 +583,7 @@ result is used as te read or peek function's result. The
special value, but the byte string is guaranteed only to hold at least
one byte.
If @scheme[close?] is true, then closing the resulting input port also
If @racket[close?] is true, then closing the resulting input port also
closes @racket[in].}
@; ----------------------------------------------------------------------
@ -571,23 +594,23 @@ closes @racket[in].}
@defproc[(eof-evt [in input-port?]) evt?]{
Returns a @tech{synchronizable event} is that is ready when
@scheme[in] produces an @scheme[eof]. If @scheme[in] produces a
mid-stream @scheme[eof], the @scheme[eof] is consumed by the event
@racket[in] produces an @racket[eof]. If @racket[in] produces a
mid-stream @racket[eof], the @racket[eof] is consumed by the event
only if the event is chosen in a synchronization.}
@defproc[(read-bytes-evt [k exact-nonnegative-integer?] [in input-port?])
evt?]{
Returns a @tech{synchronizable event} is that is ready when @scheme[k]
bytes can be read from @scheme[in], or when an end-of-file is
encountered in @scheme[in]. If @scheme[k] is @scheme[0], then the
event is ready immediately with @scheme[""]. For non-zero @scheme[k],
Returns a @tech{synchronizable event} is that is ready when @racket[k]
bytes can be read from @racket[in], or when an end-of-file is
encountered in @racket[in]. If @racket[k] is @racket[0], then the
event is ready immediately with @racket[""]. For non-zero @racket[k],
if no bytes are available before an end-of-file, the event's result is
@scheme[eof]. Otherwise the event's result is a byte string of up to
@scheme[k] bytes, which contains as many bytes as are available (up to
@scheme[k]) before an available end-of-file. (The result is a byte
string on less than @scheme[k] bytes only when an end-of-file is
@racket[eof]. Otherwise the event's result is a byte string of up to
@racket[k] bytes, which contains as many bytes as are available (up to
@racket[k]) before an available end-of-file. (The result is a byte
string on less than @racket[k] bytes only when an end-of-file is
encountered.)
Bytes are read from the port if and only if the event is chosen in a
@ -598,7 +621,7 @@ The event can be synchronized multiple times---event
concurrently---and each synchronization corresponds to a distinct read
request.
The @scheme[in] must support progress events, and it must not produce
The @racket[in] must support progress events, and it must not produce
a special non-byte value during the read attempt.}
@ -606,14 +629,14 @@ a special non-byte value during the read attempt.}
[in input-port?])
evt?]{
Like @scheme[read-bytes-evt], except that the read bytes are placed
into @scheme[bstr], and the number of bytes to read corresponds to
@scheme[(bytes-length bstr)]. The event's result is either
@scheme[eof] or the number of read bytes.
Like @racket[read-bytes-evt], except that the read bytes are placed
into @racket[bstr], and the number of bytes to read corresponds to
@racket[(bytes-length bstr)]. The event's result is either
@racket[eof] or the number of read bytes.
The @scheme[bstr] may be mutated any time after the first
The @racket[bstr] may be mutated any time after the first
synchronization attempt on the event. If the event is not synchronized
multiple times concurrently, @scheme[bstr-bytes] is never mutated by
multiple times concurrently, @racket[bstr-bytes] is never mutated by
the event after it is chosen in a synchronization (no matter how many
synchronization attempts preceded the choice). Thus, the event may be
sensibly used multiple times until a successful choice, but should not
@ -623,15 +646,15 @@ be used in multiple concurrent synchronizations.}
@defproc[(read-bytes-avail!-evt [bstr (and/c bytes? (not/c immutable?))] [in input-port?])
evt?]{
Like @scheme[read-bytes!-evt], except that the event reads only as
Like @racket[read-bytes!-evt], except that the event reads only as
many bytes as are immediately available, after at least one byte or
one @scheme[eof] becomes available.}
one @racket[eof] becomes available.}
@defproc[(read-string-evt [k exact-nonnegative-integer?] [in input-port?])
evt?]{
Like @scheme[read-bytes-evt], but for character strings instead of
Like @racket[read-bytes-evt], but for character strings instead of
byte strings.}
@ -639,7 +662,7 @@ byte strings.}
[in input-port?])
evt?]{
Like @scheme[read-bytes!-evt], but for a character string instead of
Like @racket[read-bytes!-evt], but for a character string instead of
a byte string.}
@ -648,8 +671,8 @@ a byte string.}
evt?]{
Returns a @tech{synchronizable event} that is ready when a line of
characters or end-of-file can be read from @scheme[inport]. The
meaning of @scheme[mode] is the same as for @scheme[read-line]. The
characters or end-of-file can be read from @racket[inport]. The
meaning of @racket[mode] is the same as for @racket[read-line]. The
event result is the read line of characters (not including the line
separator).
@ -662,7 +685,7 @@ bytes in the port's stream.}
[mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one)])
evt?]{
Like @scheme[read-line-evt], but returns a byte string instead of a
Like @racket[read-line-evt], but returns a byte string instead of a
string.}
@defproc*[([(peek-bytes-evt [k exact-nonnegative-integer?] [skip exact-nonnegative-integer?]
@ -674,11 +697,11 @@ string.}
[(peek-string-evt [k exact-nonnegative-integer?] [in input-port?]) evt?]
[(peek-string!-evt [str (and/c string? (not/c immutable?))] [in input-port?]) evt?])]{
Like the @scheme[read-...-evt] functions, but for peeking. The
@scheme[skip] argument indicates the number of bytes to skip, and
@scheme[progress] indicates an event that effectively cancels the peek
(so that the event never becomes ready). The @scheme[progress]
argument can be @scheme[#f], in which case the event is never
Like the @racket[read-...-evt] functions, but for peeking. The
@racket[skip] argument indicates the number of bytes to skip, and
@racket[progress] indicates an event that effectively cancels the peek
(so that the event never becomes ready). The @racket[progress]
argument can be @racket[#f], in which case the event is never
cancelled.}
@ -686,12 +709,12 @@ cancelled.}
[in input-port?]) any]{
Returns a @tech{synchronizable event} that is ready when
@scheme[pattern] matches the stream of bytes/characters from
@scheme[in]; see also @scheme[regexp-match]. The event's value is the
@racket[pattern] matches the stream of bytes/characters from
@racket[in]; see also @racket[regexp-match]. The event's value is the
result of the match, in the same form as the result of
@scheme[regexp-match].
@racket[regexp-match].
If @scheme[pattern] does not require a start-of-stream match, then
If @racket[pattern] does not require a start-of-stream match, then
bytes skipped to complete the match are read and discarded when the
event is chosen in a synchronization.
@ -699,16 +722,16 @@ Bytes are read from the port if and only if the event is chosen in a
synchronization, and the returned match always represents contiguous
bytes in the port's stream. If not-yet-available bytes from the port
might contribute to the match, the event is not ready. Similarly, if
@scheme[pattern] begins with a start-of-stream @litchar{^} and the
@scheme[pattern] does not initially match, then the event cannot
@racket[pattern] begins with a start-of-stream @litchar{^} and the
@racket[pattern] does not initially match, then the event cannot
become ready until bytes have been read from the port.
The event can be synchronized multiple times---even concurrently---and
each synchronization corresponds to a distinct match request.
The @scheme[in] port must support progress events. If @scheme[in]
The @racket[in] port must support progress events. If @racket[in]
returns a special non-byte value during the match attempt, it is
treated like @scheme[eof].}
treated like @racket[eof].}
@; ----------------------------------------------------------------------
@ -720,35 +743,35 @@ treated like @scheme[eof].}
[out output-port?])
void?]{
Reads data from @scheme[in], converts it using
@scheme[(bytes-open-converter from-encoding-string
Reads data from @racket[in], converts it using
@racket[(bytes-open-converter from-encoding-string
to-encoding-string)] and writes the converted bytes to
@scheme[out]. The @scheme[convert-stream] procedure returns after
reaching @scheme[eof] in @scheme[in].
@racket[out]. The @racket[convert-stream] procedure returns after
reaching @racket[eof] in @racket[in].
If opening the converter fails, the @exnraise[exn:fail]. Similarly, if
a conversion error occurs at any point while reading @scheme[in], then
a conversion error occurs at any point while reading @racket[in], then
@exnraise[exn:fail].}
@defproc[(copy-port [in input-port?] [out output-port?] ...+) void?]{
Reads data from @scheme[in] and writes it back out to @scheme[out],
returning when @scheme[in] produces @scheme[eof]. The copy is
Reads data from @racket[in] and writes it back out to @racket[out],
returning when @racket[in] produces @racket[eof]. The copy is
efficient, and it is without significant buffer delays (i.e., a byte
that becomes available on @scheme[in] is immediately transferred to
@scheme[out], even if future reads on @scheme[in] must block). If
@scheme[in] produces a special non-byte value, it is transferred to
@scheme[out] using @scheme[write-special].
that becomes available on @racket[in] is immediately transferred to
@racket[out], even if future reads on @racket[in] must block). If
@racket[in] produces a special non-byte value, it is transferred to
@racket[out] using @racket[write-special].
This function is often called from a ``background'' thread to
continuously pump data from one stream to another.
If multiple @scheme[out]s are provided, case data from @scheme[in] is
written to every @scheme[out]. The different @scheme[out]s block
output to each other, because each block of data read from @scheme[in]
is written completely to one @scheme[out] before moving to the next
@scheme[out]. The @scheme[out]s are written in the provided order, so
If multiple @racket[out]s are provided, case data from @racket[in] is
written to every @racket[out]. The different @racket[out]s block
output to each other, because each block of data read from @racket[in]
is written completely to one @racket[out] before moving to the next
@racket[out]. The @racket[out]s are written in the provided order, so
non-blocking ports (e.g., to a file) should be placed first in the
argument list.}

38
collects/setup/parallel-do.rkt
View File

@ -23,6 +23,16 @@
wrkr/send
define/class/generics)
(define-syntax-rule (mk-generic func clss method args ...)
(begin
(define g (generic clss method))
(define (func obj args ...)
(send-generic obj g args ...))))
(define-syntax-rule (define/class/generics class (func method args ...) ...)
(begin
(mk-generic func class method args ...) ...))
(define Worker% (class object%
(field [id 0]
[process-handle null]
@ -30,7 +40,7 @@
[in null]
[err null])
(define/public (spawn _id worker-cmdline-list initialcode initialmsg)
(define/public (spawn _id worker-cmdline-list [initialcode #f] [initialmsg #f])
(let-values ([(_process-handle _out _in _err) (apply subprocess #f #f (current-error-port) worker-cmdline-list)])
(set! id _id)
(set! process-handle _process-handle)
@ -49,9 +59,17 @@
(close-output-port in)
(close-input-port out)
(subprocess-kill process-handle #t))
(define/public (kill/respawn worker-cmdline-list [initialcode #f] [initialmsg #f])
(kill)
(spawn id worker-cmdline-list [initialcode #f] [initialmsg #f]))
(define/public (wait) (subprocess-wait process-handle))
(super-new)))
(define (wrkr/spawn id worker-cmdline-list [initialcode #f] [initialmsg #f])
(define wrkr (new Worker%))
(send wrkr spawn id worker-cmdline-list initialcode initialmsg)
wrkr)
(define WorkQueue<%> (interface ()
get-job
work-done
@ -59,23 +77,12 @@
jobs-cnt
get-results))
(define-syntax-rule (mk-generic func clss method args ...)
(begin
(define g (generic clss method))
(define (func obj args ...)
(send-generic obj g args ...))))
(define-syntax-rule (define/class/generics class (func method args ...) ...)
(begin
(mk-generic func class method args ...) ...))
(define/class/generics Worker%
(wrkr/send send/msg msg)
(wrkr/kill kill)
(wrkr/recv recv/msg)
(wrkr/id get-id)
(wrkr/out get-out)
(wrkr/spawn spawn id worker-cmdline-list initialcode initialmsg))
(wrkr/out get-out))
(define/class/generics WorkQueue<%>
(queue/get get-job wrkrid)
@ -95,10 +102,7 @@
(find-system-path 'orig-dir))))))
(define (parallel-do-event-loop initialcode initialmsg worker-cmdline-list jobqueue nprocs stopat)
(define (spawn id)
(define wrkr (new Worker%))
(wrkr/spawn wrkr id worker-cmdline-list initialcode initialmsg)
wrkr)
(define (spawn id) (wrkr/spawn id worker-cmdline-list initialcode initialmsg))
(define (jobs?) (queue/has jobqueue))
(define (empty?) (not (queue/has jobqueue)))
(define workers #f)

114
collects/syntax-color/module-lexer.rkt
View File

@ -1,52 +1,78 @@
#lang scheme/base
(require scheme/port
"scheme-lexer.rkt")
(provide module-lexer)
#|
mode : (or/c #f 'before-lang-line
'no-lang-line
(cons lexer mode)
lexer)
the module lexer tracks any white-space and comments before
the #lang line (if any) explicitly by wrapping calls to the
scheme-lexer (in #f or 'before-lang-line mode).
Once it finds a non-white-space and non-comment
token, it checks to see if there is a #lang line and, if so
changes the mode to be the lexer that the #lang indicates,
delegating to it (the last two modes listed above).
If there is no #lang line, then it continues
to delegate to the scheme-lexer (in the 'no-lang-line mode).
|#
(define (module-lexer in offset mode)
(cond
[(not mode)
;; Starting out: look for #lang:
(let*-values ([(p) (peeking-input-port in)]
[(init) (file-position p)]
[(start-line start-col start-pos) (port-next-location p)])
(let ([get-info (with-handlers ([exn:fail? (lambda (exn) 'fail)])
(read-language p (lambda () #f)))]
[sync-ports (lambda ()
(read-bytes (- (file-position p) init) in))])
[(or (not mode) (eq? mode 'before-lang-line))
(define lexer-port (peeking-input-port in))
(port-count-lines! lexer-port)
(define-values (lexeme type data raw-new-token-start raw-new-token-end) (scheme-lexer lexer-port))
(define new-token-start (and raw-new-token-start (+ raw-new-token-start (file-position in))))
(define new-token-end (and raw-new-token-end (+ raw-new-token-end (file-position in))))
(cond
[(or (eq? type 'comment) (eq? type 'white-space))
(define lexer-end (file-position lexer-port))
(read-string lexer-end in) ;; sync ports
(values lexeme type data new-token-start new-token-end 0 'before-lang-line)]
[else
;; look for #lang:
(define p (peeking-input-port in))
(port-count-lines! p)
(define get-info (with-handlers ([exn:fail? values]) (read-language p (λ () 'fail))))
(cond
[(procedure? get-info)
;; Produce language as first token:
(sync-ports)
(let-values ([(end-line end-col end-pos) (port-next-location in)])
(values
"#lang"
'other
#f
start-pos
end-pos
0
(or (let ([v (get-info 'color-lexer #f)])
(and v
(if (procedure-arity-includes? v 3)
(cons v #f)
v)))
scheme-lexer)))]
[(eq? 'fail get-info)
(sync-ports)
(let*-values ([(end-line end-col end-pos) (port-next-location in)])
(values #f 'error #f start-pos end-pos 0 scheme-lexer))]
[else
;; Start over using the Scheme lexer
(module-lexer in offset scheme-lexer)])))]
[(pair? mode)
;; #lang-selected language consumes and produces a mode:
(let-values ([(lexeme type data new-token-start new-token-end backup-delta new-mode)
((car mode) in offset (cdr mode))])
(values lexeme type data new-token-start new-token-end backup-delta (cons (car mode) new-mode)))]
[else
;; #lang-selected language (or default) doesn't deal with modes:
(let-values ([(lexeme type data new-token-start new-token-end)
(mode in)])
(values lexeme type data new-token-start new-token-end 0 mode))]))
[(procedure? get-info)
(define end-pos (file-position p))
(read-string end-pos in) ;; sync ports
;; Produce language as first token:
(values
"#lang"
'other
#f
1 ;; start-pos
(+ end-pos 1)
0
(or (let ([v (get-info 'color-lexer #f)])
(and v
(if (procedure-arity-includes? v 3)
(cons v #f)
v)))
scheme-lexer))]
[else
(read-string (file-position lexer-port) in) ;; sync ports
(values lexeme type data new-token-start new-token-end 0 'no-lang-line)])])]
[(eq? mode 'no-lang-line)
(let-values ([(lexeme type data new-token-start new-token-end)
(scheme-lexer in)])
(values lexeme type data new-token-start new-token-end 0 'no-lang-line))]
[(pair? mode)
;; #lang-selected language consumes and produces a mode:
(let-values ([(lexeme type data new-token-start new-token-end backup-delta new-mode)
((car mode) in offset (cdr mode))])
(values lexeme type data new-token-start new-token-end backup-delta (cons (car mode) new-mode)))]
[else
;; #lang-selected language (or default) doesn't deal with modes:
(let-values ([(lexeme type data new-token-start new-token-end)
(mode in)])
(values lexeme type data new-token-start new-token-end 0 mode))]))

12
collects/tests/racket/contract-test.rktl
View File

@ -3533,6 +3533,18 @@
(reverse x))
'(3 1 2 4))
(test/spec-passed/result
'and/c-isnt
'(and (regexp-match #rx"isn't even?"
(with-handlers ((exn:fail? exn-message))
(contract (and/c integer? even? positive?)
-3
'pos
'neg)
"not the error!"))
#t)
#t)
(test/spec-passed
'contract-flat1
'(contract not #f 'pos 'neg))