~ chicken-r7rs (master) 8a04d4f5e2d528677272d75da4fb2e06c2ebc80a

commit 8a04d4f5e2d528677272d75da4fb2e06c2ebc80a
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sat Apr 5 21:50:10 2014 +0000
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sat Apr 5 21:50:10 2014 +0000

    Bytevector ports (credit to Seth Alves)

diff --git a/scheme.base-interface.scm b/scheme.base-interface.scm
index 89a95da..9f9cc5a 100644
--- a/scheme.base-interface.scm
+++ b/scheme.base-interface.scm
@@ -58,9 +58,7 @@
   flush-output-port
   for-each
   gcd lcm
-  #|
   get-output-bytevector
-  |#
   get-output-string
   guard
   if
@@ -96,9 +94,7 @@
   null?
   number->string string->number
   number?
-  #|
   open-input-bytevector open-output-bytevector
-  |#
   open-input-string open-output-string
   or
   pair?
diff --git a/scheme.base.scm b/scheme.base.scm
index ad59202..3074371 100644
--- a/scheme.base.scm
+++ b/scheme.base.scm
@@ -23,6 +23,8 @@
                 (make-u8vector make-bytevector)
                 (write-u8vector write-bytevector)))
 
+(import (only ports make-input-port make-output-port))
+
 (%include "scheme.base-interface.scm")
 
 ;; For syntax definition helpers.
@@ -784,4 +786,27 @@
       ((bv port start end)
        (read-u8vector!/eof (fx- end start) bv port start)))))
 
+(define (open-input-bytevector bv)
+  (let ((index 0)
+        (bv-len (bytevector-length bv)))
+    (make-input-port
+     (lambda () ; read-char
+       (if (= index bv-len)
+           (eof-object)
+           (let ((c (bytevector-u8-ref bv index)))
+             (set! index (+ index 1))
+             (integer->char c))))
+     (lambda () ; char-ready?
+       (not (= index bv-len)))
+     (lambda () #t) ; close
+     (lambda () ; peek-char
+       (if (= index bv-len)
+           (eof-object)
+           (bytevector-u8-ref bv index))))))
+
+(define (open-output-bytevector) (open-output-string))
+
+(define (get-output-bytevector p)
+  (string->utf8 (get-output-string p)))
+
 )
diff --git a/tests/run.scm b/tests/run.scm
index 3749247..66e93b4 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -973,6 +973,21 @@
                  (import (scheme base))
                  (begin (eq? numbers#+ +)))))
 
+
+(test-group "open-input-bytevector"
+  (test (bytevector 0 1 2 10 13 40 41 42 128 140 240 255)
+        (let ((bv (bytevector 0 1 2 10 13 40 41 42 128 140 240 255)))
+          (read-bytevector 12 (open-input-bytevector bv)))))
+
+(test-group "open-output-bytevector"
+  (test (bytevector 0 1 2 10 13 40 41 42 128 140 240 255)
+        (let ((p (open-output-bytevector)))
+          (write-bytevector (bytevector 0 1 2 10 13) p)
+          (write-bytevector (bytevector 40 41 42 128) p)
+          (write-bytevector (bytevector 140 240 255) p)
+          (close-output-port p)
+          (get-output-bytevector p))))
+
 (test-end "r7rs tests")
 
 (test-exit)