Add Futureof' type, types for future' and `touch'

collects/tests/typed-scheme/succeed/mandelbrot.rkt

@@ -0,0 +1,30 @@
+#lang typed/racket/base #:optimize
+(require racket/future racket/flonum)
+(define: MAX-ITERS : Positive-Fixnum 50)
+(define MAX-DIST 2.0)
+(define: N : Positive-Fixnum 512)
+(: mandelbrot-point : Integer Integer -> Integer)
+(define (mandelbrot-point x y)
+  (define c 
+    (+ (- (/ (* 2.0 (->fl x)) N) 1.5)
+       (* 0.0+1.0i (- (/ (* 2.0 (->fl y)) N) 1.0))))
+  (let loop ((i 0) (z 0.0+0.0i))
+    (cond
+      [(> i MAX-ITERS) (char->integer #\*)]
+      [(> (magnitude z) MAX-DIST)
+       (char->integer #\space)]
+      [else (loop (add1 i) (+ (* z z) c))])))
+
+(: fs (Listof (Futureof Bytes)))
+(define fs
+  (for/list ([y (in-range N)])
+    (let ([bstr (make-bytes N)])
+      (future
+       (lambda ()
+         (for ([x (in-range N)])
+           (bytes-set! bstr x (mandelbrot-point x y)))
+         bstr)))))
+#;
+(for: ([f : (Futureof Bytes) (in-list fs)])
+  (write-bytes (touch f))
+  (newline))

collects/typed-scheme/infer/infer-unit.rkt

@@ -476,6 +476,9 @@
           ;; syntax is covariant
           [((Syntax: s1) (Syntax: s2))
            (cg s1 s2)]
+          ;; futures are covariant
+          [((Future: s1) (Future: s2))
+           (cg s1 s2)]
           ;; parameters are just like one-arg functions
           [((Param: in1 out1) (Param: in2 out2))
            (cset-meet (cg in2 in1) (cg out1 out2))]

collects/typed-scheme/private/base-env.rkt

@@ -5,6 +5,7 @@
  racket
  racket/unsafe/ops
  racket/fixnum
+ racket/future
  (only-in rnrs/lists-6 fold-left)
  '#%paramz
  "extra-procs.rkt"
@@ -311,6 +312,9 @@
 [thread-try-receive (-> Univ)]
 [thread-rewind-receive (-> (-lst Univ) -Void)]
 
+[future (-poly (A) ((-> A) . -> . (-future A)))]
+[touch (-poly (A) ((-future A) . -> . A))]
+
 [reverse (-poly (a) (-> (-lst a) (-lst a)))]
 [append (-poly (a) (->* (list) (-lst a) (-lst a)))]
 [length (-poly (a) (-> (-lst a) -NonnegativeFixnum))]

collects/typed-scheme/private/base-types.rkt

@@ -62,6 +62,7 @@
 [True (-val #t)]
 [Null (-val null)]
 [Nothing (Un)]
+[Futureof (-poly (a) (-future a))]
 [Pairof (-poly (a b) (-pair a b))]
 [MPairof (-poly (a b) (-mpair a b))]
 [MListof (-poly (a) (-mlst a))]

collects/typed-scheme/rep/type-rep.rkt

@@ -386,6 +386,8 @@
     [#:frees (λ (f) (combine-frees (map f tys)))]
     [#:key #f] [#:fold-rhs (*Sequence (map type-rec-id tys))])
 
+(dt Future ([t Type/c]) [#:key 'future])
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Ugly hack - should use units

collects/typed-scheme/types/abbrev.rkt

@@ -29,6 +29,7 @@
 (define -box make-Box)
 (define -channel make-Channel)
 (define -vec make-Vector)
+(define -future make-Future)
 (define (-seq . args) (make-Sequence args))
 
 (define-syntax *Un

collects/typed-scheme/types/printer.rkt

@@ -168,6 +168,7 @@
                                (fp " ~a" i))
                              (fp ")")]
     [(Box: e) (fp "(Boxof ~a)" e)]
+    [(Future: e) (fp "(Futureof ~a)" e)]
     [(Channel: e) (fp "(Channelof ~a)" e)]
     [(Union: elems) (fp "~a" (cons 'U elems))]
     [(Pair: l r) (fp "(Pairof ~a ~a)" l r)]

collects/typed-scheme/types/subtype.rkt

@@ -393,6 +393,8 @@
 	      ;; subtyping on other stuff
 	      [((Syntax: t) (Syntax: t*))
 	       (subtype* A0 t t*)]
+              [((Future: t) (Future: t*))
+               (subtype* A0 t t*)]
 	      [((Instance: t) (Instance: t*))
 	       (subtype* A0 t t*)]
               [((Class: '() '() (list (and s  (list names  meths )) ...))