Add extflvector optimizations.

original commit: e41e91f55146e735c4dd67d02e0cf4c3c78a1f9a

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/vector.rkt

@@ -1,12 +1,12 @@
 #lang racket/base
 
 (require syntax/parse syntax/stx
-         racket/match racket/flonum
-         (for-template racket/base racket/flonum racket/unsafe/ops)
+         racket/match racket/flonum racket/extflonum
+         (for-template racket/base racket/flonum racket/extflonum racket/unsafe/ops)
          "../utils/utils.rkt"
          (utils tc-utils)
          (rep type-rep)
-         (types type-table utils numeric-tower)
+         (types type-table utils numeric-tower abbrev)
          (optimizer utils logging fixnum))
 
 (provide vector-opt-expr)
@@ -20,13 +20,16 @@
 (define-literal-syntax-class flvector-length)
 (define-unsafe-syntax-class flvector-ref)
 (define-unsafe-syntax-class flvector-set!)
+(define-literal-syntax-class extflvector-length)
+(define-unsafe-syntax-class extflvector-ref)
+(define-unsafe-syntax-class extflvector-set!)
 
 (define-syntax-class vector-op
   #:commit
   ;; we need the non-* versions of these unsafe operations to be chaperone-safe
   (pattern :vector-ref^  #:with unsafe #'unsafe-vector-ref  #:with unsafe-no-impersonator #'unsafe-vector*-ref)
   (pattern :vector-set!^ #:with unsafe #'unsafe-vector-set! #:with unsafe-no-impersonator #'unsafe-vector*-set!))
-(define-merged-syntax-class flvector-op (flvector-ref^ flvector-set!^))
+(define-merged-syntax-class flvector-op (flvector-ref^ flvector-set!^ extflvector-ref^ extflvector-set!^))
 
 (define-syntax-class known-length-vector-expr
   #:commit
@@ -53,10 +56,13 @@
   (pattern (#%plain-app op:vector-length^ v:opt-expr)
     #:do [(log-opt "vector-length" "Vector check elimination.")]
     #:with opt #'(unsafe-vector-length v.opt))
-  ;; same for flvector-length
+  ;; same for flvector-length and unsafe-flvector-length
   (pattern (#%plain-app op:flvector-length^ v:opt-expr)
     #:do [(log-opt "flvector-length" "Float vector check elimination.")]
     #:with opt #'(unsafe-flvector-length v.opt))
+  (pattern (#%plain-app op:extflvector-length^ v:opt-expr)
+    #:do [(log-opt "extflvector-length" "Extflonum vector check elimination.")]
+    #:with opt #'(unsafe-extflvector-length v.opt))
   ;; we can optimize vector ref and set! on vectors of known length if we know
   ;; the index is within bounds (for now, literal or singleton type)
   (pattern (#%plain-app op:vector-op v:known-length-vector-expr i:value-expr new:opt-expr ...)
@@ -91,16 +97,21 @@
                                    #,one-sided)))
                     (op.unsafe-no-impersonator new-v new-i new.opt ...)
                     #,safe-fallback)))))
-  ;; similarly for flvectors
+  ;; similarly for flvectors and extflvectors
   (pattern (#%plain-app op:flvector-op v:opt-expr i:fixnum-expr new:opt-expr ...)
-    #:do [(log-opt "flvector partial bounds checking elimination"
+    #:do [(define flvector? (subtypeof? #'v -FlVector))
+          (log-opt (format "~a partial bounds checking elimination"
+                           (if flvector? "flvector" "extflvector"))
                    "Partial bounds checking elimination.")]
     #:with opt
       (let ([safe-fallback #'(op new-v new-i new.opt ...)]
             [i-known-nonneg? (subtypeof? #'i -NonNegFixnum)])
         #`(let ([new-i i.opt]
                 [new-v v.opt])
-            (if #,(let ([one-sided #'(unsafe-fx< new-i (unsafe-flvector-length new-v))])
+            (if #,(let ([one-sided #`(unsafe-fx< new-i (#,(if flvector?
+                                                              #'unsafe-flvector-length
+                                                              #'unsafe-extflvector-length)
+                                                        new-v))])
                     (if i-known-nonneg?
                         one-sided
                         #`(and (unsafe-fx>= new-i 0)

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/bounds-check.rkt

@@ -6,12 +6,20 @@ TR info: bounds-check.rkt 22:1 displayln -- hidden parameter
 TR info: bounds-check.rkt 39:1 displayln -- hidden parameter
 TR info: bounds-check.rkt 41:1 displayln -- hidden parameter
 TR info: bounds-check.rkt 43:1 displayln -- hidden parameter
+TR info: bounds-check.rkt 60:1 displayln -- hidden parameter
+TR info: bounds-check.rkt 62:1 displayln -- hidden parameter
+TR info: bounds-check.rkt 64:1 displayln -- hidden parameter
 TR opt: bounds-check.rkt 12:2 (vector-ref v i) -- vector partial bounds checking elimination
 TR opt: bounds-check.rkt 15:2 (vector-set! v i n) -- vector partial bounds checking elimination
 TR opt: bounds-check.rkt 27:2 (flvector-ref v i) -- flvector partial bounds checking elimination
 TR opt: bounds-check.rkt 30:2 (flvector-set! v i n) -- flvector partial bounds checking elimination
 TR opt: bounds-check.rkt 33:2 (flvector-ref v i) -- flvector partial bounds checking elimination
 TR opt: bounds-check.rkt 36:2 (flvector-set! v i n) -- flvector partial bounds checking elimination
+TR opt: bounds-check.rkt 48:2 (extflvector-ref v i) -- extflvector partial bounds checking elimination
+TR opt: bounds-check.rkt 51:2 (extflvector-set! v i n) -- extflvector partial bounds checking elimination
+TR opt: bounds-check.rkt 54:2 (extflvector-ref v i) -- extflvector partial bounds checking elimination
+TR opt: bounds-check.rkt 57:2 (extflvector-set! v i n) -- extflvector partial bounds checking elimination
+TR opt: bounds-check.rkt 66:0 (extflvector-length efv) -- extflvector-length
 TR opt: bounds-check.rkt 6:2 (vector-ref v i) -- vector partial bounds checking elimination
 TR opt: bounds-check.rkt 9:2 (vector-set! v i n) -- vector partial bounds checking elimination
 END
@@ -22,13 +30,17 @@ END
 3.0
 4.0
 5.0
+3.0t0
+4.0t0
+5.0t0
+4
 
 END
 
 #lang typed/racket
 #reader tests/typed-racket/optimizer/reset-port
 
-(require racket/flonum)
+(require racket/flonum racket/extflonum)
 
 (: f (All (X) ((Vectorof X) Fixnum -> X)))
 (define (f v i)
@@ -70,3 +82,26 @@ END
 (displayln (fh fv 2))
 (fa fv 2 5.0)
 (displayln (ff fv 2))
+
+
+(: b (ExtFlVector Fixnum -> ExtFlonum))
+(define (b v i)
+  (extflvector-ref v i))
+(: c (ExtFlVector Fixnum ExtFlonum -> Void))
+(define (c v i n)
+  (extflvector-set! v i n))
+(: d (ExtFlVector Index -> ExtFlonum))
+(define (d v i)
+  (extflvector-ref v i))
+(: e (ExtFlVector Index ExtFlonum -> Void))
+(define (e v i n)
+  (extflvector-set! v i n))
+
+(define: efv : ExtFlVector (extflvector 1.0t0 2.0t0 3.0t0 4.0t0))
+(displayln (b efv 2))
+(c efv 2 4.0t0)
+(displayln (d efv 2))
+(e efv 2 5.0t0)
+(displayln (b efv 2))
+
+(extflvector-length efv)