From e958a5af7ad7cfae58f0afc3a7e2e0c801d0fdad Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 11 Feb 2008 14:27:42 +0000 Subject: [PATCH] more mzlib scribbling svn: r8621 --- collects/mzlib/scribblings/mzlib.scrbl | 39 ++++++ collects/mzlib/scribblings/struct.scrbl | 2 - collects/mzlib/scribblings/surrogate.scrbl | 76 +++++++++++ collects/mzlib/scribblings/thread.scrbl | 141 +++++++++++++++++++++ collects/mzlib/scribblings/trace.scrbl | 48 +++++++ collects/mzlib/scribblings/traceld.scrbl | 22 ++++ collects/mzlib/scribblings/transcr.scrbl | 22 ++++ collects/mzlib/traceld.ss | 70 ++++------ 8 files changed, 371 insertions(+), 49 deletions(-) create mode 100644 collects/mzlib/scribblings/surrogate.scrbl create mode 100644 collects/mzlib/scribblings/thread.scrbl create mode 100644 collects/mzlib/scribblings/trace.scrbl create mode 100644 collects/mzlib/scribblings/traceld.scrbl create mode 100644 collects/mzlib/scribblings/transcr.scrbl diff --git a/collects/mzlib/scribblings/mzlib.scrbl b/collects/mzlib/scribblings/mzlib.scrbl index 8b5b54c3dd..f6eb0378e2 100644 --- a/collects/mzlib/scribblings/mzlib.scrbl +++ b/collects/mzlib/scribblings/mzlib.scrbl @@ -230,6 +230,45 @@ Re-exports @schememodname[scheme/shared]. @; ---------------------------------------------------------------------- +@mzlib[stxparam] + +Re-exports @schememodname[scheme/stxparam] and +@schememodname[scheme/stxparam-exptime] (both at phase level 0). + +@; ---------------------------------------------------------------------- + +@include-section["surrogate.scrbl"] + +@; ---------------------------------------------------------------------- + +@mzlib[tar] + +Re-exports @schememodname[file/tar]. + +@; ---------------------------------------------------------------------- + +@include-section["thread.scrbl"] + +@; ---------------------------------------------------------------------- + +@include-section["trace.scrbl"] + +@; ---------------------------------------------------------------------- + +@include-section["traceld.scrbl"] + +@; ---------------------------------------------------------------------- + +@mzlib[trait] + +Re-exports @schememodname[scheme/trait]. + +@; ---------------------------------------------------------------------- + +@include-section["transcr.scrbl"] + +@; ---------------------------------------------------------------------- + @(bibliography (bib-entry #:key "Shivers06" diff --git a/collects/mzlib/scribblings/struct.scrbl b/collects/mzlib/scribblings/struct.scrbl index 4569ed4e9b..2bff7dc9ed 100644 --- a/collects/mzlib/scribblings/struct.scrbl +++ b/collects/mzlib/scribblings/struct.scrbl @@ -12,8 +12,6 @@ @mzlib[#:mode title struct] -@section[#:tag "mzlib:struct"]{Structure Utilities} - @defform[(copy-struct struct-id struct-expr (accessor-id field-expr) ...)]{ diff --git a/collects/mzlib/scribblings/surrogate.scrbl b/collects/mzlib/scribblings/surrogate.scrbl new file mode 100644 index 0000000000..a6fa1a7032 --- /dev/null +++ b/collects/mzlib/scribblings/surrogate.scrbl @@ -0,0 +1,76 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/surrogate + mzlib/class)) + +@mzlib[#:mode title surrogate] + +The @schememodname[mzlib/surrogate] library provides an abstraction +for building an instance of the @deftech{proxy design pattern}. The +pattern consists of two objects, a @defterm{host} and a +@defterm{surrogate} object. The host object delegates method calls to +its surrogate object. Each host has a dynamically assigned surrogate, +so an object can completely change its behavior merely by changing the +surrogate. + +@defform/subs[#:literals (override override-final) + (surrogate method-spec ...) + ([method-spec (method-id arg-spec ...) + (override method-id arg-spec ...) + (override-final method-id (lambda () default-expr) + arg-spec ...)] + [arg-spec (id ...) + id])]{ + +If neither @scheme[override] nor @scheme[override-final] is specified +for a @scheme[method-id], then @scheme[override] is assumed. + +The @scheme[surrogate] form produces four values: a host mixin (a +procedure that accepts and returns a class), a host interface, a +surrogate class, and a surrogate interface. + +The host mixin adds one additional field, @scheme[surrogate], to its +argument. It also adds a getter method, @scheme[get-surrogate], and a +setter method, @scheme[set-surrogate], for changing the field. The +@scheme[set-surrogate] form accepts instances the class returned by +the form or @scheme[#f], and updates the field with its +argument. Then, it calls the @scheme[on-disable-surrogate] on the +previous value of the field and @scheme[on-enable-surrogate] for the +new value of the field. The @scheme[get-surrogate] method returns the +current value of the field. + +The host mixin has a single overriding method for each +@scheme[method-id] in the @scheme[surrogate] form. Each of these +methods is defined with a @scheme[case-lambda] with one arm for each +@scheme[arg-spec]. Each arm has the variables as arguments in the +@scheme[arg-spec]. The body of each method tests the +@scheme[surrogate] field. If it is @scheme[#f], the method just +returns the result of invoking the super or inner method. If the +@scheme[surrogate] field is not @scheme[#f], the corresponding method +of the object in the field is invoked. This method receives the same +arguments as the original method, plus two extras. The extra arguments +come at the beginning of the argument list. The first is the original +object. The second is a procedure that calls the super or inner method +(i.e., the method of the class that is passed to the mixin or an +extension, or the method in an overriding class), with the arguments +that the procedure receives. + +The host interface has the names @scheme[set-surrogate], +@scheme[get-surrogate], and each of the @scheme[method-id]s in the +original form. + +The surrogate class has a single public method for each +@scheme[method-id] in the @scheme[surrogate] form. These methods are +invoked by classes constructed by the mixin. Each has a corresponding +method signature, as described in the above paragraph. Each method +just passes its argument along to the super procedure it receives. + +Note: if you derive a class from the surrogate class, do not both call +the @scheme[super] argument and the super method of the surrogate +class itself. Only call one or the other, since the default methods +call the @scheme[super] argument. + +Finally, the interface contains all of the names specified in +surrogate's argument, plus @scheme[on-enable-surrogate] and +@scheme[on-disable-surrogate]. The class returned by +@scheme[surrogate] implements this interface.} diff --git a/collects/mzlib/scribblings/thread.scrbl b/collects/mzlib/scribblings/thread.scrbl new file mode 100644 index 0000000000..177731dae0 --- /dev/null +++ b/collects/mzlib/scribblings/thread.scrbl @@ -0,0 +1,141 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/thread + scheme/contract + scheme/tcp)) + +@mzlib[#:mode title thread] + +@defproc[(coroutine [proc ((any/c . -> . void?) . -> . any/c)]) + coroutine?]{ + +Returns a coroutine object to encapsulate a thread that runs only when +allowed. The @scheme[proc] procedure should accept one argument, and +@scheme[proc] is run in the coroutine thread when +@scheme[coroutine-run] is called. If @scheme[coroutine-run] returns +due to a timeout, then the coroutine thread is suspended until a +future call to @scheme[coroutine-run]. Thus, @scheme[proc] only +executes during the dynamic extent of a @scheme[coroutine-run] call. + +The argument to @scheme[proc] is a procedure that takes a boolean, and +it can be used to disable suspends (in case @scheme[proc] has critical +regions where it should not be suspended). A true value passed to the +procedure enables suspends, and @scheme[#f] disables +suspends. Initially, suspends are allowed.} + + +@defproc[(coroutine? [v any/c]) any]{ + +Returns @scheme[#t] if @scheme[v] is a coroutine produced by +@scheme[coroutine], @scheme[#f] otherwise.} + + +@defproc[(coroutine-run [timeout-secs real?][coroutine coroutine?]) + boolean?]{ + +Allows the thread associated with @scheme[coroutine] to execute for up +to @scheme[timeout-secs]. If @scheme[coroutine]'s procedure disables +suspends, then the coroutine can run arbitrarily long until it +re-enables suspends. + +The @scheme[coroutine-run] procedure returns @scheme[#t] if +@scheme[coroutine]'s procedure completes (or if it completed earlier), +and the result is available via @scheme[coroutine-result]. The +@scheme[coroutine-run] procedure returns @scheme[#f] if +@scheme[coroutine]'s procedure does not complete before it is +suspended after @scheme[timeout-secs]. If @scheme[coroutine]'s +procedure raises an exception, then it is re-raised by +@scheme[coroutine-run].} + + +@defproc[(coroutine-result [coroutine coroutine]) any]{ + +Returns the result for @scheme[coroutine] if it has completed with a +value (as opposed to an exception), @scheme[#f] otherwise.} + + +@defproc[(coroutine-kill [coroutine coroutine?]) void?]{ + +Forcibly terminates the thread associated with @scheme[coroutine] if +it is still running, leaving the coroutine result unchanged.} + + +@defproc[(consumer-thread [f procedure?][init (-> any) void]) + (values thread? procedure?)]{ + +Returns two values: a thread descriptor for a new thread, and a +procedure with the same arity as @scheme[f]. (The returned procedure +actually accepts any number of arguments, but immediately raises +@scheme[exn:fail:contract:arity] if @scheme[f] cannot accept the +provided number of arguments.) + +When the returned procedure is applied, its arguments are queued to be +passed on to @scheme[f], and @|void-const| is immediately returned. +The thread created by @scheme[consumer-thread] dequeues arguments and +applies @scheme[f] to them, removing a new set of arguments from the +queue only when the previous application of @scheme[f] has completed; +if @scheme[f] escapes from a normal return (via an exception or a +continuation), the @scheme[f]-applying thread terminates. + +The @scheme[init] argument is a procedure of no arguments; if it is +provided, @scheme[init] is called in the new thread immediately after the +thread is created.} + + +@defproc[(run-server [port-no (integer-in 1 65535)] + [conn-proc (input-port? output-port? . -> . any)] + [conn-timeout (and/c real? (not/c negative?))] + [handler (exn? . -> . any/c) void] + [listen ((integer-in 1 65535) (one-of/c 5) (one-of/c #t) + . -> . listener?) + tcp-listen] + [close (listener? . -> . any) tcp-close] + [accept (listener? . ->* . (input-port? output-port?)) tcp-accept] + [accept/break (listener? . ->* . (input-port? output-port?)) tcp-accept/enable-break]) + void?]{ + +Executes a TCP server on the port indicated by @scheme[port-no]. When +a connection is made by a client, @scheme[conn] is called with two +values: an input port to receive from the client, and an output port +to send to the client. + +Each client connection is managed by a new custodian, and each call to +@scheme[conn] occurs in a new thread (managed by the connection's +custodian). If the thread executing @scheme[conn] terminates for any +reason (e.g., @scheme[conn] returns), the connection's custodian is +shut down. Consequently, @scheme[conn] need not close the ports +provided to it. Breaks are enabled in the connection thread if breaks +are enabled when @scheme[run-server] is called. + +To facilitate capturing a continuation in one connection thread and +invoking it in another, the parameterization of the +@scheme[run-server] call is used for every call to +@scheme[handler]. In this parameterization and for the connection's +thread, the @scheme[current-custodian] parameter is assigned to the +connection's custodian. + +If @scheme[conn-timeout] is not @scheme[#f], then it must be a +non-negative number specifying the time in seconds that a connection +thread is allowed to run before it is sent a break signal. Then, if +the thread runs longer than @scheme[(* conn-timeout 2)] seconds, then +the connection's custodian is shut down. If @scheme[conn-timeout] is +@scheme[#f], a connection thread can run indefinitely. + +If @scheme[handler] is provided, it is passed exceptions related +to connections (i.e., exceptions not caught by @scheme[conn-proc], or +exceptions that occur when trying to accept a connection). The default +handler ignores the exception and returns @|void-const|. + +The @scheme[run-server] function uses @scheme[listen], @scheme[close], +@scheme[accept] and @scheme[accept/break] in the same way as it might +use @scheme[tcp-listen], @scheme[tcp-close], @scheme[tcp-accept], and +@scheme[tcp-accept/enable-break] to accept connections. Provide +alternate procedures to use an alternate communication protocol (such +as SSL) or to supply optional arguments in the use of +@scheme[tcp-listen]. The @scheme[listener?] part of the contract +indicates that the procedures must all work on the same kind of +listener value. + +The @scheme[run-server] procedure loops to serve client connections, +so it never returns. If a break occurs, the loop will cleanly shut +down the server, but it will not terminate active connections.} diff --git a/collects/mzlib/scribblings/trace.scrbl b/collects/mzlib/scribblings/trace.scrbl new file mode 100644 index 0000000000..e2a2f6390d --- /dev/null +++ b/collects/mzlib/scribblings/trace.scrbl @@ -0,0 +1,48 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/trace)) + +@mzlib[#:mode title trace] + +The @schememodname[mzlib/trace] library mimics the tracing facility +available in Chez Scheme. + +@defform[(trace id ...)]{ + +Each @scheme[id] must be bound to a procedure in the environment of +the @scheme[trace] expression. Each @scheme[id] is @scheme[set!]ed to +a new procedure that traces procedure calls and returns by printing +the arguments and results of the call. If multiple values are +returned, each value is displayed starting on a separate line. + +When traced procedures invoke each other, nested invocations are shown +by printing a nesting prefix. If the nesting depth grows to ten and +beyond, a number is printed to show the actual nesting depth. + +The @scheme[trace] form can be used on an identifier that is already +traced. In this case, assuming that the variable's value has not been +changed, @scheme[trace] has no effect. If the variable has been +changed to a different procedure, then a new trace is installed. + +Tracing respects tail calls to preserve loops, but its effect may be +visible through continuation marks. When a call to a traced procedure +occurs in tail position with respect to a previous traced call, then +the tailness of the call is preserved (and the result of the call is +not printed for the tail call, because the same result will be printed +for an enclosing call). Otherwise, however, the body of a traced +procedure is not evaluated in tail position with respect to a call to +the procedure. + +The result of a @scheme[trace] expression is @|void-const|.} + +@defform[(untrace id ...)]{ + +Undoes the effects of the @scheme[trace] form for each @scheme[id], +@scheme[set!]ing each @scheme[id] back to the untraced procedure, but +only if the current value of @scheme[id] is a traced procedure. If +the current value of a @scheme[id] is not a procedure installed by +@scheme[trace], then the variable is not changed. + +The result of an @scheme[untrace] expression is @|void-const|.} + + diff --git a/collects/mzlib/scribblings/traceld.scrbl b/collects/mzlib/scribblings/traceld.scrbl new file mode 100644 index 0000000000..467922f5e2 --- /dev/null +++ b/collects/mzlib/scribblings/traceld.scrbl @@ -0,0 +1,22 @@ +#lang scribble/doc +@(require "common.ss") + +@mzlib[#:mode title traceld] + +The @schememodname[mzlib/traceld] library does not provide any +bindings. Instead, @schememodname[mzlib/traceld] is @scheme[require]d +for its side-effects. + +The @schememodname[mzlib/traceld] library installs a new load handler +(see @scheme[current-load]) and load-extension handler (see +@scheme[current-load-extension]) to print information about the files +that are loaded. These handlers chain to the current handlers to +perform the actual loads. Trace output is printed to the port that is +the current error port (see @scheme[current-error-port]) when the +library is instantiated. + +Before a file is loaded, the tracer prints the file name and ``time'' +(as reported by the procedure @scheme[current-process-milliseconds]) +when the load starts. Trace information for nested loads is printed +with indentation. After the file is loaded, the file name is printed +with the ``time'' that the load completed. diff --git a/collects/mzlib/scribblings/transcr.scrbl b/collects/mzlib/scribblings/transcr.scrbl new file mode 100644 index 0000000000..2d5488ea62 --- /dev/null +++ b/collects/mzlib/scribblings/transcr.scrbl @@ -0,0 +1,22 @@ +#lang scribble/doc +@(require "common.ss") + +@mzlib[#:mode title transcr] + +The @scheme[transcript-on] and @scheme[transcript-off] procedures of +@schememodname[mzscheme] always raise +@scheme[exn:fail:unsupported]. The @schememodname[mzlib/transcr] +library provides working versions of @scheme[transcript-on] and +@scheme[transcript-off]. + +@(define-syntax-rule (go) + (begin + (require (for-label mzlib/transcr)) + + @deftogether[( + @defproc[(transcript-on [filename any/c]) any] + @defproc[(transcript-off) any] + )]{ + + Starts/stops recording a transcript at @scheme[filename].})) +@(go) diff --git a/collects/mzlib/traceld.ss b/collects/mzlib/traceld.ss index 012d5439aa..f4a3f20c67 100644 --- a/collects/mzlib/traceld.ss +++ b/collects/mzlib/traceld.ss @@ -1,49 +1,25 @@ +#lang scheme/base -(module traceld scheme/base +(let ([load (current-load)] + [load-extension (current-load-extension)] + [ep (current-error-port)] + [tab ""]) + (let ([mk-chain + (lambda (load) + (lambda (filename expected-module) + (fprintf ep + "~aloading ~a at ~a~n" + tab filename (current-process-milliseconds)) + (begin0 + (let ([s tab]) + (dynamic-wind + (lambda () (set! tab (string-append " " tab))) + (lambda () + (load filename expected-module)) + (lambda () (set! tab s)))) + (fprintf ep + "~adone ~a at ~a~n" + tab filename (current-process-milliseconds)))))]) + (current-load (mk-chain load)) + (current-load-extension (mk-chain load-extension)))) - (let ([load (current-load)] - [load-extension (current-load-extension)] - [ep (current-error-port)] - [tab ""]) - (let ([mk-chain - (lambda (load) - (lambda (filename expected-module) - (fprintf ep - "~aloading ~a at ~a~n" - tab filename (current-process-milliseconds)) - (begin0 - (let ([s tab]) - (dynamic-wind - (lambda () (set! tab (string-append " " tab))) - (lambda () - (if (regexp-match #rx#"_loader" (path->bytes filename)) - (let ([f (load filename #f)]) - (lambda (sym) - (fprintf ep - "~atrying ~a's ~a~n" tab filename sym) - (let-values ([(loader provided-module) (f sym)]) - (values - (and loader - (lambda () - (fprintf ep - "~astarting ~a's ~a at ~a~n" - tab filename sym - (current-process-milliseconds)) - (let ([s tab]) - (begin0 - (dynamic-wind - (lambda () (set! tab (string-append " " tab))) - (lambda () (loader)) - (lambda () (set! tab s))) - (fprintf ep - "~adone ~a's ~a at ~a~n" - tab filename sym - (current-process-milliseconds)))))) - provided-module)))) - (load filename expected-module))) - (lambda () (set! tab s)))) - (fprintf ep - "~adone ~a at ~a~n" - tab filename (current-process-milliseconds)))))]) - (current-load (mk-chain load)) - (current-load-extension (mk-chain load-extension)))))