12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273 |
- (import
- ;; ports
- (ice-9 popen)
- (ice-9 textual-ports)
- (ice-9 binary-ports)
- (ice-9 exceptions)
- ;; receive form
- ;; (ice-9 receive)
- ;; pattern matching
- (ice-9 match)
- ;; concurrency
- (ice-9 threads)
- (ice-9 futures)
- ;; let-values form
- (srfi srfi-11))
- (define-values (in out)
- (match-let ([(in . out) (pipe)])
- ;; make out line buffered
- (setvbuf out 'none)
- (values in out)))
- (define seconds
- (λ (s)
- (* s (expt 10 6))))
- (define endless-writer
- (λ (out)
- (let loop ()
- ;; (simple-format #t "writer: writing message to output port\n")
- (put-string out "Hello!\n")
- ;; forcing the output should be unnecessary
- ;; (force-output out)
- (usleep (seconds 1))
- (loop))
- 'never))
- (define reader
- (lambda* (in-port #:key (bytes-count 1024) (out-port (current-output-port)))
- "Read from an IN-PORT and write to OUT-PORT, BYTES-COUNT
- bytes at a time."
- (let loop ([bv (get-bytevector-n in-port bytes-count)])
- ;; (simple-format #t "reader: reading from in-port\n")
- (unless (eof-object? bv)
- (put-bytevector out-port bv)
- (loop (get-bytevector-n in-port bytes-count))))))
- (define line-reader
- (lambda* (in-port #:key (out-port (current-output-port)))
- "Read from an IN-PORT and write to OUT-PORT."
- (let loop ([line (get-line in-port)])
- ;; (simple-format #t "reader: reading from in-port\n")
- (unless (eof-object? line)
- (simple-format out-port "~a\n" line)
- ;;(put-string out-port (string-append line "\n"))
- (loop (get-line in-port))))))
- ;; Start writing and reading endlessly.
- (define writer-future (future (endless-writer out)))
- (define reader-future (future (line-reader in #:out-port (current-output-port))))
- ;; Read from in-port, which should be the corresponding one to the
- ;; out-port, to which the endless-writer writes its output. Output to
- ;; the current output port, so that the output is visible. Read some
- ;; number of bytes at once. Limits the amount of memory needed for the
- ;; string.
|