From 4459d51f149a26cf34e473db70bd001bc3ac6bc2 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 24 Apr 2017 20:55:15 -0700 Subject: [PATCH] Fix previous change to add close operation to non-channel sink. Also add support for sources. --- src/runtime/binary-port.scm | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/src/runtime/binary-port.scm b/src/runtime/binary-port.scm index 34466a09c..a77236313 100644 --- a/src/runtime/binary-port.scm +++ b/src/runtime/binary-port.scm @@ -725,7 +725,7 @@ USA. (lambda () unspecific) (list->vector custom))) -(define (make-non-channel-ss flavor custom) +(define (make-non-channel-ss flavor close . custom) (let ((port #f) (open? #t)) (make-source/sink flavor @@ -733,7 +733,14 @@ USA. (lambda () port) (lambda (port*) (set! port port*) unspecific) (lambda () open?) - (lambda () (set! open? #f) unspecific) + (if (default-object? close) + (lambda () + (set! open? #f) + unspecific) + (lambda () + (close) + (set! open? #f) + unspecific)) (list->vector custom)))) (define (source/sink-port source/sink) @@ -756,8 +763,9 @@ USA. (lambda () (channel-has-input? channel)) (lambda (bv bs be) (channel-read channel bv bs be)))) -(define (make-non-channel-input-source has-bytes? read-bytes! . custom) - (make-non-channel-ss 'source has-bytes? read-bytes! custom)) +(define (make-non-channel-input-source has-bytes? read-bytes! + #!optional close . custom) + (apply make-non-channel-ss 'source close has-bytes? read-bytes! custom)) (define (input-source? object) (and (source/sink? object) @@ -793,8 +801,8 @@ USA. (lambda (bv bs be) (channel-write channel bv bs be)) (lambda () unspecific))) -(define (make-non-channel-output-sink write-bytes close . custom) - (make-non-channel-ss 'sink write-bytes close custom)) +(define (make-non-channel-output-sink write-bytes #!optional close . custom) + (apply make-non-channel-ss 'sink close write-bytes custom)) (define (output-sink? object) (and (source/sink? object) @@ -808,16 +816,13 @@ USA. (define output-sink-port source/sink-port) (define set-output-sink-port! set-source/sink-port!) (define output-sink-open? source/sink-open?) +(define close-output-sink close-source/sink) (define (output-sink-write-bytes sink bv bs be) ((vector-ref (source/sink-custom sink) 0) bv bs be)) -(define (close-output-sink sink) - ((vector-ref (source/sink-custom sink) 1)) - (close-source/sink sink)) - (define (output-sink-custom-length sink) - (fix:- (vector-length (source/sink-custom sink)) 2)) + (fix:- (vector-length (source/sink-custom sink)) 1)) (define (output-sink-custom-ref sink index) - (vector-ref (source/sink-custom sink) (fix:+ index 2))) \ No newline at end of file + (vector-ref (source/sink-custom sink) (fix:+ index 1))) \ No newline at end of file -- 2.25.1