aboutsummaryrefslogtreecommitdiffstats
path: root/csc/vec.csc
blob: 03f2b0f5a5e1b1f6e5197974c69e3c8f2bbf3b64 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
(define-library (csc vec)
  (export
    list->vec
    vec
    vec->list
    vec-append
    vec-length
    vec-ref
    vec?)
  (import (scheme base))
  (begin


    (define-record-type <vec>
      (make-vec len arr)
      vec?
      (len vec-length)
      (arr vec-arr))


    (define (list->vec l)
      (let ((arr (list->vector l)))
        (make-vec (vector-length arr) arr)))


    (define (vec->list v)
      (vector->list (vec-arr v) 0 (vec-length v)))


    (define (vec . xs)
      (list->vec xs))


    (define (vec-append v . xs)
      (let ((append-one
              (lambda (v x)
                (let ((new-v (if (> (vector-length (vec-arr v)) (vec-length v))
                                 v
                               (let ((new-arr (make-vector (max 1 (* 2 (vec-length v))))))
                                 (vector-copy! new-arr 0 (vec-arr v))
                                 (make-vec (vec-length v) new-arr)))))
                  (vector-set! (vec-arr new-v) (vec-length new-v) x)
                  (make-vec (+ 1 (vec-length new-v)) (vec-arr new-v))))))
        (let loop ((v v)
                   (xs xs))
          (if (null? xs)
              v
            (loop (append-one v (car xs)) (cdr xs))))))


    (define (vec-ref v k)
      (if (>= k (vec-length v))
          (error "index out of bounds" k)
        (vector-ref (vec-arr v) k)))))