srfi-66.scm 1.5 KB

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