CPS type analysis support for mutable vs immutable vectors

* module/language/cps/types.scm (&mutable-vector, &vector): Separate
  type bits.
  (&vector): New union type.
  (constant-type): Constant vectors are immutable.
* module/language/cps/type-fold.scm (mutable-vector?)
  (immutable-vector?): New folders.
  (vector?): Add union folder.

module/language/cps/type-fold.scm

@@ -114,12 +114,19 @@
 (define-unary-type-predicate-folder pair? &pair)
 (define-unary-type-predicate-folder symbol? &symbol)
 (define-unary-type-predicate-folder variable? &box)
-(define-unary-type-predicate-folder vector? &vector)
+(define-unary-type-predicate-folder mutable-vector? &mutable-vector)
+(define-unary-type-predicate-folder immutable-vector? &immutable-vector)
 (define-unary-type-predicate-folder struct? &struct)
 (define-unary-type-predicate-folder string? &string)
 (define-unary-type-predicate-folder number? &number)
 (define-unary-type-predicate-folder char? &char)
 
+(define-unary-branch-folder (vector? type min max)
+  (cond
+   ((zero? (logand type &vector)) (values #t #f))
+   ((type<=? type &vector) (values #t #t))
+   (else (values #f #f))))
+
 (define-binary-branch-folder (eq? type0 min0 max0 type1 min1 max1)
   (cond
    ((or (zero? (logand type0 type1)) (< max0 min1) (< max1 min0))

module/language/cps/types.scm

@@ -101,7 +101,8 @@
             &pointer
             &fluid
             &pair
-            &vector
+            &immutable-vector
+            &mutable-vector
             &box
             &struct
             &string
@@ -115,7 +116,7 @@
             &null &nil &false &true &unspecified &undefined &eof
 
             ;; Union types.
-            &exact-integer &exact-number &real &number
+            &exact-integer &exact-number &real &number &vector
 
             ;; Untagged types.
             &f64
@@ -161,7 +162,8 @@
   &pointer
   &fluid
   &pair
-  &vector
+  &immutable-vector
+  &mutable-vector
   &box
   &struct
   &string
@@ -196,6 +198,9 @@
 (define-syntax &number
   (identifier-syntax (logior &fixnum &bignum &flonum &complex &fraction)))
 
+(define-syntax &vector
+  (identifier-syntax (logior &immutable-vector &mutable-vector)))
+
 (define-syntax-rule (type<=? x type)
   (zero? (logand x (lognot type))))
 
@@ -366,7 +371,7 @@ minimum, and maximum."
    ((symbol? val) (return &symbol #f))
    ((keyword? val) (return &keyword #f))
    ((pair? val) (return &pair #f))
-   ((vector? val) (return &vector (vector-length val)))
+   ((vector? val) (return &immutable-vector (vector-length val)))
    ((string? val) (return &string (string-length val)))
    ((bytevector? val) (return &bytevector (bytevector-length val)))
    ((bitvector? val) (return &bitvector (bitvector-length val)))
@@ -666,7 +671,8 @@ minimum, and maximum."
 (define-simple-predicate-inferrer pair? &pair)
 (define-simple-predicate-inferrer symbol? &symbol)
 (define-simple-predicate-inferrer variable? &box)
-(define-simple-predicate-inferrer vector? &vector)
+(define-simple-predicate-inferrer immutable-vector? &immutable-vector)
+(define-simple-predicate-inferrer mutable-vector? &mutable-vector)
 (define-simple-predicate-inferrer struct? &struct)
 (define-simple-predicate-inferrer string? &string)
 (define-simple-predicate-inferrer bytevector? &bytevector)
@@ -679,6 +685,10 @@ minimum, and maximum."
 (define-simple-predicate-inferrer compnum? &complex)
 (define-simple-predicate-inferrer fracnum? &fraction)
 
+(define-predicate-inferrer (vector? val true?)
+  (define &not-vector (logand &all-types (lognot &vector)))
+  (restrict! val (if true? &vector &not-vector) -inf.0 +inf.0))
+
 (define-predicate-inferrer (eq? a b true?)
   ;; We can only propagate information down the true leg.
   (when true?