[Guile-commits] 27/41: Better range inference for indexes of vector-ref, string-ref et al

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit d2808b16e5003282d53220158742421562f88924
Author: Andy Wingo <address@hidden>
Date:   Fri Nov 20 13:25:59 2015 +0100

    Better range inference for indexes of vector-ref, string-ref et al
    
    * module/language/cps/types.scm (vector-ref, vector-set!)
      (string-ref, string-set!, struct-ref, struct-set!)
      (define-bytevector-accessors, define-bytevector-uaccessors): Clamp
      range of object and index to be within the range of indices, with a
      maximum of *max-size-t*.
---
 module/language/cps/types.scm |  117 +++++++++++++++++++++--------------------
 1 files changed, 59 insertions(+), 58 deletions(-)

diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 543f550..4fd5e56 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -596,16 +596,16 @@ minimum, and maximum."
   (and (check-type v &vector 0 *max-vector-len*)
        (check-type idx &exact-integer 0 (1- (&min v)))))
 (define-type-inferrer (vector-ref v idx result)
-  (restrict! v &vector (1+ (&min idx)) +inf.0)
-  (restrict! idx &exact-integer 0 (1- (&max v)))
+  (restrict! v &vector (1+ (&min idx)) *max-vector-len*)
+  (restrict! idx &exact-integer 0 (1- (min (&max v) *max-vector-len*)))
   (define! result &all-types -inf.0 +inf.0))
 
 (define-type-checker (vector-set! v idx val)
   (and (check-type v &vector 0 *max-vector-len*)
        (check-type idx &exact-integer 0 (1- (&min v)))))
 (define-type-inferrer (vector-set! v idx val)
-  (restrict! v &vector (1+ (&min idx)) +inf.0)
-  (restrict! idx &exact-integer 0 (1- (&max v))))
+  (restrict! v &vector (1+ (&min idx)) *max-vector-len*)
+  (restrict! idx &exact-integer 0 (1- (min (&max v) *max-vector-len*))))
 
 (define-type-aliases make-vector make-vector/immediate)
 (define-type-aliases vector-ref vector-ref/immediate)
