;;;
;;; gauche.uvector - uniform vectors
;;;
;;;   Copyright (c) 2000-2025  Shiro Kawai  <shiro@acm.org>
;;;
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;
;;;   1. Redistributions of source code must retain the above copyright
;;;      notice, this list of conditions and the following disclaimer.
;;;
;;;   2. Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;
;;;   3. Neither the name of the authors nor the names of its contributors
;;;      may be used to endorse or promote products derived from this
;;;      software without specific prior written permission.
;;;
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;

;; This module defines the superset of SRFI-4, homogeneous numeric vector
;; types.   Most of basic operations are defined in the DSO module libuvector.
;; Besides defining functions, the DSO sets up a reader hook to enable
;; extended syntax such as #s8(1 2 3).
;; This module also defines methods for collection and sequence frameworks.

;; NB: The following identifiers are defined in core now:
;;   uvector? ${TAG}vector-ref  ${TAG}vector-set!  uvector-ref  uvector-set!
;;   uvector-length    uvector-immutable?

(define-module gauche.uvector
  (use gauche.collection)
  (use gauche.sequence)

  (include "./exports")
  (export make-uvector

          open-output-uvector get-output-uvector port->uvector
          read-block! read-uvector read-uvector!
          read-bytevector read-bytevector!
          referencer

          ;; string <-> uvector operations are now in libvec.scm
          ;; we reexport them for the compatibility.
          string->s8vector string->s8vector!
          string->u8vector string->u8vector!
          string->s32vector string->s32vector!
          string->u32vector string->u32vector!
          s8vector->string u8vector->string
          s32vector->string u32vector->string

          uvector-alias uvector-segment/shared
          uvector-binary-search uvector-class-element-size
          uvector-copy uvector-copy! uvector-ref uvector-set! uvector-size
          uvector->list uvector->vector uvector-swap-bytes uvector-swap-bytes!
          list->uvector vector->uvector

          uvector-class-valid-element?

          write-block write-uvector write-bytevector

          ;; R7RS compatibility (scheme base) and (scheme bytevector)
          bytevector bytevector? make-bytevector bytevector-fill!
          bytevector-length bytevector-u8-ref bytevector-u8-set!
          bytevector-s8-ref bytevector-s8-set!
          bytevector->u8-list u8-list->bytevector
          bytevector-copy bytevector-copy! bytevector-copy!-r6
          bytevector-append bytevector=?
          ))
(select-module gauche.uvector)

;; gauche.vport is used by port->uvector.  Technically it's on top
;; of uniform vector ports provided by gauche.vport, but logically
;; it is expected to belong gauche.uvector.
(autoload gauche.vport open-output-uvector get-output-uvector)

;; referenced from SRFI-160 make-TAGvector-generator
(autoload gauche.generator uvector->generator)

(inline-stub
 (declcode
  (.include <math.h>)
  (.define EXTUVECTOR_EXPORTS)
  (.include "gauche/uvector.h")
  (.include "gauche/priv/vectorP.h")
  (.include "gauche/priv/bytesP.h")
  (.include "uvectorP.h")))

;; uvlib.scm is generated by uvlib.scm.tmpl
(include "./uvlib.scm")

;;;
;;; Generic procedures
;;;

;; uvector-alias
(inline-stub
 (define-cproc uvector-alias
   (klass::<class> v::<uvector> :optional (start::<fixnum> 0) (end::<fixnum> -1))
   Scm_UVectorAlias)

 (define-cproc uvector-segment/shared (v::<uvector> n::<fixnum>)
   (unless (> n 0)
     (Scm_Error "Positive exact integer required, but got: %d" n))
   (let* ([len::ScmSmallInt (SCM_UVECTOR_SIZE v)]
          [i::ScmSmallInt 0]
          [h SCM_NIL] [t SCM_NIL])
     (while (< i len)
       (let* ([vv (Scm_UVectorAlias (Scm_ClassOf (SCM_OBJ v))
                                    v i (?: (> (+ i n) len) len (+ i n)))])
         (SCM_APPEND1 h t vv))
       (set! i (+ i n)))
     (return h)))
 )

