blob: 9f2fbc40522dfb25948db6f62ce916f464434e7b (
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
(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))))))
|
