srfi-66.scm 1.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. ; Part of Scheme 48 1.9. See file COPYING for notices and license.
  2. ; Authors: Mike Sperber, Robert Ransom
  3. ; SRFI 66: Octet vectors
  4. (define (make-u8vector k fill)
  5. (make-byte-vector k fill))
  6. (define u8vector? byte-vector?)
  7. (define (list->u8vector octets)
  8. (let* ((size (length octets))
  9. (v (make-byte-vector size 0)))
  10. (do ((i 0 (+ 1 i))
  11. (l octets (cdr l)))
  12. ((>= i size))
  13. (byte-vector-set! v i (car l)))
  14. v))
  15. (define (u8vector->list octets)
  16. (let loop ((n (byte-vector-length octets)) (r '()))
  17. (if (zero? n)
  18. r
  19. (loop (- n 1) (cons (byte-vector-ref octets (- n 1)) r)))))
  20. (define u8vector byte-vector)
  21. (define u8vector-length byte-vector-length)
  22. (define u8vector-ref byte-vector-ref)
  23. (define u8vector-set! byte-vector-set!)
  24. (define (u8vector-copy! source source-start target target-start count)
  25. (copy-bytes! source source-start target target-start count))
  26. (define (u8vector-copy u8vector)
  27. (let* ((size (byte-vector-length u8vector))
  28. (copy (make-byte-vector size 0)))
  29. (u8vector-copy! u8vector 0 copy 0 size)
  30. copy))
  31. (define u8vector=? byte-vector=?)
  32. (define (u8vector-compare u8vector-1 u8vector-2)
  33. (let ((length-1 (u8vector-length u8vector-1))
  34. (length-2 (u8vector-length u8vector-2)))
  35. (cond
  36. ((< length-1 length-2) -1)
  37. ((> length-1 length-2) 1)
  38. (else
  39. (let loop ((i 0))
  40. (if (= i length-1)
  41. 0
  42. (let ((elt-1 (u8vector-ref u8vector-1 i))
  43. (elt-2 (u8vector-ref u8vector-2 i)))
  44. (cond ((< elt-1 elt-2) -1)
  45. ((> elt-1 elt-2) 1)
  46. (else (loop (+ i 1)))))))))))