diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss index ac99417..526593c 100644 --- a/collects/mzlib/class.ss +++ b/collects/mzlib/class.ss @@ -2041,9 +2041,9 @@ ; corresponding method is overridden in the object's class relative to ; the primitive class, #f otherwise. ; - ; When a primitive class have a primitive superclass, the - ; struct:prim maker is responsible for ensuring that the returned - ; struct items match the supertype predicate. + ; When a primitive class has a superclass, the struct:prim maker + ; is responsible for ensuring that the returned struct items match + ; the supertype predicate. (compose-class name (or super object%) diff --git a/collects/mzlib/string.ss b/collects/mzlib/string.ss index a83a7be..b3b1e29 100644 --- a/collects/mzlib/string.ss +++ b/collects/mzlib/string.ss @@ -101,13 +101,9 @@ (define expr->string (lambda (v) - (let* ([s ""] - [write-to-s - (lambda (str) - (set! s (string-append s str)))] - [port (make-output-port write-to-s (lambda () #f))]) + (let ([port (open-output-string)]) (write v port) - s))) + (get-output-string port)))) (define regexp-quote (opt-lambda (s [case-sens? #t]) diff --git a/collects/mzlib/thread.ss b/collects/mzlib/thread.ss index 17e89d5..0bfdce1 100644 --- a/collects/mzlib/thread.ss +++ b/collects/mzlib/thread.ss @@ -97,17 +97,27 @@ thunk (lambda () (semaphore-post sema)))))))) - (define (copy-port src dest) + (define (copy-port src dest . dests) + (unless (input-port? src) + (raise-type-error 'copy-port "input-port" src)) + (for-each + (lambda (dest) + (unless (output-port? dest) + (raise-type-error 'copy-port "output-port" dest))) + (cons dest dests)) (let ([s (make-string 4096)]) (let loop () (let ([c (read-string-avail! s src)]) (unless (eof-object? c) - (let loop ([start 0]) - (unless (= start c) - (let ([c2 (write-string-avail s dest start c)]) - (loop (+ start c2))))) + (for-each + (lambda (dest) + (let loop ([start 0]) + (unless (= start c) + (let ([c2 (write-string-avail s dest start c)]) + (loop (+ start c2)))))) + (cons dest dests)) (loop)))))) - + (define merge-input (case-lambda [(a b) (merge-input a b 4096)]