From 72ef0a9323ba0cf5000423b73797cd03e6f5ba4f Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 7 Feb 2014 17:20:48 -0500
Subject: [PATCH] Add other future/place primitives to TR base-env

Also fixed the type of `place-dead-evt`.
---
 .../typed-racket/base-env/base-env.rkt        | 18 ++++++++--
 .../unit-tests/typecheck-tests.rkt            | 33 +++++++++++++++++++
 2 files changed, 49 insertions(+), 2 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt
index e1e6717fce..d4302dd637 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt
@@ -1219,9 +1219,14 @@
 ;; Section 11.4 (Futures)
 [future (-poly (A) ((-> A) . -> . (-future A)))]
 [touch (-poly (A) ((-future A) . -> . A))]
+[futures-enabled? (-> -Boolean)]
+[current-future (-> (-opt (-future Univ)))]
+[future? (make-pred-ty (-future Univ))]
+[would-be-future (-poly (A) ((-> A) . -> . (-future A)))]
 [processor-count (-> -PosInt)]
 
 ;; Section 11.5 (Places)
+[place-enabled? (-> -Boolean)]
 [place? (make-pred-ty -Place)]
 [place-channel? (make-pred-ty -Place-Channel)]
 ;; FIXME: the `#:at` keyword is for remote places, not supported yet
@@ -1229,14 +1234,23 @@
                       #:at (-val #f) #f
                       #:named (Un (-val #f) -Symbol) #f
                       -Place)]
+[dynamic-place* (->key -Module-Path Sym
+                       #:in (-opt -Input-Port) #f
+                       #:out (-opt -Output-Port) #f
+                       #:err (-opt -Output-Port) #f
+                      (-values (list -Place
+                                     (-opt -Output-Port)
+                                     (-opt -Input-Port)
+                                     (-opt -Input-Port))))]
 [place-wait (-> -Place -Int)]
-[place-dead-evt (-> -Place (make-Evt -Byte))]
-[place-break (-> -Place -Void)]
+[place-dead-evt (-> -Place (-mu x (make-Evt x)))]
+[place-break (->opt -Place [(-opt (one-of/c 'hang-up 'terminate))] -Void)]
 [place-kill (-> -Place -Void)]
 [place-channel (-> (-values (list -Place-Channel -Place-Channel)))]
 [place-channel-put (-> -Place-Channel Univ -Void)]
 [place-channel-get (-> -Place-Channel Univ)]
 [place-channel-put/get (-> -Place-Channel Univ Univ)]
+[place-message-allowed? (-> Univ -Boolean)]
 
 ;; Section 12 (Macros)
 
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
index 4203c2e4de..5729fe7148 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
@@ -149,9 +149,11 @@
   racket/fixnum
   racket/flonum
   racket/function
+  racket/future
   racket/list
   racket/math
   racket/path
+  racket/place
   racket/port
   racket/sequence
   racket/set
@@ -1928,6 +1930,37 @@
          (call-with-values (lambda () (eval #'(+ 1 2))) (inst list Any))
          (-lst Univ)]
 
+       ;; futures & places primitives
+       [tc-e (future (λ () "foo")) (-future -String)]
+       [tc-e (would-be-future (λ () "foo")) (-future -String)]
+       [tc-e (touch (future (λ () "foo"))) -String]
+       [tc-e (current-future) (-opt (-future Univ))]
+       [tc-e (add1 (processor-count)) -PosInt]
+       [tc-e (assert (current-future) future?) (-future Univ)]
+       [tc-e (futures-enabled?) -Boolean]
+       [tc-e (place-enabled?) -Boolean]
+       [tc-e (dynamic-place "a.rkt" 'a #:at #f) -Place]
+       [tc-e (let-values
+               ([(p _1 _2 _3)
+                 (dynamic-place* "a.rkt" 'a #:in (open-input-string "hi"))])
+               p)
+             -Place]
+       [tc-e (let ([p (dynamic-place "a.rkt" 'a)])
+               (place-break p)
+               (place-break p 'terminate)
+               (place-kill p)
+               (list (place-wait p)
+                     (place-dead-evt p)))
+             (-lst* -Int (-mu x (make-Evt x)))]
+       [tc-e (let ()
+               (define-values (c1 c2) (place-channel))
+               (place-channel-get c2)
+               (place-channel-get c2)
+               (place-channel-put/get c2 "b")
+               (place-channel-put c1 "a"))
+             -Void]
+       [tc-e (place-message-allowed? 'msg) -Boolean]
+
        ;; for/hash, for*/hash - PR 14306
        [tc-e (for/hash: : (HashTable Symbol String)
                ([x (in-list '(x y z))]