(export
  list->vector
  make-vector
  vector
  vector->list
  vector-append
  vector-copy
  vector-copy!
  vector-fill!
  vector-for-each
  vector-length
  vector-map
  vector-ref
  vector-set!
  vector?)
(import (only (csc builtins)
          call-builtin))
(begin


  (define (vector? obj)
    (zero? (call-builtin peek obj 0)))


  (define (vector-length v)
    (unless (vector? v)
      (error "unexpected type in vector-length" v))
    (call-builtin peek v 1))


  (define (vector-set! v k obj)
    (unless (< k (vector-length v))
      (error "index out of range in vector-set!" k v))
    (call-builtin poke obj v (+ 2 k)))


  (define vector-fill!
    (case-lambda
      ((v fill)
        (vector-fill! v 0 (vector-length v)))
      ((v fill start)
        (vector-fill! v start (vector-length v)))
      ((v fill start end)
        (let loop ((i start))
          (when (< i end)
            (vector-set! v i fill)
            (loop (+ 1 i)))))))


  (define make-vector
    (case-lambda
      ((k)
        (define v (call-builtin alloc (+ 2 k)))
        (call-builtin poke 0 v 0)
        (call-builtin poke k v 1)
        v)
      ((k fill)
        (define n (+ 2 k))
        (define v (call-builtin alloc n))
        (call-builtin poke 0 v 0)
        (call-builtin poke k v 1)
        (vector-fill! v fill)
        v)))


  (define (list->vector l)
    (define n (length l))
    (define v (make-vector n))
    (let loop ((i 0)
               (l l))
      (when (< i n)
        (vector-set! v i (car l))
        (loop (+ 1 i) (cdr l))))
    v)


  (define (vector . objs)
    (list->vector objs))


  (define (vector-ref v k)
    (unless (< k (vector-length v))
      (error "index out of range in vector-set!" k v))
    (call-builtin peek v (+ 2 k)))


  (define vector->list
    (case-lambda
      ((v)
        (vector->list v 0 (vector-length v)))
      ((v start)
        (vector->list v start (vector-length v)))
      ((v start end)
        (let loop ((i (- end 1))
                   (acc '()))
          (when (>= i start)
            (loop (- i 1)
                  (cons (vector-ref v i) acc)))))))


  (define vector-copy!
    (case-lambda
      ((to at from)
        (vector-copy! to at from 0 (vector-length from)))
      ((to at from start)
        (vector-copy! to at from start (vector-length from)))
      ((to at from start end)
        (let loop ((i start)
                   (j at))
          (when (< i end)
            (vector-set! to j (vector-ref from i))
            (loop (+ 1 i) (+ 1 j)))))))


  (define vector-copy
    (case-lambda
      ((v)
        (vector-copy v 0 (vector-length v)))
      ((v start)
        (vector-copy v start (vector-length v)))
      ((v start end)
        (define v* (make-vector (- end start)))
        (vector-copy! v* 0 v)
        v*)))


  (define (vector-append . vectors)
    (define v (make-vector (apply + (map vector-length vectors))))
    (let loop ((vs vectors)
               (i 0))
      (unless (null? vs)
        (vector-copy! v i (car vs))
        (loop (cdr vs)
              (+ i (vector-length (car vs))))))
    v)


  (define (vector-map proc v1 . vs)
    (define vs* (cons v1 vs))
    (define n (apply min (map vector-length vs*)))
    (define out (make-vector n))
    (let loop ((i 0))
      (when (< i n)
        (vector-set! out i
          (apply proc (map (lambda (v) (vector-ref v i)) vs*)))
        (loop (+ 1 i))))
    out)


  (define (vector-for-each proc v1 . vs)
    (define vs* (cons v1 vs))
    (define n (apply min (map vector-length vs*)))
    (let loop ((i 0))
      (when (< i n)
        (apply proc (map (lambda (v) (vector-ref v i)) vs*))
        (loop (+ 1 i))))))