Skip to content

Commit c8c494d

Browse files
mflattmflatt
committed
add immutable-vector-copy, etc.
Includes cp0 rules to combine vector-construction operations, such as `(vector->immutable-vector (vector-append (vector x y) '#(3)))` to `(immutable-vector x y 3)`.
1 parent e8a1515 commit c8c494d

17 files changed

+666
-235
lines changed

‎boot/pb/equates.h

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
/* equates.h for Chez Scheme Version 9.9.9-pre-release.23 */
1+
/* equates.h for Chez Scheme Version 9.9.9-pre-release.24 */
22

33
/* Do not edit this file. It is automatically generated and */
44
/* specifically tailored to the version of Chez Scheme named */
@@ -1010,7 +1010,7 @@ typedef uint64_t U64;
10101010
#define rtd_sealed 0x4
10111011
#define sbwp (ptr)0x4E
10121012
#define scaled_shot_1_shot_flag -0x8
1013-
#define scheme_version 0x9090917
1013+
#define scheme_version 0x9090918
10141014
#define seginfo_generation_disp 0x1
10151015
#define seginfo_list_bits_disp 0x8
10161016
#define seginfo_space_disp 0x0

‎boot/pb/petite.boot

28.1 KB
Binary file not shown.

‎boot/pb/scheme.boot

8.72 KB
Binary file not shown.

‎boot/pb/scheme.h

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
/* scheme.h for Chez Scheme Version 9.9.9-pre-release.23 (pb) */
1+
/* scheme.h for Chez Scheme Version 9.9.9-pre-release.24 (pb) */
22

33
/* Do not edit this file. It is automatically generated and */
44
/* specifically tailored to the version of Chez Scheme named */
@@ -40,7 +40,7 @@
4040
#endif
4141

4242
/* Chez Scheme Version and machine type */
43-
#define VERSION "9.9.9-pre-release.23"
43+
#define VERSION "9.9.9-pre-release.24"
4444
#define MACHINE_TYPE "pb"
4545

4646
/* Integer typedefs */

‎csug/objects.stex

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -754,7 +754,9 @@ The length and indices of a vector in {\ChezScheme} are always fixnums.
754754
\index{immutable vectors}\index{mutable vectors}%
755755
All vectors are mutable by default, including constants.
756756
A program can create immutable vectors via
757-
\index{\scheme{vector->immutable-vector}}\scheme{vector->immutable-vector}.
757+
\index{\scheme{vector->immutable-vector}}\scheme{vector->immutable-vector},
758+
\index{\scheme{immutable-vector}}\scheme{immutable-vector},
759+
and other functions.
758760
Any attempt to modify an immutable vector causes an exception to be raised.
759761

760762
%----------------------------------------------------------------------------
@@ -920,6 +922,21 @@ is immutable; otherwise, the result is an immutable vector with the same content
920922
(vector-set! v 0 0) ;=> \var{exception: not mutable}
921923
\endschemedisplay
922924

925+
%----------------------------------------------------------------------------
926+
\entryheader
927+
\formdef{immutable-vector}{\categoryprocedure}{(immutable-vector \var{obj} \dots)}
928+
\formdef{immutable-vector-copy}{\categoryprocedure}{(immutable-vector-copy \var{vector})}
929+
\formdef{immutable-vector-copy}{\categoryprocedure}{(immutable-vector-copy \var{vector} \var{start} \var{n})}
930+
\formdef{immutable-vector-append}{\categoryprocedure}{(immutable-vector-append \var{vector} \dots)}
931+
\formdef{immutable-vector-set/copy}{\categoryprocedure}{(vector-set/copy \var{vector} \var{n} \var{val})}
932+
\listlibraries
933+
\endentryheader
934+
935+
Like \scheme{vector}, \scheme{vector-copy}, \scheme{vector-append}, and
936+
\scheme{vector-set/copy}, but producing an immutable vector instead of a mutable
937+
vector. In the case of \scheme{immutable-vector-copy}, \scheme{immutable-vector-append}, or
938+
\scheme{immutable-vector-set/copy}, an argument vector can be mutable or immutable.
939+
923940
%----------------------------------------------------------------------------
924941
\entryheader
925942
\formdef{self-evaluating-vectors}{\categorythreadparameter}{self-evaluating-vectors}

