Add FlVector types to Typed Scheme and bindings for all flvector operations in scheme/flonum and scheme/unsafe/ops.

svn: r18555

original commit: 39a1489403db3184b23622dfde17548d65681f6a

collects/tests/typed-scheme/succeed/flvector.ss

@@ -0,0 +1,39 @@
+#lang typed/scheme
+
+(require
+ scheme/flonum
+ scheme/unsafe/ops)
+
+;; Test the all the flvector operations have been wrapped with types
+
+;; We aren't really testing the semantics of the
+;; operations. The checks are just to catch anything that is
+;; really badly wrong.
+
+(: check (All (a) ((a a -> Boolean) a a -> Boolean)))
+;; Simple check function as SchemeUnit doesn't work in Typed Scheme (yet)
+(define (check f a b)
+  (if (f a b)
+      #t
+      (error (format "Check (~a ~a ~a) failed" f a b)))) 
+
+(check equal? (flvector 1. 2. 3. 4.) (flvector 1. 2. 3. 4.))
+(check equal? (flvector? (flvector 1. 2. 3.)) #t)
+(check equal? (make-flvector 3 3.0) (flvector 3. 3. 3.))
+(check = (flvector-length (flvector 1. 2. 3.)) 3)
+(check = (flvector-ref (flvector 1. 2. 3.) 0) 1.)
+(check =
+       (let ([v (flvector 1. 2. 3.)])
+         (flvector-set! v 0 10.)
+         (flvector-ref v 0))
+       10.)
+
+;; Unsafe operations
+
+(check = (unsafe-flvector-length (flvector 1. 2. 3.)) 3)
+(check = (unsafe-flvector-ref (flvector 1. 2. 3.) 0) 1.)
+(check =
+       (let ([v (flvector 1. 2. 3.)])
+         (unsafe-flvector-set! v 0 10.)
+         (unsafe-flvector-ref v 0))
+       10.)

collects/typed-scheme/private/base-env-numeric.ss

@@ -236,3 +236,20 @@
 [fl>= fl-comp]
 [fl> fl-comp]
 [fl< fl-comp]
+
+;; safe flvector ops
+
+[flvector? (make-pred-ty -FlVector)]
+[flvector (->* (list) -Flonum -FlVector)]
+[make-flvector (-> -Integer -Flonum -FlVector)]
+[flvector-length (-> -FlVector -Nat)]
+[flvector-ref (-> -FlVector -Nat -Flonum)]
+[flvector-set! (-> -FlVector -Nat -Flonum -Void)]
+
+;; unsafe flvector ops
+
+[unsafe-flvector (->* (list) -Flonum -FlVector)]
+[unsafe-make-flvector (-> -Integer -Flonum -FlVector)]
+[unsafe-flvector-length (-> -FlVector -Nat)]
+[unsafe-flvector-ref (-> -FlVector -Nat -Flonum)]
+[unsafe-flvector-set! (-> -FlVector -Nat -Flonum -Void)]

collects/typed-scheme/types/abbrev.ss

@@ -8,6 +8,7 @@
          scheme/list
          scheme/match         
          scheme/promise
+         scheme/flonum
          (prefix-in c: scheme/contract)
          (for-syntax scheme/base syntax/parse)
 	 (for-template scheme/base scheme/contract scheme/promise scheme/tcp))
@@ -99,6 +100,8 @@
 (define -Input-Port (make-Base 'Input-Port #'input-port?))
 (define -TCP-Listener (make-Base 'TCP-Listener #'tcp-listener?))
 
+(define -FlVector (make-Base 'FlVector #'flvector?))
+
 (define -Syntax make-Syntax)
 (define -HT make-Hashtable)
 (define -Promise make-promise-ty)