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

.

Browse Source 
original commit: 13ce85f6e2558557305d2031bf72e7db1be4b95c
This commit is contained in:
Matthew Flatt 2003-12-05 17:18:06 +00:00
parent 3b45b7165e
commit f7a6fde0db
1 changed files with 26 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/mzlib/thread.ss
View File

@ -12,6 +12,7 @@
merge-input merge-input
copy-port copy-port
wrap-input-ports
run-server run-server
make-limited-input-port) make-limited-input-port)
@ -190,6 +191,31 @@
(loop))) (loop)))
(lambda () (tcp-close l)))))) (lambda () (tcp-close l))))))
(define wrap-input-ports
(opt-lambda (ports [close-orig? #t])
(let ([go (lambda (op)
(if (null? ports)
eof
(let ([n (op (car ports))])
(cond
[(eq? n 0) (car ports)]
[(eof-object? n)
(when close-orig?
(close-input-port (car ports)))
(set! ports (cdr ports))
0]
[else n]))))])
(make-custom-input-port
(lambda (str)
(go (lambda (p)
(read-string-avail!* str p))))
(lambda (str skip)
(go (lambda (p)
(peek-string-avail!* str skip p))))
(lambda ()
(when close-orig?
(map close-input-port ports)))))))
(define make-limited-input-port (define make-limited-input-port
(opt-lambda (port limit [close-orig? #t]) (opt-lambda (port limit [close-orig? #t])
(let ([got 0]) (let ([got 0])