‎mats/5_6.ms

Lines changed: 261 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@
1616
(mat vector
1717
(equal? (vector 1 2 3 4) '#(1 2 3 4))
1818
(eq? (vector) '#())
19-
)
19+
)
2020

2121
(mat immutable-vector
2222
(equal? (immutable-vector 1 2 3 4) (vector->immutable-vector '#(1 2 3 4)))
@@ -129,12 +129,16 @@
129129
)
130130

131131
(mat vector-copy
132-
(equal? (vector-copy '#()) '#())
132+
(eq? (vector-copy '#()) '#())
133133
(equal? (vector-copy '#(a b c)) '#(a b c))
134134
(equal? (vector-copy '#(a b c) 0 1) '#(a))
135135
(equal? (vector-copy '#(a b c) 2 1) '#(c))
136136
(equal? (vector-copy '#(a b c d) 1 2) '#(b c))
137137
(eq? (vector-copy '#(a b c d) 1 0) '#())
138+
(mutable-vector? (vector-copy '#(a b c)))
139+
(mutable-vector? (vector-copy '#(a b c) 0 1))
140+
(mutable-vector? (vector-copy '#(a b c) 2 1))
141+
(mutable-vector? (vector-copy '#(a b c d) 1 2))
138142
(let* ((x1 (vector 1 2 3)) (x2 (vector-copy x1)))
139143
(and (equal? x2 x1) (not (eq? x2 x1))))
140144
(andmap
@@ -150,11 +154,41 @@
150154
(error? (vector-copy '#(a b c) 2 -1))
151155
)
152156

157+
(mat immutable-vector-copy
158+
(eq? (immutable-vector-copy '#()) (immutable-vector))
159+
(equal? (immutable-vector-copy '#(a b c)) '#(a b c))
160+
(equal? (immutable-vector-copy '#(a b c) 0 1) '#(a))
161+
(equal? (immutable-vector-copy '#(a b c) 2 1) '#(c))
162+
(equal? (immutable-vector-copy '#(a b c d) 1 2) '#(b c))
163+
(immutable-vector? (immutable-vector-copy '#(a b c)))
164+
(immutable-vector? (immutable-vector-copy '#(a b c) 0 1))
165+
(immutable-vector? (immutable-vector-copy '#(a b c) 2 1))
166+
(immutable-vector? (immutable-vector-copy '#(a b c d) 1 2))
167+
(eq? (immutable-vector-copy '#(a b c d) 1 0) (immutable-vector))
168+
(let* ((x1 (vector 1 2 3)) (x2 (immutable-vector-copy x1)))
169+
(and (equal? x2 x1) (not (eq? x2 x1))))
170+
(andmap
171+
(lambda (n)
172+
(let ([v (vector-map random (make-vector n 1000))])
173+
(equal? (immutable-vector-copy v) v)))
174+
(map random (make-list 500 2500)))
175+
(error? (immutable-vector-copy '(a b c)))
176+
(error? (immutable-vector-copy '#(a b c) 'x 2))
177+
(error? (immutable-vector-copy '#(a b c) 1 'x))
178+
(error? (immutable-vector-copy '#(a b c) -1 2))
179+
(error? (immutable-vector-copy '#(a b c) 1 3))
180+
(error? (immutable-vector-copy '#(a b c) 2 -1))
181+
)
182+
153183
(mat vector-set/copy
154184
(equal? (vector-set/copy '#(a b c) 0 'x) '#(x b c))
155185
(equal? (vector-set/copy '#(a b c) 1 'x) '#(a x c))
156186
(equal? (vector-set/copy '#(a b c) 2 'x) '#(a b x))
157187
(equal? (vector-set/copy '#(a b c d e f g h i) 2 'x) '#(a b x d e f g h i))
188+
(mutable-vector? (vector-set/copy '#(a b c) 0 'x))
189+
(mutable-vector? (vector-set/copy '#(a b c) 1 'x))
190+
(mutable-vector? (vector-set/copy '#(a b c) 2 'x))
191+
(mutable-vector? (vector-set/copy '#(a b c d e f g h i) 2 'x))
158192
(error? (vector-set/copy 1))
159193
(error? (vector-set/copy '#(a b c)))
160194
(error? (vector-set/copy '#(a b c) 1))
@@ -163,19 +197,43 @@
163197
(error? (vector-set/copy '#(a b c) 3 'x))
164198
)
165199
200+
(mat immutable-vector-set/copy
201+
(equal? (immutable-vector-set/copy '#(a b c) 0 'x) '#(x b c))
202+
(equal? (immutable-vector-set/copy '#(a b c) 1 'x) '#(a x c))
203+
(equal? (immutable-vector-set/copy '#(a b c) 2 'x) '#(a b x))
204+
(equal? (immutable-vector-set/copy '#(a b c d e f g h i) 2 'x) '#(a b x d e f g h i))
205+
(immutable-vector? (immutable-vector-set/copy '#(a b c) 0 'x))
206+
(immutable-vector? (immutable-vector-set/copy '#(a b c) 1 'x))
207+
(immutable-vector? (immutable-vector-set/copy '#(a b c) 2 'x))
208+
(immutable-vector? (immutable-vector-set/copy '#(a b c d e f g h i) 2 'x))
209+
(error? (immutable-vector-set/copy 1))
210+
(error? (immutable-vector-set/copy '#(a b c)))
211+
(error? (immutable-vector-set/copy '#(a b c) 1))
212+
(error? (immutable-vector-set/copy '#(a b c) 'y 'x))
213+
(error? (immutable-vector-set/copy '#(a b c) -1 'x))
214+
(error? (immutable-vector-set/copy '#(a b c) 3 'x))
215+
)
216+
166217
(mat vector-append
167218
(eq? (vector-append) '#())
168219
(eq? (vector-append '#()) '#())
169220
(eq? (vector-append '#() '#()) '#())
170221
(eq? (vector-append '#() '#() '#()) '#())
171222
(eq? (vector-append '#() '#() '#() '#()) '#())
172223
(equal? (vector-append '#(a b c)) '#(a b c))
224+
(mutable-vector? (vector-append '#(a b c)))
173225
(equal? (vector-append '#(a b c) '#(d e)) '#(a b c d e))
226+
(mutable-vector? (vector-append '#(a b c) '#(d e)))
174227
(equal? (vector-append '#(a b c) '#(d e) '#(f) '#(g h i)) '#(a b c d e f g h i))
228+
(mutable-vector? (vector-append '#(a b c) '#(d e) '#(f) '#(g h i)))
175229
(equal? (vector-append (vector 'p) '#()) '#(p))
230+
(mutable-vector? (vector-append (vector 'p) '#()))
176231
(equal? (vector-append '#() (vector 'p)) '#(p))
232+
(mutable-vector? (vector-append '#() (vector 'p)))
177233
(equal? (vector-append (vector 'p) '#(a b c)) '#(p a b c))
178234
(equal? (vector-append '#(a b c) (vector 'p)) '#(a b c p))
235+
(mutable-vector? (vector-append (vector 'p) '#(a b c)))
236+
(mutable-vector? (vector-append '#(a b c) (vector 'p)))
179237
(error? (vector-append 1))
180238
(error? (vector-append '#(a b c) 'x))
181239
(error? (vector-append '#(a b c) '#(d) 'x))
@@ -199,6 +257,199 @@
199257
(equal? (vector-ref v N) "8")))))))
200258
)
201259

260+
(mat immutable-vector-append
261+
(eq? (immutable-vector-append) (immutable-vector))
262+
(eq? (immutable-vector-append '#()) (immutable-vector))
263+
(eq? (immutable-vector-append '#() '#()) (immutable-vector))
264+
(eq? (immutable-vector-append '#() '#() '#()) (immutable-vector))
265+
(eq? (immutable-vector-append '#() '#() '#() '#()) (immutable-vector))
266+
(equal? (immutable-vector-append '#(a b c)) '#(a b c))
267+
(immutable-vector? (immutable-vector-append '#(a b c)))
268+
(equal? (immutable-vector-append '#(a b c) '#(d e)) '#(a b c d e))
269+
(immutable-vector? (immutable-vector-append '#(a b c) '#(d e)))
270+
(equal? (immutable-vector-append '#(a b c) '#(d e) '#(f) '#(g h i)) '#(a b c d e f g h i))
271+
(immutable-vector? (immutable-vector-append '#(a b c) '#(d e) '#(f) '#(g h i)))
272+
(equal? (immutable-vector-append (vector 'p) '#()) '#(p))
273+
(immutable-vector? (immutable-vector-append (vector 'p) '#()))
274+
(equal? (immutable-vector-append '#() (vector 'p)) '#(p))
275+
(immutable-vector? (immutable-vector-append '#() (vector 'p)))
276+
(equal? (immutable-vector-append (vector 'p) '#(a b c)) '#(p a b c))
277+
(equal? (immutable-vector-append '#(a b c) (vector 'p)) '#(a b c p))
278+
(immutable-vector? (immutable-vector-append (vector 'p) '#(a b c)))
279+
(immutable-vector? (immutable-vector-append '#(a b c) (vector 'p)))
280+
(error? (immutable-vector-append 1))
281+
(error? (immutable-vector-append '#(a b c) 'x))
282+
(error? (immutable-vector-append '#(a b c) '#(d) 'x))
283+
(error? (immutable-vector-append '#(a b c) '#(d) '#(e)'x))
284+
285+
;; same as mutable-vector test above
286+
(with-interrupts-disabled
287+
(letrec ([f (lambda (m)
288+
(collect 0 1)
289+
(number->string m))]
290+
[N 1000])
291+
(let ([v (immutable-vector-append (make-vector N)
292+
(vector (f 8)))])
293+
(and (eqv? 0 (#%$generation (vector-ref v N)))
294+
(eqv? 0 (#%$generation v))
295+
(begin
296+
(collect 0 1)
297+
(and (eqv? 1 (#%$generation (vector-ref v N)))
298+
(equal? (vector-ref v N) "8")))))))
299+
)
300+
301+
(mat vector-cbuild-cp0 (parameters [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
302+
(equivalent-expansion?
303+
(expand/optimize '(vector->immutable-vector (vector 1 2)))
304+
`(quote ,(immutable-vector 1 2)))
305+
(equivalent-expansion?
306+
(expand/optimize '(vector->immutable-vector (immutable-vector 1 2)))
307+
`(quote ,(immutable-vector 1 2)))
308+
(not
309+
(equivalent-expansion?
310+
(expand/optimize `(vector->immutable-vector '#(1 2)))
311+
`(quote ,(immutable-vector 1 2))))
312+
(equivalent-expansion?
313+
(expand/optimize `(vector->immutable-vector '#()))
314+
`(quote ,(immutable-vector)))
315+
(equivalent-expansion?
316+
(expand/optimize `(vector->immutable-vector ',(immutable-vector 1 2)))
317+
`(quote ,(immutable-vector 1 2)))
318+
(equivalent-expansion?
319+
(expand/optimize '(lambda (x y) (vector->immutable-vector (vector x y))))
320+
`(lambda (x y) (#3%immutable-vector x y)))
321+
(equivalent-expansion?
322+
(expand/optimize '(lambda (x y) (vector->immutable-vector (immutable-vector x y))))
323+
`(lambda (x y) (#3%immutable-vector x y)))
324+
(equivalent-expansion?
325+
(expand/optimize '(lambda (x y) (vector->immutable-vector (begin (x) (vector x y)))))
326+
`(lambda (x y) (x) (#3%immutable-vector x y)))
327+
(equivalent-expansion?
328+
(expand/optimize '(lambda (x y) (vector->immutable-vector (begin (x) (immutable-vector x y)))))
329+
`(lambda (x y) (x) (#3%immutable-vector x y)))
330+
331+
(equivalent-expansion?
332+
(expand/optimize '(immutable-vector-copy (vector 1 2)))
333+
`(quote ,(immutable-vector 1 2)))
334+
(equivalent-expansion?
335+
(expand/optimize '(immutable-vector-copy (immutable-vector 1 2)))
336+
`(quote ,(immutable-vector 1 2)))
337+
(equivalent-expansion?
338+
(expand/optimize `(immutable-vector-copy ',(immutable-vector 1 2)))
339+
`(quote ,(immutable-vector 1 2)))
340+
(equivalent-expansion?
341+
(expand/optimize '(lambda (x y) (immutable-vector-copy (vector x y))))
342+
`(lambda (x y) (#3%immutable-vector x y)))
343+
(equivalent-expansion?
344+
(expand/optimize '(lambda (x y) (immutable-vector-copy (immutable-vector x y))))
345+
`(lambda (x y) (#3%immutable-vector x y)))
346+
347+
(equivalent-expansion?
348+
(expand/optimize '(vector-copy (vector 1 2)))
349+
`(#3%vector 1 2))
350+
(equivalent-expansion?
351+
(expand/optimize '(vector-copy (immutable-vector 1 2)))
352+
`(#3%vector 1 2))
353+
(equivalent-expansion?
354+
(expand/optimize `(vector-copy ',(immutable-vector 1 2)))
355+
`(#3%vector 1 2))
356+
(equivalent-expansion?
357+
(expand/optimize '(lambda (x y) (vector-copy (vector x y))))
358+
`(lambda (x y) (#3%vector x y)))
359+
(equivalent-expansion?
360+
(expand/optimize '(lambda (x y) (vector-copy (immutable-vector x y))))
361+
`(lambda (x y) (#3%vector x y)))
362+
363+
(equivalent-expansion?
364+
(expand/optimize '(immutable-vector-append (vector 1 2)))
365+
`(quote ,(immutable-vector 1 2)))
366+
(equivalent-expansion?
367+
(expand/optimize '(immutable-vector-append (vector 1 2) (vector 3 4)))
368+
`(quote ,(immutable-vector 1 2 3 4)))
369+
(equivalent-expansion?
370+
(expand/optimize '(immutable-vector-append (immutable-vector 1 2)))
371+
`(quote ,(immutable-vector 1 2)))
372+
(equivalent-expansion?
373+
(expand/optimize '(immutable-vector-append (immutable-vector 1 2) (vector 3 4)))
374+
`(quote ,(immutable-vector 1 2 3 4)))
375+
(equivalent-expansion?
376+
(expand/optimize `(immutable-vector-append ',(immutable-vector 1 2)))
377+
`(quote ,(immutable-vector 1 2)))
378+
(equivalent-expansion?
379+
(expand/optimize `(immutable-vector-append ',(immutable-vector 1 2) (vector 3 4)))
380+
`(quote ,(immutable-vector 1 2 3 4)))
381+
(equivalent-expansion?
382+
(expand/optimize '(lambda (x y) (immutable-vector-append (vector x y))))
383+
`(lambda (x y) (#3%immutable-vector x y)))
384+
(equivalent-expansion?
385+
(expand/optimize '(lambda (x y) (immutable-vector-append (vector x y) (vector y x))))
386+
`(lambda (x y) (#3%immutable-vector x y y x)))
387+
(equivalent-expansion?
388+
(expand/optimize '(lambda (x y) (immutable-vector-append (immutable-vector x y))))
389+
`(lambda (x y) (#3%immutable-vector x y)))
390+
(equivalent-expansion?
391+
(expand/optimize '(lambda (x y) (immutable-vector-append (immutable-vector x y) (immutable-vector y x))))
392+
`(lambda (x y) (#3%immutable-vector x y y x)))
393+
(equivalent-expansion?
394+
(expand/optimize `(lambda (x y) (immutable-vector-append (immutable-vector 1 x)
395+
(vector 2 y)
396+
(vector-copy (vector 6 7 x))
397+
',(immutable-vector 8))))
398+
`(lambda (x y) (#3%immutable-vector 1 x 2 y 6 7 x 8)))
399+
400+
(equivalent-expansion?
401+
(expand/optimize '(vector-append (vector 1 2)))
402+
`(#3%vector 1 2))
403+
(equivalent-expansion?
404+
(expand/optimize '(vector-append (vector 1 2) (vector 3 4)))
405+
`(#3%vector 1 2 3 4))
406+
(equivalent-expansion?
407+
(expand/optimize '(vector-append (immutable-vector 1 2)))
408+
`(#3%vector 1 2))
409+
(equivalent-expansion?
410+
(expand/optimize '(vector-append (immutable-vector 1 2) (vector 3 4)))
411+
`(#3%vector 1 2 3 4))
412+
(equivalent-expansion?
413+
(expand/optimize `(vector-append ',(immutable-vector 1 2)))
414+
`(#3%vector 1 2))
415+
(equivalent-expansion?
416+
(expand/optimize `(vector-append ',(immutable-vector 1 2) (vector 3 4)))
417+
`(#3%vector 1 2 3 4))
418+
(equivalent-expansion?
419+
(expand/optimize '(lambda (x y) (vector-append (vector x y))))
420+
`(lambda (x y) (#3%vector x y)))
421+
(equivalent-expansion?
422+
(expand/optimize '(lambda (x y) (vector-append (vector x y) (vector y x))))
423+
`(lambda (x y) (#3%vector x y y x)))
424+
(equivalent-expansion?
425+
(expand/optimize '(lambda (x y) (vector-append (immutable-vector x y))))
426+
`(lambda (x y) (#3%vector x y)))
427+
(equivalent-expansion?
428+
(expand/optimize '(lambda (x y) (vector-append (immutable-vector x y) (immutable-vector y x))))
429+
`(lambda (x y) (#3%vector x y y x)))
430+
(equivalent-expansion?
431+
(expand/optimize `(lambda (x y) (vector-append (immutable-vector 1 x)
432+
(vector 2 y)
433+
(vector-copy (vector 6 7 x))
434+
',(immutable-vector 8))))
435+
`(lambda (x y) (#3%vector 1 x 2 y 6 7 x 8)))
436+
437+
438+
(equivalent-expansion?
439+
(expand/optimize `(lambda (x y)
440+
(vector-ref (vector-copy (immutable-vector 1 x)) 1)))
441+
`(lambda (x y) x))
442+
(equivalent-expansion?
443+
(expand/optimize `(lambda (x y)
444+
(vector->immutable-vector
445+
(vector (vector-ref (vector-copy (immutable-vector 1 x)) 1)
446+
(vector-ref (immutable-vector-append (immutable-vector 2 3)
447+
(vector y 0))
448+
2)))))
449+
`(lambda (x y) (#3%immutable-vector x y)))
450+
451+
)
452+
202453
(mat vector-fill!
203454
(let ([v (vector-copy '#5(a b c d e))])
204455
(and (equal? v '#5(a b c d e))
@@ -1469,7 +1720,14 @@
14691720
(equal? '#(1 2 3) immutable-123-vector)
14701721
(eq? immutable-123-vector
14711722
(vector->immutable-vector immutable-123-vector))
1472-
1723+
1724+
;; these also turn out to be conversions that should
1725+
;; leave an immutable vector alone:
1726+
(eq? immutable-123-vector
1727+
(immutable-vector-copy immutable-123-vector))
1728+
(eq? immutable-123-vector
1729+
(immutable-vector-append immutable-123-vector))
1730+
14731731
(mutable-vector? (make-vector 5))
14741732
(not (immutable-vector? (make-vector 5)))
14751733

0 commit comments

Comments
 (0)