;; byte swapping
(inline-stub
 (define-cise-stmt swap-bytes-common
   [(_ c-fn v type)
    `(let* ([opt::int SWAPB_STD])
       (cond [(== ,type NULL)]
             [(SCM_EQ (SCM_OBJ ,type) 'le:arm-le) (= opt SWAPB_ARM_LE)]
             [(SCM_EQ (SCM_OBJ ,type) 'be:arm-le) (= opt SWAPB_ARM_BE)]
             [else (Scm_TypeError "type" "#f or a symbol le:arm-le or be:arm-le"
                                  (SCM_OBJ ,type))])
       (,c-fn ,v opt))])

 (define-cproc uvector-swap-bytes (v::<uvector> :optional (type::<symbol>? #f)) ::<void>
   (swap-bytes-common Scm_UVectorSwapBytes v type))

 (define-cproc uvector-swap-bytes! (v::<uvector> :optional (type::<symbol>? #f)) ::<void>
   (swap-bytes-common Scm_UVectorSwapBytesX v type))
 )

;; uvector-size
(inline-stub
 (define-cproc uvector-size (v::<uvector>
                             :optional (start::<fixnum> 0) (end::<fixnum> -1))
   ::<fixnum>
   (let* ([len::ScmSmallInt (SCM_UVECTOR_SIZE v)])
     (SCM_CHECK_START_END start end len)
     (return (* (- end start)
                (Scm_UVectorElementSize (Scm_ClassOf (SCM_OBJ v)))))))

 (define-cproc uvector-class-element-size (c::<class>) ::<fixnum>
   (let* ([r::int (Scm_UVectorElementSize c)])
     (when (< r 0)
       (Scm_Error "A class of uvector is required, but got: %S" c))
     (return r)))
 )

;; uvector->list
;; uvector->vector
(inline-stub
 (define-cproc uvector->list (v::<uvector>
                              :optional (start::<fixnum> 0)
                                        (end::<fixnum> -1))
   (return (Scm_UVectorToList v start end)))

 (define-cproc uvector->vector (v::<uvector>
                                :optional (start::<fixnum> 0)
                                          (end::<fixnum> -1))
   (return (Scm_UVectorToVector v start end)))

 ;; TODO: We may allow optional clam/start/end argumetns.
 (define-cproc list->uvector (klass::<class> elts)
   (return (Scm_ListToUVector klass elts SCM_CLAMP_ERROR)))

 (define-cproc vector->uvector (klass::<class> elts::<vector>)
   (return (Scm_VectorToUVector klass elts 0 -1 SCM_CLAMP_ERROR)))
 )

;; allocation by class
(inline-stub
 (define-cproc make-uvector (klass::<class> size::<fixnum>
                             :optional (init 0))
   (unless (>= size 0) (Scm_Error "invalid uvector size: %d" size))
   (let* ([v (Scm_MakeUVector klass size NULL)])
     (case (Scm_UVectorType klass)
       [(SCM_UVECTOR_S8)
        (Scm_S8VectorFill (SCM_S8VECTOR v)
                          (Scm_GetInteger8Clamp init SCM_CLAMP_ERROR NULL)
                          0 -1)]
       [(SCM_UVECTOR_U8)
        (Scm_U8VectorFill (SCM_U8VECTOR v)
                          (Scm_GetIntegerU8Clamp init SCM_CLAMP_ERROR NULL)
                          0 -1)]
       [(SCM_UVECTOR_S16)
        (Scm_S16VectorFill (SCM_S16VECTOR v)
                           (Scm_GetInteger16Clamp init SCM_CLAMP_ERROR NULL)
                           0 -1)]
       [(SCM_UVECTOR_U16)
        (Scm_U16VectorFill (SCM_U16VECTOR v)
                           (Scm_GetIntegerU16Clamp init SCM_CLAMP_ERROR NULL)
                           0 -1)]
       [(SCM_UVECTOR_S32)
        (Scm_S32VectorFill (SCM_S32VECTOR v)
                           (Scm_GetInteger32Clamp init SCM_CLAMP_ERROR NULL)
                           0 -1)]
       [(SCM_UVECTOR_U32)
        (Scm_U32VectorFill (SCM_U32VECTOR v)
                           (Scm_GetIntegerU32Clamp init SCM_CLAMP_ERROR NULL)
                           0 -1)]
       [(SCM_UVECTOR_S64)
        (Scm_S64VectorFill (SCM_S64VECTOR v)
                           (Scm_GetInteger64Clamp init SCM_CLAMP_ERROR NULL)
                           0 -1)]
       [(SCM_UVECTOR_U64)
        (Scm_U64VectorFill (SCM_U64VECTOR v)
                           (Scm_GetIntegerU64Clamp init SCM_CLAMP_ERROR NULL)
                           0 -1)]
       [(SCM_UVECTOR_F16)
        (Scm_F16VectorFill (SCM_F16VECTOR v)
                           (Scm_DoubleToHalf (Scm_GetDouble init))
                           0 -1)]
       [(SCM_UVECTOR_F32)
        (Scm_F32VectorFill (SCM_F32VECTOR v)
                           (cast float (Scm_GetDouble init))
                           0 -1)]
       [(SCM_UVECTOR_F64)
        (Scm_F64VectorFill (SCM_F64VECTOR v)
                           (Scm_GetDouble init)
                           0 -1)]
       [(SCM_UVECTOR_C32)
        (Scm_C32VectorFill (SCM_C32VECTOR v) (Scm_GetHalfComplex init) 0 -1)]
       [(SCM_UVECTOR_C64)
        (Scm_C64VectorFill (SCM_C64VECTOR v) (Scm_GetFloatComplex init) 0 -1)]
       [(SCM_UVECTOR_C128)
        (Scm_C128VectorFill (SCM_C128VECTOR v)
                            (Scm_GetDoubleComplex init) 0 -1)]
       [else (Scm_Error "[internal] Invalid uvector class: %S" klass)])
     (return v))))

;; generic copy
(inline-stub
 (define-cproc uvector-copy (v::<uvector>
                             :optional (start::<fixnum> 0)
                                       (end::<fixnum> -1))
   (return (Scm_UVectorCopy v start end)))
 )

;; search
;; rounding can be #f, 'floor or 'ceiling  (SRFI-114 also uses symbols
;; for rounding.  we don't use 'round and 'truncate, though, for
;; it doesn't make much sense.)
(inline-stub
 ;; aux fn to deal with optional fixnum arg.  we should make genstub handle
 ;; this in future.
 (define-cfn get-fixnum-arg (arg fallback::ScmSmallInt name::(const char*))
   ::ScmSmallInt :static
   (cond [(SCM_INTP arg) (return (SCM_INT_VALUE arg))]
         [(SCM_FALSEP arg) (return fallback)]
         [else (Scm_Error "%s expects fixnum or #f, but got: %S" name arg)
               (return 0)])) ; dummy

 (define-cproc uvector-binary-search (v::<uvector> key::<number>
                                                   :optional
                                                   (start #f)
                                                   (end   #f)
                                                   (skip  #f)
                                                   (rounding #f))
   (let* ([len::ScmSize (SCM_UVECTOR_SIZE v)]
          [s::ScmSmallInt (get-fixnum-arg start 0 "start")]
          [e::ScmSmallInt (get-fixnum-arg end -1 "end")]
          [p::ScmSmallInt (get-fixnum-arg skip 0 "skip")])
     (SCM_CHECK_START_END s e len)
     (unless (== (% (- e s) (+ p 1)) 0)
       (Scm_Error "uvector size (%d) isn't multiple of record size (%d)"
                  (- e s) (+ p 1)))
     (let* ([r::size_t (cast (size_t) -1)]
            [lb::size_t]
            [ub::size_t])
       (case (Scm_UVectorType (Scm_ClassOf (SCM_OBJ v)))
         [(SCM_UVECTOR_S8)
          (let* ([k::int8_t
                  (Scm_GetInteger8Clamp key SCM_CLAMP_ERROR NULL)])
            (set! r (Scm_BinarySearchS8 (+ (SCM_S8VECTOR_ELEMENTS v) s)
                                        (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_U8)
          (let* ([k::uint8_t
                  (Scm_GetIntegerU8Clamp key SCM_CLAMP_ERROR NULL)])
            (set! r (Scm_BinarySearchU8 (+ (SCM_U8VECTOR_ELEMENTS v) s)
                                        (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_S16)
          (let* ([k::int16_t
                  (Scm_GetInteger16Clamp key SCM_CLAMP_ERROR NULL)])
            (set! r (Scm_BinarySearchS16 (+ (SCM_S16VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_U16)
          (let* ([k::uint16_t
                  (Scm_GetIntegerU16Clamp key SCM_CLAMP_ERROR NULL)])
            (set! r (Scm_BinarySearchU16 (+ (SCM_U16VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_S32)
          (let* ([k::int32_t
                  (Scm_GetInteger32Clamp key SCM_CLAMP_ERROR NULL)])
            (set! r (Scm_BinarySearchS32 (+ (SCM_S32VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_U32)
          (let* ([k::uint32_t
                  (Scm_GetIntegerU32Clamp key SCM_CLAMP_ERROR NULL)])
            (set! r (Scm_BinarySearchU32 (+ (SCM_U32VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_S64)
          (let* ([k::int64_t
                  (Scm_GetInteger64Clamp key SCM_CLAMP_ERROR NULL)])
            (set! r (Scm_BinarySearchS64 (+ (SCM_S64VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_U64)
          (let* ([k::uint64_t
                  (Scm_GetIntegerU64Clamp key SCM_CLAMP_ERROR NULL)])
            (set! r (Scm_BinarySearchU64 (+ (SCM_U64VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_F16)
          (let* ([k::ScmHalfFloat (Scm_DoubleToHalf (Scm_GetDouble key))])
            (set! r (Scm_BinarySearchF16 (+ (SCM_F16VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_F32)
          (let* ([k::float (Scm_GetDouble key)])
            (set! r (Scm_BinarySearchF32 (+ (SCM_F32VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_F64)
          (let* ([k::double (Scm_GetDouble key)])
            (set! r (Scm_BinarySearchF64 (+ (SCM_F64VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_C32)
          (let* ([k::ScmHalfComplex (Scm_GetHalfComplex key)])
            (set! r (Scm_BinarySearchC32 (+ (SCM_C32VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_C64)
          (let* ([k::(ScmFloatComplex) (Scm_GetFloatComplex key)])
            (set! r (Scm_BinarySearchC64 (+ (SCM_C64VECTOR_ELEMENTS v) s)
                                         (- e s) k p (& lb) (& ub))))]
         [(SCM_UVECTOR_C128)
          (let* ([k::(ScmDoubleComplex) (Scm_GetDoubleComplex key)])
            (set! r (Scm_BinarySearchC128 (+ (SCM_C128VECTOR_ELEMENTS v) s)
                                          (- e s) k p (& lb) (& ub))))]
         [else (Scm_Error "[internal] Invalid uvector type: %S" v)]
         )
       (when (== r (cast (size_t) -1))
         (cond
          [(SCM_EQ rounding 'floor)   (set! r lb)]
          [(SCM_EQ rounding 'ceiling) (set! r ub)]
          [(not (SCM_FALSEP rounding))
           (Scm_Error "Rounding argument must be either #f, floor \
                       or ceiling, but got: %S" rounding)]))
       (if (== r (cast (size_t) -1))
         (return SCM_FALSE)
         (return (Scm_MakeIntegerU (+ r s)))))))
 )

;; block i/o
(inline-stub
 (define-cproc read-uvector! (v::<uvector>
                              :optional (port::<input-port> (current-input-port))
                                        (start::<fixnum> 0)
                                        (end::<fixnum> -1)
                                        (endian::<symbol>? #f))
   Scm_ReadBlockX)

 (define-cproc read-uvector (klass::<class> size::<fixnum>
                             :optional (port::<input-port> (current-input-port))
                                       (endian::<symbol>? #f))
   (unless (Scm_SubtypeP klass SCM_CLASS_UVECTOR)
     (Scm_TypeError "class" "uniform vector class" (SCM_OBJ klass)))
   (let* ([v::ScmUVector* (cast ScmUVector* (Scm_MakeUVector klass size NULL))]
          [r (Scm_ReadBlockX v port 0 size endian)])
     (if (SCM_EOFP r)
       (return r)
       (begin
         (SCM_ASSERT (SCM_INTP r))
         (let* ([n::ScmSmallInt (SCM_INT_VALUE r)])
           (SCM_ASSERT (and (<= n size) (<= 0 n)))
           ;; NB: If read size is a lot shorter than requested size, we may
           ;; want to copy it instead of just keeping the rest of vector
           ;; unused.
           (if (< n size)
             (return (Scm_UVectorAlias klass v 0 n))
             (return (SCM_OBJ v))))))))

 (define-cproc write-uvector (v::<uvector>
                              :optional (port::<output-port> (current-output-port))
                                        (start::<fixnum> 0)
                                        (end::<fixnum> -1)
                                        (endian::<symbol>? #f))
   Scm_WriteBlock)
 )

;; R7RS bytevectors
(define (read-bytevector k :optional (port (current-input-port)))
  (read-uvector <u8vector> k port))
(define (read-bytevector! bv :optional (port (current-input-port))
                          (start 0)
                          (end (uvector-length bv)))
  (assume-type bv <u8vector>)
  (read-uvector! bv port start end))
(define (write-bytevector bv :optional (port (current-output-port))
                                       (start 0)
                                       (end (uvector-length bv)))
  (assume-type bv <u8vector>)
  (write-uvector bv port start end))

;; copy
(inline-stub
 (define-cproc uvector-copy! (dest::<uvector> dstart::<fixnum> src::<uvector>
                              :optional (sstart::<fixnum> 0)
                                        (send::<fixnum> -1))
   ::<void>
   (SCM_UVECTOR_CHECK_MUTABLE dest)
   (SCM_CHECK_START_END sstart send (SCM_UVECTOR_SIZE src))
   (let* ([deltsize::int (Scm_UVectorElementSize (Scm_ClassOf (SCM_OBJ dest)))]
          [doff::ScmSmallInt (* dstart deltsize)]
          [seltsize::int (Scm_UVectorElementSize (Scm_ClassOf (SCM_OBJ src)))]
          [soff::ScmSmallInt (* sstart seltsize)]
          [size::ScmSmallInt (- (* send seltsize) soff)])
     (memmove (+ (cast char* (SCM_UVECTOR_ELEMENTS dest)) doff)
              (+ (cast (const char*) (SCM_UVECTOR_ELEMENTS src)) soff)
              size)))
 )

;; for the bakcward compatibility
(define read-block! read-uvector!)
(define write-block write-uvector)

;; for symmetry of port->string, etc.
;; This actually uses uvector port in gauche.vport, but that's inner
;; details users shouldn't need to care.
;; TODO: Optional endian argument
(define (port->uvector iport :optional (class <u8vector>))
  (let1 p (open-output-uvector (make-uvector class 0) :extendable #t)
    (copy-port iport p)
    (get-output-uvector p :shared #t)))

;;-------------------------------------------------------------
;; Element range check (SRFI-160)
;;

(define-cproc u8? (v) ::<boolean> SCM_INTEGER_FITS_UINT8_P)
(define-cproc s8? (v) ::<boolean> SCM_INTEGER_FITS_INT8_P)
(define-cproc u16? (v) ::<boolean> SCM_INTEGER_FITS_UINT16_P)
(define-cproc s16? (v) ::<boolean> SCM_INTEGER_FITS_INT16_P)
(define-cproc u32? (v) ::<boolean> SCM_INTEGER_FITS_UINT32_P)
(define-cproc s32? (v) ::<boolean> SCM_INTEGER_FITS_INT32_P)
(define-cproc u64? (v) ::<boolean> SCM_INTEGER_FITS_UINT64_P)
(define-cproc s64? (v) ::<boolean> SCM_INTEGER_FITS_INT64_P)

(define-cproc f16? (v) ::<boolean> :fast-flonum (return (SCM_REALP v)))
(define-cproc f32? (v) ::<boolean> :fast-flonum (return (SCM_REALP v)))
(define-cproc f64? (v) ::<boolean> :fast-flonum (return (SCM_REALP v)))

(define-cproc c32? (v) ::<boolean> :fast-flonum (return (SCM_NUMBERP v)))
(define-cproc c64? (v) ::<boolean> :fast-flonum (return (SCM_NUMBERP v)))
(define-cproc c128? (v) ::<boolean> :fast-flonum (return (SCM_NUMBERP v)))

;; generic version.
(define-cproc uvector-class-valid-element? (klass::<class> v) ::<boolean>
  (case (Scm_UVectorType klass)
    [(SCM_UVECTOR_U8)  (return (SCM_INTEGER_FITS_UINT8_P v))]
    [(SCM_UVECTOR_S8)  (return (SCM_INTEGER_FITS_INT8_P v))]
    [(SCM_UVECTOR_U16) (return (SCM_INTEGER_FITS_UINT16_P v))]
    [(SCM_UVECTOR_S16) (return (SCM_INTEGER_FITS_INT16_P v))]
    [(SCM_UVECTOR_U32) (return (SCM_INTEGER_FITS_UINT32_P v))]
    [(SCM_UVECTOR_S32) (return (SCM_INTEGER_FITS_INT32_P v))]
    [(SCM_UVECTOR_U64) (return (SCM_INTEGER_FITS_UINT64_P v))]
    [(SCM_UVECTOR_S64) (return (SCM_INTEGER_FITS_INT64_P v))]
    [(SCM_UVECTOR_F16 SCM_UVECTOR_F32 SCM_UVECTOR_F64) (return (SCM_REALP v))]
    [(SCM_UVECTOR_C32 SCM_UVECTOR_C64 SCM_UVECTOR_C128) (return (SCM_NUMBERP v))]
    [else (return FALSE)]
    ))

;;-------------------------------------------------------------
;; special coercers (most sequence methods are in uvlib.scm.tmpl
;;

(define-method coerce-to ((dst <string-meta>) (src <u8vector>))
  (u8vector->string src))
(define-method coerce-to ((dst <string-meta>) (src <s8vector>))
  (s8vector->string src))
(define-method coerce-to ((dst <u8vector-meta>) (src <string>))
  (string->u8vector src))
(define-method coerce-to ((dst <s8vector-meta>) (src <string>))
  (string->s8vector src))
(define-method coerce-to ((dst <string-meta>) (src <u32vector>))
  (u32vector->string src))
(define-method coerce-to ((dst <string-meta>) (src <s32vector>))
  (s32vector->string src))
(define-method coerce-to ((dst <u32vector-meta>) (src <string>))
  (string->u32vector src))
(define-method coerce-to ((dst <s32vector-meta>) (src <string>))
  (string->s32vector src))

;;-------------------------------------------------------------
;; Bytevector aliases (R7RS compatibility)
;;

(define (%adjust-fill-arg fill)
  (cond [(<= 0 fill 255) fill]
        [(<= -128 fill -1) (logand fill #xff)]
        [else (error "fill argument out of range" fill)]))

(define (make-bytevector len :optional (fill 0))
  (make-u8vector len (%adjust-fill-arg fill)))
(define (bytevector-fill! v fill)       ; scheme.bytevector
  (u8vector-fill! v (%adjust-fill-arg fill)))

(define-inline bytevector         u8vector)
(define-inline bytevector?        u8vector?)
(define-inline bytevector-length  u8vector-length)
(define-inline bytevector-u8-ref  u8vector-ref)
(define-inline bytevector-u8-set! u8vector-set!)
(define-inline bytevector-copy    u8vector-copy)
(define-inline bytevector-copy!   u8vector-copy!)
(define-inline bytevector-append  u8vector-append)
(define-inline bytevector=?       u8vector=?)

(define (bytevector-s8-set! v k b)      ; scheme.bytevector
  (bytevector-u8-set! v k (logand b #xff)))
(define bytevector-s8-ref         ; scheme.bytevector
  (letrec ([bytevector-s8-ref
            (^[v k]
              (let1 b (bytevector-u8-ref v k)
                (if (>= b 128) (- b 256) b)))])
    (getter-with-setter bytevector-s8-ref bytevector-s8-set!)))

(define (bytevector-copy!-r6 src sstart target tstart len) ; scheme.bytevector
  (u8vector-copy! target tstart src sstart (+ sstart len)))

(define (bytevector->u8-list v) (u8vector->list v))     ; scheme.bytevector
(define (u8-list->bytevector lis) (list->u8vector lis)) ; scheme.bytevector