@@ -627,35 +627,35 @@ minimum, and maximum."
 ;; No type-checker for allocate-struct, as we can't currently check that
 ;; vt is actually a vtable.
 (define-type-inferrer (allocate-struct vt size result)
-  (restrict! vt &struct vtable-offset-user +inf.0)
-  (restrict! size &exact-integer 0 +inf.0)
-  (define! result &struct (max (&min size) 0) (&max size)))
+  (restrict! vt &struct vtable-offset-user *max-size-t*)
+  (restrict! size &exact-integer 0 *max-size-t*)
+  (define! result &struct (max (&min size) 0) (min (&max size) *max-size-t*)))
 
 (define-type-checker (struct-ref s idx)
-  (and (check-type s &struct 0 +inf.0)
-       (check-type idx &exact-integer 0 +inf.0)
+  (and (check-type s &struct 0 *max-size-t*)
+       (check-type idx &exact-integer 0 *max-size-t*)
        ;; FIXME: is the field readable?
        (< (&max idx) (&min s))))
 (define-type-inferrer (struct-ref s idx result)
-  (restrict! s &struct (1+ (&min idx)) +inf.0)
-  (restrict! idx &exact-integer 0 (1- (&max s)))
+  (restrict! s &struct (1+ (&min idx)) *max-size-t*)
+  (restrict! idx &exact-integer 0 (1- (min (&max s) *max-size-t*)))
   (define! result &all-types -inf.0 +inf.0))
 
 (define-type-checker (struct-set! s idx val)
-  (and (check-type s &struct 0 +inf.0)
-       (check-type idx &exact-integer 0 +inf.0)
+  (and (check-type s &struct 0 *max-size-t*)
+       (check-type idx &exact-integer 0 *max-size-t*)
        ;; FIXME: is the field writable?
        (< (&max idx) (&min s))))
 (define-type-inferrer (struct-set! s idx val)
-  (restrict! s &struct (1+ (&min idx)) +inf.0)
-  (restrict! idx &exact-integer 0 (1- (&max s))))
+  (restrict! s &struct (1+ (&min idx)) *max-size-t*)
+  (restrict! idx &exact-integer 0 (1- (min (&max s) *max-size-t*))))
 
 (define-type-aliases allocate-struct allocate-struct/immediate)
 (define-type-aliases struct-ref struct-ref/immediate)
 (define-type-aliases struct-set! struct-set!/immediate)
 
-(define-simple-type (struct-vtable (&struct 0 +inf.0))
-  (&struct vtable-offset-user +inf.0))
+(define-simple-type (struct-vtable (&struct 0 *max-size-t*))
+  (&struct vtable-offset-user *max-size-t*))
 
 
 
@@ -667,31 +667,31 @@ minimum, and maximum."
 (define *max-char* (1- (ash 1 24)))
 
 (define-type-checker (string-ref s idx)
-  (and (check-type s &string 0 +inf.0)
-       (check-type idx &exact-integer 0 +inf.0)
+  (and (check-type s &string 0 *max-size-t*)
+       (check-type idx &exact-integer 0 *max-size-t*)
        (< (&max idx) (&min s))))
 (define-type-inferrer (string-ref s idx result)
-  (restrict! s &string (1+ (&min idx)) +inf.0)
-  (restrict! idx &exact-integer 0 (1- (&max s)))
+  (restrict! s &string (1+ (&min idx)) *max-size-t*)
+  (restrict! idx &exact-integer 0 (1- (min (&max s) *max-size-t*)))
   (define! result &char 0 *max-char*))
 
 (define-type-checker (string-set! s idx val)
-  (and (check-type s &string 0 +inf.0)
-       (check-type idx &exact-integer 0 +inf.0)
+  (and (check-type s &string 0 *max-size-t*)
+       (check-type idx &exact-integer 0 *max-size-t*)
        (check-type val &char 0 *max-char*)
        (< (&max idx) (&min s))))
 (define-type-inferrer (string-set! s idx val)
-  (restrict! s &string (1+ (&min idx)) +inf.0)
-  (restrict! idx &exact-integer 0 (1- (&max s)))
+  (restrict! s &string (1+ (&min idx)) *max-size-t*)
+  (restrict! idx &exact-integer 0 (1- (min (&max s) *max-size-t*)))
   (restrict! val &char 0 *max-char*))
 
 (define-simple-type-checker (string-length &string))
 (define-type-inferrer (string-length s result)
-  (restrict! s &string 0 +inf.0)
-  (define! result &exact-integer (max (&min s) 0) (&max s)))
+  (restrict! s &string 0 *max-size-t*)
+  (define! result &exact-integer (max (&min s) 0) (min (&max s) *max-size-t*)))
 
-(define-simple-type (number->string &number) (&string 0 +inf.0))
-(define-simple-type (string->number (&string 0 +inf.0))
+(define-simple-type (number->string &number) (&string 0 *max-size-t*))
+(define-simple-type (string->number (&string 0 *max-size-t*))
   ((logior &number &false) -inf.0 +inf.0))
 
 
@@ -713,10 +713,10 @@ minimum, and maximum."
   (define! result &flonum (&min f64) (&max f64)))
 
 (define-type-checker (scm->u64 scm)
-  (check-type scm &exact-integer 0 +inf.0))
+  (check-type scm &exact-integer 0 #xffffffffffffffff))
 (define-type-inferrer (scm->u64 scm result)
-  (restrict! scm &exact-integer 0 +inf.0)
-  (define! result &u64 (&min scm) (&max scm)))
+  (restrict! scm &exact-integer 0 #xffffffffffffffff)
+  (define! result &u64 (max (&min scm) 0) (min (&max scm) #xffffffffffffffff)))
 
 (define-type-checker (u64->scm u64)
   #t)
@@ -732,28 +732,29 @@ minimum, and maximum."
 
 (define-simple-type-checker (bv-length &bytevector))
 (define-type-inferrer (bv-length bv result)
-  (restrict! bv &bytevector 0 +inf.0)
-  (define! result &exact-integer (max (&min bv) 0) (&max bv)))
+  (restrict! bv &bytevector 0 *max-size-t*)
+  (define! result &exact-integer
+    (max (&min bv) 0) (min (&max bv) *max-size-t*)))
 
-(define-syntax-rule (define-bytevector-accessors ref set type size min max)
+(define-syntax-rule (define-bytevector-accessors ref set type size lo hi)
   (begin
     (define-type-checker (ref bv idx)
-      (and (check-type bv &bytevector 0 +inf.0)
-           (check-type idx &exact-integer 0 +inf.0)
+      (and (check-type bv &bytevector 0 *max-size-t*)
+           (check-type idx &exact-integer 0 *max-size-t*)
            (< (&max idx) (- (&min bv) size))))
     (define-type-inferrer (ref bv idx result)
-      (restrict! bv &bytevector (+ (&min idx) size) +inf.0)
-      (restrict! idx &exact-integer 0 (- (&max bv) size))
-      (define! result type min max))
+      (restrict! bv &bytevector (+ (&min idx) size) *max-size-t*)
+      (restrict! idx &exact-integer 0 (- (min (&max bv) *max-size-t*) size))
+      (define! result type lo hi))
     (define-type-checker (set bv idx val)
-      (and (check-type bv &bytevector 0 +inf.0)
-           (check-type idx &exact-integer 0 +inf.0)
-           (check-type val type min max)
+      (and (check-type bv &bytevector 0 *max-size-t*)
+           (check-type idx &exact-integer 0 *max-size-t*)
+           (check-type val type lo hi)
            (< (&max idx) (- (&min bv) size))))
     (define-type-inferrer (set! bv idx val)
-      (restrict! bv &bytevector (+ (&min idx) size) +inf.0)
-      (restrict! idx &exact-integer 0 (- (&max bv) size))
-      (restrict! val type min max))))
+      (restrict! bv &bytevector (+ (&min idx) size) *max-size-t*)
+      (restrict! idx &exact-integer 0 (- (min (&max bv) *max-size-t*) size))
+      (restrict! val type lo hi))))
 
 (define-syntax-rule (define-short-bytevector-accessors ref set size signed?)
   (define-bytevector-accessors ref set &exact-integer size
@@ -774,25 +775,25 @@ minimum, and maximum."
 (define-bytevector-accessors bv-s64-ref bv-s64-set!
   &exact-integer 8 (- #x8000000000000000) #x7fffFFFFffffFFFF)
 
-(define-syntax-rule (define-bytevector-uaccessors ref set type size min max)
+(define-syntax-rule (define-bytevector-uaccessors ref set type size lo hi)
   (begin
     (define-type-checker (ref bv idx)
-      (and (check-type bv &bytevector 0 +inf.0)
-           (check-type idx &u64 0 +inf.0)
+      (and (check-type bv &bytevector 0 *max-size-t*)
+           (check-type idx &u64 0 *max-size-t*)
            (< (&max idx) (- (&min bv) size))))
     (define-type-inferrer (ref bv idx result)
-      (restrict! bv &bytevector (+ (&min idx) size) +inf.0)
-      (restrict! idx &u64 0 (- (&max bv) size))
-      (define! result type min max))
+      (restrict! bv &bytevector (+ (&min idx) size) *max-size-t*)
+      (restrict! idx &u64 0 (- (min (&max bv) *max-size-t*) size))
+      (define! result type lo hi))
     (define-type-checker (set bv idx val)
-      (and (check-type bv &bytevector 0 +inf.0)
-           (check-type idx &u64 0 +inf.0)
-           (check-type val type min max)
+      (and (check-type bv &bytevector 0 *max-size-t*)
+           (check-type idx &u64 0 *max-size-t*)
+           (check-type val type lo hi)
            (< (&max idx) (- (&min bv) size))))
     (define-type-inferrer (set! bv idx val)
-      (restrict! bv &bytevector (+ (&min idx) size) +inf.0)
-      (restrict! idx &exact-integer 0 (- (&max bv) size))
-      (restrict! val type min max))))
+      (restrict! bv &bytevector (+ (&min idx) size) *max-size-t*)
+      (restrict! idx &exact-integer 0 (- (min (&max bv) *max-size-t*) size))
+      (restrict! val type lo hi))))
 (define-bytevector-uaccessors bv-f32-ref bv-f32-set! &f64 4 -inf.0 +inf.0)
 (define-bytevector-uaccessors bv-f64-ref bv-f64-set! &f64 8 -inf.0 +inf.0)