Skip to content

Commit

Permalink
add immutable-vector-copy, etc.
Browse files Browse the repository at this point in the history 
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)`.
  • Loading branch information
@mflatt
mflatt committed Jan 6, 2024
1 parent 8e094a5 commit 3f2b8d5
Show file tree
Hide file tree
Showing 17 changed files with 739 additions and 273 deletions.
4 changes: 2 additions & 2 deletions boot/pb/equates.h
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
/* equates.h for Chez Scheme Version 9.9.9-pre-release.23 */
/* equates.h for Chez Scheme Version 9.9.9-pre-release.24 */

/* Do not edit this file. It is automatically generated and */
/* specifically tailored to the version of Chez Scheme named */
Expand Down Expand Up @@ -1010,7 +1010,7 @@ typedef uint64_t U64;
#define rtd_sealed 0x4
#define sbwp (ptr)0x4E
#define scaled_shot_1_shot_flag -0x8
#define scheme_version 0x9090917
#define scheme_version 0x9090918
#define seginfo_generation_disp 0x1
#define seginfo_list_bits_disp 0x8
#define seginfo_space_disp 0x0
Expand Down
Binary file modified boot/pb/petite.boot
View file
Binary file not shown.
Binary file modified boot/pb/scheme.boot
View file
Binary file not shown.
4 changes: 2 additions & 2 deletions boot/pb/scheme.h
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
/* scheme.h for Chez Scheme Version 9.9.9-pre-release.23 (pb) */
/* scheme.h for Chez Scheme Version 9.9.9-pre-release.24 (pb) */

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

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

/* Integer typedefs */
Expand Down
19 changes: 18 additions & 1 deletion csug/objects.stex
View file
Original file line number Diff line number Diff line change
Expand Up @@ -754,7 +754,9 @@ The length and indices of a vector in {\ChezScheme} are always fixnums.
\index{immutable vectors}\index{mutable vectors}%
All vectors are mutable by default, including constants.
A program can create immutable vectors via
\index{\scheme{vector->immutable-vector}}\scheme{vector->immutable-vector}.
\index{\scheme{vector->immutable-vector}}\scheme{vector->immutable-vector},
\index{\scheme{immutable-vector}}\scheme{immutable-vector},
and other functions.
Any attempt to modify an immutable vector causes an exception to be raised.

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

%----------------------------------------------------------------------------
\entryheader
\formdef{immutable-vector}{\categoryprocedure}{(immutable-vector \var{obj} \dots)}
\formdef{immutable-vector-copy}{\categoryprocedure}{(immutable-vector-copy \var{vector})}
\formdef{immutable-vector-copy}{\categoryprocedure}{(immutable-vector-copy \var{vector} \var{start} \var{n})}
\formdef{immutable-vector-append}{\categoryprocedure}{(immutable-vector-append \var{vector} \dots)}
\formdef{immutable-vector-set/copy}{\categoryprocedure}{(vector-set/copy \var{vector} \var{n} \var{val})}
\listlibraries
\endentryheader

Like \scheme{vector}, \scheme{vector-copy}, \scheme{vector-append}, and
\scheme{vector-set/copy}, but producing an immutable vector instead of a mutable
vector. In the case of \scheme{immutable-vector-copy}, \scheme{immutable-vector-append}, or
\scheme{immutable-vector-set/copy}, an argument vector can be mutable or immutable.

%----------------------------------------------------------------------------
\entryheader
\formdef{self-evaluating-vectors}{\categorythreadparameter}{self-evaluating-vectors}
Expand Down
264 changes: 261 additions & 3 deletions mats/5_6.ms
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
(mat vector
(equal? (vector 1 2 3 4) '#(1 2 3 4))
(eq? (vector) '#())
)
)

(mat immutable-vector
(equal? (immutable-vector 1 2 3 4) (vector->immutable-vector '#(1 2 3 4)))
Expand Down Expand Up @@ -129,12 +129,16 @@
)

(mat vector-copy
(equal? (vector-copy '#()) '#())
(eq? (vector-copy '#()) '#())
(equal? (vector-copy '#(a b c)) '#(a b c))
(equal? (vector-copy '#(a b c) 0 1) '#(a))
(equal? (vector-copy '#(a b c) 2 1) '#(c))
(equal? (vector-copy '#(a b c d) 1 2) '#(b c))
(eq? (vector-copy '#(a b c d) 1 0) '#())
(mutable-vector? (vector-copy '#(a b c)))
(mutable-vector? (vector-copy '#(a b c) 0 1))
(mutable-vector? (vector-copy '#(a b c) 2 1))
(mutable-vector? (vector-copy '#(a b c d) 1 2))
(let* ((x1 (vector 1 2 3)) (x2 (vector-copy x1)))
(and (equal? x2 x1) (not (eq? x2 x1))))
(andmap
Expand All @@ -150,11 +154,41 @@
(error? (vector-copy '#(a b c) 2 -1))
)

(mat immutable-vector-copy
(eq? (immutable-vector-copy '#()) (immutable-vector))
(equal? (immutable-vector-copy '#(a b c)) '#(a b c))
(equal? (immutable-vector-copy '#(a b c) 0 1) '#(a))
(equal? (immutable-vector-copy '#(a b c) 2 1) '#(c))
(equal? (immutable-vector-copy '#(a b c d) 1 2) '#(b c))
(immutable-vector? (immutable-vector-copy '#(a b c)))
(immutable-vector? (immutable-vector-copy '#(a b c) 0 1))
(immutable-vector? (immutable-vector-copy '#(a b c) 2 1))
(immutable-vector? (immutable-vector-copy '#(a b c d) 1 2))
(eq? (immutable-vector-copy '#(a b c d) 1 0) (immutable-vector))
(let* ((x1 (vector 1 2 3)) (x2 (immutable-vector-copy x1)))
(and (equal? x2 x1) (not (eq? x2 x1))))
(andmap
(lambda (n)
(let ([v (vector-map random (make-vector n 1000))])
(equal? (immutable-vector-copy v) v)))
(map random (make-list 500 2500)))
(error? (immutable-vector-copy '(a b c)))
(error? (immutable-vector-copy '#(a b c) 'x 2))
(error? (immutable-vector-copy '#(a b c) 1 'x))
(error? (immutable-vector-copy '#(a b c) -1 2))
(error? (immutable-vector-copy '#(a b c) 1 3))
(error? (immutable-vector-copy '#(a b c) 2 -1))
)

(mat vector-set/copy
(equal? (vector-set/copy '#(a b c) 0 'x) '#(x b c))
(equal? (vector-set/copy '#(a b c) 1 'x) '#(a x c))
(equal? (vector-set/copy '#(a b c) 2 'x) '#(a b x))
(equal? (vector-set/copy '#(a b c d e f g h i) 2 'x) '#(a b x d e f g h i))
(mutable-vector? (vector-set/copy '#(a b c) 0 'x))
(mutable-vector? (vector-set/copy '#(a b c) 1 'x))
(mutable-vector? (vector-set/copy '#(a b c) 2 'x))
(mutable-vector? (vector-set/copy '#(a b c d e f g h i) 2 'x))
(error? (vector-set/copy 1))
(error? (vector-set/copy '#(a b c)))
(error? (vector-set/copy '#(a b c) 1))
Expand All @@ -163,19 +197,43 @@
(error? (vector-set/copy '#(a b c) 3 'x))
)

(mat immutable-vector-set/copy
(equal? (immutable-vector-set/copy '#(a b c) 0 'x) '#(x b c))
(equal? (immutable-vector-set/copy '#(a b c) 1 'x) '#(a x c))
(equal? (immutable-vector-set/copy '#(a b c) 2 'x) '#(a b x))
(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))
(immutable-vector? (immutable-vector-set/copy '#(a b c) 0 'x))
(immutable-vector? (immutable-vector-set/copy '#(a b c) 1 'x))
(immutable-vector? (immutable-vector-set/copy '#(a b c) 2 'x))
(immutable-vector? (immutable-vector-set/copy '#(a b c d e f g h i) 2 'x))
(error? (immutable-vector-set/copy 1))
(error? (immutable-vector-set/copy '#(a b c)))
(error? (immutable-vector-set/copy '#(a b c) 1))
(error? (immutable-vector-set/copy '#(a b c) 'y 'x))
(error? (immutable-vector-set/copy '#(a b c) -1 'x))
(error? (immutable-vector-set/copy '#(a b c) 3 'x))
)

(mat vector-append
(eq? (vector-append) '#())
(eq? (vector-append '#()) '#())
(eq? (vector-append '#() '#()) '#())
(eq? (vector-append '#() '#() '#()) '#())
(eq? (vector-append '#() '#() '#() '#()) '#())
(equal? (vector-append '#(a b c)) '#(a b c))
(mutable-vector? (vector-append '#(a b c)))
(equal? (vector-append '#(a b c) '#(d e)) '#(a b c d e))
(mutable-vector? (vector-append '#(a b c) '#(d e)))
(equal? (vector-append '#(a b c) '#(d e) '#(f) '#(g h i)) '#(a b c d e f g h i))
(mutable-vector? (vector-append '#(a b c) '#(d e) '#(f) '#(g h i)))
(equal? (vector-append (vector 'p) '#()) '#(p))
(mutable-vector? (vector-append (vector 'p) '#()))
(equal? (vector-append '#() (vector 'p)) '#(p))
(mutable-vector? (vector-append '#() (vector 'p)))
(equal? (vector-append (vector 'p) '#(a b c)) '#(p a b c))
(equal? (vector-append '#(a b c) (vector 'p)) '#(a b c p))
(mutable-vector? (vector-append (vector 'p) '#(a b c)))
(mutable-vector? (vector-append '#(a b c) (vector 'p)))
(error? (vector-append 1))
(error? (vector-append '#(a b c) 'x))
(error? (vector-append '#(a b c) '#(d) 'x))
Expand All @@ -199,6 +257,199 @@
(equal? (vector-ref v N) "8")))))))
)

(mat immutable-vector-append
(eq? (immutable-vector-append) (immutable-vector))
(eq? (immutable-vector-append '#()) (immutable-vector))
(eq? (immutable-vector-append '#() '#()) (immutable-vector))
(eq? (immutable-vector-append '#() '#() '#()) (immutable-vector))
(eq? (immutable-vector-append '#() '#() '#() '#()) (immutable-vector))
(equal? (immutable-vector-append '#(a b c)) '#(a b c))
(immutable-vector? (immutable-vector-append '#(a b c)))
(equal? (immutable-vector-append '#(a b c) '#(d e)) '#(a b c d e))
(immutable-vector? (immutable-vector-append '#(a b c) '#(d e)))
(equal? (immutable-vector-append '#(a b c) '#(d e) '#(f) '#(g h i)) '#(a b c d e f g h i))
(immutable-vector? (immutable-vector-append '#(a b c) '#(d e) '#(f) '#(g h i)))
(equal? (immutable-vector-append (vector 'p) '#()) '#(p))
(immutable-vector? (immutable-vector-append (vector 'p) '#()))
(equal? (immutable-vector-append '#() (vector 'p)) '#(p))
(immutable-vector? (immutable-vector-append '#() (vector 'p)))
(equal? (immutable-vector-append (vector 'p) '#(a b c)) '#(p a b c))
(equal? (immutable-vector-append '#(a b c) (vector 'p)) '#(a b c p))
(immutable-vector? (immutable-vector-append (vector 'p) '#(a b c)))
(immutable-vector? (immutable-vector-append '#(a b c) (vector 'p)))
(error? (immutable-vector-append 1))
(error? (immutable-vector-append '#(a b c) 'x))
(error? (immutable-vector-append '#(a b c) '#(d) 'x))
(error? (immutable-vector-append '#(a b c) '#(d) '#(e)'x))

;; same as mutable-vector test above
(with-interrupts-disabled
(letrec ([f (lambda (m)
(collect 0 1)
(number->string m))]
[N 1000])
(let ([v (immutable-vector-append (make-vector N)
(vector (f 8)))])
(and (eqv? 0 (#%$generation (vector-ref v N)))
(eqv? 0 (#%$generation v))
(begin
(collect 0 1)
(and (eqv? 1 (#%$generation (vector-ref v N)))
(equal? (vector-ref v N) "8")))))))
)

(mat vector-cbuild-cp0 (parameters [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(equivalent-expansion?
(expand/optimize '(vector->immutable-vector (vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(equivalent-expansion?
(expand/optimize '(vector->immutable-vector (immutable-vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(not
(equivalent-expansion?
(expand/optimize `(vector->immutable-vector '#(1 2)))
`(quote ,(immutable-vector 1 2))))
(equivalent-expansion?
(expand/optimize `(vector->immutable-vector '#()))
`(quote ,(immutable-vector)))
(equivalent-expansion?
(expand/optimize `(vector->immutable-vector ',(immutable-vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector->immutable-vector (vector x y))))
`(lambda (x y) (#3%immutable-vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector->immutable-vector (immutable-vector x y))))
`(lambda (x y) (#3%immutable-vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector->immutable-vector (begin (x) (vector x y)))))
`(lambda (x y) (x) (#3%immutable-vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector->immutable-vector (begin (x) (immutable-vector x y)))))
`(lambda (x y) (x) (#3%immutable-vector x y)))

(equivalent-expansion?
(expand/optimize '(immutable-vector-copy (vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(equivalent-expansion?
(expand/optimize '(immutable-vector-copy (immutable-vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(equivalent-expansion?
(expand/optimize `(immutable-vector-copy ',(immutable-vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (immutable-vector-copy (vector x y))))
`(lambda (x y) (#3%immutable-vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (immutable-vector-copy (immutable-vector x y))))
`(lambda (x y) (#3%immutable-vector x y)))

(equivalent-expansion?
(expand/optimize '(vector-copy (vector 1 2)))
`(#3%vector 1 2))
(equivalent-expansion?
(expand/optimize '(vector-copy (immutable-vector 1 2)))
`(#3%vector 1 2))
(equivalent-expansion?
(expand/optimize `(vector-copy ',(immutable-vector 1 2)))
`(#3%vector 1 2))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector-copy (vector x y))))
`(lambda (x y) (#3%vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector-copy (immutable-vector x y))))
`(lambda (x y) (#3%vector x y)))

(equivalent-expansion?
(expand/optimize '(immutable-vector-append (vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(equivalent-expansion?
(expand/optimize '(immutable-vector-append (vector 1 2) (vector 3 4)))
`(quote ,(immutable-vector 1 2 3 4)))
(equivalent-expansion?
(expand/optimize '(immutable-vector-append (immutable-vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(equivalent-expansion?
(expand/optimize '(immutable-vector-append (immutable-vector 1 2) (vector 3 4)))
`(quote ,(immutable-vector 1 2 3 4)))
(equivalent-expansion?
(expand/optimize `(immutable-vector-append ',(immutable-vector 1 2)))
`(quote ,(immutable-vector 1 2)))
(equivalent-expansion?
(expand/optimize `(immutable-vector-append ',(immutable-vector 1 2) (vector 3 4)))
`(quote ,(immutable-vector 1 2 3 4)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (immutable-vector-append (vector x y))))
`(lambda (x y) (#3%immutable-vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (immutable-vector-append (vector x y) (vector y x))))
`(lambda (x y) (#3%immutable-vector x y y x)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (immutable-vector-append (immutable-vector x y))))
`(lambda (x y) (#3%immutable-vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (immutable-vector-append (immutable-vector x y) (immutable-vector y x))))
`(lambda (x y) (#3%immutable-vector x y y x)))
(equivalent-expansion?
(expand/optimize `(lambda (x y) (immutable-vector-append (immutable-vector 1 x)
(vector 2 y)
(vector-copy (vector 6 7 x))
',(immutable-vector 8))))
`(lambda (x y) (#3%immutable-vector 1 x 2 y 6 7 x 8)))

(equivalent-expansion?
(expand/optimize '(vector-append (vector 1 2)))
`(#3%vector 1 2))
(equivalent-expansion?
(expand/optimize '(vector-append (vector 1 2) (vector 3 4)))
`(#3%vector 1 2 3 4))
(equivalent-expansion?
(expand/optimize '(vector-append (immutable-vector 1 2)))
`(#3%vector 1 2))
(equivalent-expansion?
(expand/optimize '(vector-append (immutable-vector 1 2) (vector 3 4)))
`(#3%vector 1 2 3 4))
(equivalent-expansion?
(expand/optimize `(vector-append ',(immutable-vector 1 2)))
`(#3%vector 1 2))
(equivalent-expansion?
(expand/optimize `(vector-append ',(immutable-vector 1 2) (vector 3 4)))
`(#3%vector 1 2 3 4))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector-append (vector x y))))
`(lambda (x y) (#3%vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector-append (vector x y) (vector y x))))
`(lambda (x y) (#3%vector x y y x)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector-append (immutable-vector x y))))
`(lambda (x y) (#3%vector x y)))
(equivalent-expansion?
(expand/optimize '(lambda (x y) (vector-append (immutable-vector x y) (immutable-vector y x))))
`(lambda (x y) (#3%vector x y y x)))
(equivalent-expansion?
(expand/optimize `(lambda (x y) (vector-append (immutable-vector 1 x)
(vector 2 y)
(vector-copy (vector 6 7 x))
',(immutable-vector 8))))
`(lambda (x y) (#3%vector 1 x 2 y 6 7 x 8)))


(equivalent-expansion?
(expand/optimize `(lambda (x y)
(vector-ref (vector-copy (immutable-vector 1 x)) 1)))
`(lambda (x y) x))
(equivalent-expansion?
(expand/optimize `(lambda (x y)
(vector->immutable-vector
(vector (vector-ref (vector-copy (immutable-vector 1 x)) 1)
(vector-ref (immutable-vector-append (immutable-vector 2 3)
(vector y 0))
2)))))
`(lambda (x y) (#3%immutable-vector x y)))

)

(mat vector-fill!
(let ([v (vector-copy '#5(a b c d e))])
(and (equal? v '#5(a b c d e))
Expand Down Expand Up @@ -1469,7 +1720,14 @@
(equal? '#(1 2 3) immutable-123-vector)
(eq? immutable-123-vector
(vector->immutable-vector immutable-123-vector))


;; these also turn out to be conversions that should
;; leave an immutable vector alone:
(eq? immutable-123-vector
(immutable-vector-copy immutable-123-vector))
(eq? immutable-123-vector
(immutable-vector-append immutable-123-vector))

(mutable-vector? (make-vector 5))
(not (immutable-vector? (make-vector 5)))

Expand Down
Loading

0 comments on commit 3f2b8d5

Please sign in to comment.