[Guile-commits] 15/25: CPS type analysis support for mutable vs immutable vectors

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 9b3c4612bde19c42b3704ec69eb1f4686c5709f0
Author: Andy Wingo <address@hidden>
Date:   Sun Jan 7 17:16:20 2018 +0100

    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 |  9 ++++++++-
 module/language/cps/types.scm     | 20 +++++++++++++++-----
 2 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/module/language/cps/type-fold.scm 
b/module/language/cps/type-fold.scm
index d9be02d..4058066 100644
--- a/module/language/cps/type-fold.scm
+++ b/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))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 230c1eb..dfd7b92 100644
--- a/module/language/cps/types.scm
+++ b/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?