Changeset 30653 in project


Ignore:
Timestamp:
04/05/14 23:50:10 (7 years ago)
Author:
evhan
Message:

r7rs/base: Bytevector ports (credit to Seth Alves)

Location:
release/4/r7rs/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/r7rs/trunk/scheme.base-interface.scm

    r30338 r30653  
    5959  for-each
    6060  gcd lcm
    61   #|
    6261  get-output-bytevector
    63   |#
    6462  get-output-string
    6563  guard
     
    9795  number->string string->number
    9896  number?
    99   #|
    10097  open-input-bytevector open-output-bytevector
    101   |#
    10298  open-input-string open-output-string
    10399  or
  • release/4/r7rs/trunk/scheme.base.scm

    r30579 r30653  
    2323                (make-u8vector make-bytevector)
    2424                (write-u8vector write-bytevector)))
     25
     26(import (only ports make-input-port make-output-port))
    2527
    2628(%include "scheme.base-interface.scm")
     
    785787       (read-u8vector!/eof (fx- end start) bv port start)))))
    786788
     789(define (open-input-bytevector bv)
     790  (let ((index 0)
     791        (bv-len (bytevector-length bv)))
     792    (make-input-port
     793     (lambda () ; read-char
     794       (if (= index bv-len)
     795           (eof-object)
     796           (let ((c (bytevector-u8-ref bv index)))
     797             (set! index (+ index 1))
     798             (integer->char c))))
     799     (lambda () ; char-ready?
     800       (not (= index bv-len)))
     801     (lambda () #t) ; close
     802     (lambda () ; peek-char
     803       (if (= index bv-len)
     804           (eof-object)
     805           (bytevector-u8-ref bv index))))))
     806
     807(define (open-output-bytevector) (open-output-string))
     808
     809(define (get-output-bytevector p)
     810  (string->utf8 (get-output-string p)))
     811
    787812)
  • release/4/r7rs/trunk/tests/run.scm

    r30325 r30653  
    974974                 (begin (eq? numbers#+ +)))))
    975975
     976
     977(test-group "open-input-bytevector"
     978  (test (bytevector 0 1 2 10 13 40 41 42 128 140 240 255)
     979        (let ((bv (bytevector 0 1 2 10 13 40 41 42 128 140 240 255)))
     980          (read-bytevector 12 (open-input-bytevector bv)))))
     981
     982(test-group "open-output-bytevector"
     983  (test (bytevector 0 1 2 10 13 40 41 42 128 140 240 255)
     984        (let ((p (open-output-bytevector)))
     985          (write-bytevector (bytevector 0 1 2 10 13) p)
     986          (write-bytevector (bytevector 40 41 42 128) p)
     987          (write-bytevector (bytevector 140 240 255) p)
     988          (close-output-port p)
     989          (get-output-bytevector p))))
     990
    976991(test-end "r7rs tests")
    977992
Note: See TracChangeset for help on using the changeset viewer.