TR: Added Thread Cells and corresponding operations

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

@@ -27,6 +27,7 @@
  (only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym])
  (only-in (rep type-rep) make-HashtableTop make-MPairTop
           make-BoxTop make-ChannelTop make-VectorTop
+          make-ThreadCellTop
           make-Ephemeron
           make-HeterogenousVector))
 
@@ -447,7 +448,14 @@
 [thread-try-receive (-> Univ)]
 [thread-rewind-receive (-> (-lst Univ) -Void)]
 
+;Section 10.3.1 (Thread Cells)
 
+[thread-cell? (make-pred-ty (make-ThreadCellTop))]
+[make-thread-cell (-poly (a) (->opt a [Univ] (-thread-cell a)))]
+[thread-cell-ref (-poly (a) (-> (-thread-cell a) a))]
+[thread-cell-set! (-poly (a) (-> (-thread-cell a) a -Void))]
+[current-preserved-thread-cell-values
+ (cl->* (-> Univ) (-> Univ -Void))]
 
 [future (-poly (A) ((-> A) . -> . (-future A)))]
 [touch (-poly (A) ((-future A) . -> . A))]

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

@@ -495,6 +495,8 @@
            (cset-meet* (list (cg s s*) (cg s* s) (cg t t*) (cg t* t)))]
           [((Channel: e) (Channel: e*))
            (cset-meet (cg e e*) (cg e* e))]
+          [((ThreadCell: e) (ThreadCell: e*))
+           (cset-meet (cg e e*) (cg e* e))]
           [((Ephemeron: e) (Ephemeron: e*))
            (cg e e*)]
           [((Set: a) (Set: a*))

collects/typed-scheme/infer/promote-demote.rkt

@@ -26,6 +26,7 @@
              [#:Vector t (make-Vector (inv t))]
              [#:Box t (make-Box (inv t))]
              [#:Channel t (make-Channel (inv t))]
+             [#:ThreadCell t (make-ThreadCell (inv t))]
              [#:Hashtable k v
                           (if (V-in? V v)
                               Univ
@@ -60,6 +61,7 @@
              [#:Vector t (make-Vector (inv t))]
              [#:Box t (make-Box (inv t))]
              [#:Channel t (make-Channel (inv t))]
+             [#:ThreadCell t (make-ThreadCell (inv t))]
              [#:Hashtable k v
                           (if (V-in? V v)
                               (Un)

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

@@ -130,6 +130,12 @@
   [#:frees (λ (f) (make-invariant (f elem)))]
   [#:key 'channel])
 
+;; elem is a Type
+(def-type ThreadCell ([elem Type/c])
+  [#:frees (λ (f) (make-invariant (f elem)))]
+  [#:key 'thread-cell])
+
+
 ;; elem is a Type
 (def-type Ephemeron ([elem Type/c])
   [#:key 'ephemeron])
@@ -140,6 +146,8 @@
   [#:key 'set])
 
 
+
+
 ;; name is a Symbol (not a Name)
 ;; contract is used when generating contracts from types
 ;; predicate is used to check (at compile-time) whether a value belongs
@@ -315,6 +323,7 @@
 (def-type HashtableTop () [#:fold-rhs #:base] [#:key 'hash])
 (def-type MPairTop () [#:fold-rhs #:base] [#:key 'mpair])
 (def-type StructTop ([name Struct?]) [#:key 'struct])
+(def-type ThreadCellTop () [#:fold-rhs #:base] [#:key 'thread-cell])
 
 ;; v : Scheme Value
 (def-type Value (v) [#:frees #f] [#:fold-rhs #:base] [#:key (cond [(number? v) 'number]

collects/typed-scheme/types/abbrev.rkt

@@ -31,6 +31,7 @@
 (define -Param make-Param)
 (define -box make-Box)
 (define -channel make-Channel)
+(define -thread-cell make-ThreadCell)
 (define -set make-Set)
 (define -vec make-Vector)
 (define -future make-Future)

collects/typed-scheme/types/printer.rkt

@@ -125,6 +125,7 @@
     [(StructTop: st) (fp "~a" st)]
     [(BoxTop:) (fp "Box")]
     [(ChannelTop:) (fp "Channel")]
+    [(ThreadCellTop:) (fp "ThreadCell")]
     [(VectorTop:) (fp "Vector")]
     [(MPairTop:) (fp "MPair")]
     [(App: rator rands stx)
@@ -171,6 +172,7 @@
     [(Box: e) (fp "(Boxof ~a)" e)]
     [(Future: e) (fp "(Futureof ~a)" e)]
     [(Channel: e) (fp "(Channelof ~a)" e)]
+    [(ThreadCell: e) (fp "(ThreadCellof ~a)" e)]
     [(Ephemeron: e) (fp "(Ephemeronof ~a)" e)]
     [(Set: e) (fp "(Setof ~a)" e)]
     [(Union: elems) (fp "~a" (cons 'U elems))]

collects/typed-scheme/types/subtype.rkt

@@ -372,6 +372,7 @@
               [((Ephemeron: s) (Ephemeron: t))
                (subtype* A0 s t)]
               [((Box: _) (BoxTop:)) A0]
+              [((ThreadCell: _) (ThreadCellTop:)) A0]
               [((Set: t) (Set: t*)) (subtype* A0 t t*)]
               [((Channel: _) (ChannelTop:)) A0]
               [((Vector: _) (VectorTop:)) A0]