diff --git a/collects/tests/typed-scheme/succeed/mandelbrot.rkt b/collects/tests/typed-scheme/succeed/mandelbrot.rkt new file mode 100644 index 0000000000..95869a6e8c --- /dev/null +++ b/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)) diff --git a/collects/typed-scheme/infer/infer-unit.rkt b/collects/typed-scheme/infer/infer-unit.rkt index e5fff32341..9f1cc66819 100644 --- a/collects/typed-scheme/infer/infer-unit.rkt +++ b/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))] diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt index eb2f195d78..bf36ecc594 100644 --- a/collects/typed-scheme/private/base-env.rkt +++ b/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))] diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt index ad6104da0a..8249e11bb4 100644 --- a/collects/typed-scheme/private/base-types.rkt +++ b/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))] diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt index ade9bffaa5..46793127f9 100644 --- a/collects/typed-scheme/rep/type-rep.rkt +++ b/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 diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index 6f9ad4e4e0..635bdc078b 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/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 diff --git a/collects/typed-scheme/types/printer.rkt b/collects/typed-scheme/types/printer.rkt index 2569ab1839..4a6210080b 100644 --- a/collects/typed-scheme/types/printer.rkt +++ b/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)] diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-scheme/types/subtype.rkt index 6f946a89b9..6b2c0994ff 100644 --- a/collects/typed-scheme/types/subtype.rkt +++ b/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 )) ...))