Make promises like every other TR container.

original commit: df6562c1de124a01a4a104cf8f813078b12bd680

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

@@ -529,6 +529,8 @@
            (cset-meet (cg e e*) (cg e* e))]
           [((ThreadCell: e) (ThreadCell: e*))
            (cset-meet (cg e e*) (cg e* e))]
+          [((Promise: e) (Promise: e*))
+           (cg e e*)]
           [((Ephemeron: e) (Ephemeron: e*))
            (cg e e*)]
           [((CustodianBox: e) (CustodianBox: e*))

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

@@ -139,6 +139,9 @@
   [#:frees (λ (f) (make-invariant (f elem)))]
   [#:key 'thread-cell])
 
+;; elem is a Type
+(def-type Promise ([elem Type/c])
+  [#:key 'promise])
 
 ;; elem is a Type
 (def-type Ephemeron ([elem Type/c])

collects/typed-racket/types/abbrev.rkt

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

collects/typed-racket/types/base-abbrev.rkt

@@ -9,7 +9,7 @@
          (for-template racket/base)
          (for-syntax racket/base syntax/parse racket/list))
 
-(provide (except-out (all-defined-out) Promise))
+(provide (all-defined-out))
 
 ;Top and error types
 (define Univ (make-Univ))
@@ -22,13 +22,6 @@
 (define ManyUniv Univ)
 
 
-; Promise type
-; TODO make this not a struct type, but the same as all other container types
-(define Promise #f)
-(define promise-id #'Promise)
-(define -Promise
- (lambda (t)
-   (make-Struct promise-id #f (list (make-fld t #'values #f)) #f #f #'promise? values #'values)))
 
 
 ;; Char type (needed because of how sequences are checked in subtype)

collects/typed-racket/types/printer.rkt

@@ -3,7 +3,7 @@
 (require racket/require racket/match unstable/sequence racket/string racket/promise
          (prefix-in s: srfi/1)
          (path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt"
-                  "rep/rep-utils.rkt" "types/abbrev.rkt" "types/subtype.rkt"
+                  "rep/rep-utils.rkt" "types/subtype.rkt"
                   "utils/utils.rkt"
                   "utils/tc-utils.rkt")
          (for-syntax racket/base syntax/parse))
@@ -22,7 +22,6 @@
 
 (provide print-multi-line-case-> special-dots-printing? print-complex-filters?)
 
-;;TODO try to remove requirement on abbrev once promise is fixed
 
 ;; do we attempt to find instantiations of polymorphic types to print?
 ;; FIXME - currently broken
@@ -238,9 +237,6 @@
      (fp "~a" (cons 'List (tuple-elems t)))]
     [(Base: n cnt _ _ _) (fp "~s" n)]
     [(Opaque: pred _) (fp "(Opaque ~a)" (syntax->datum pred))]
-    [(Struct: (? (lambda (nm) (free-identifier=? promise-id nm)))
-              #f (list (fld: t _ _)) _    _ _ _ _)
-     (fp "(Promise ~a)" t)]
     [(Struct: nm       par (list (fld: t _ _) ...)       proc _ _ _ _)
      (fp "#(struct:~a ~a" nm t)
      (when proc
@@ -257,6 +253,7 @@
     [(Future: e) (fp "(Futureof ~a)" e)]
     [(Channel: e) (fp "(Channelof ~a)" e)]
     [(ThreadCell: e) (fp "(ThreadCellof ~a)" e)]
+    [(Promise: e) (fp "(Promise ~a)" e)]
     [(Ephemeron: e) (fp "(Ephemeronof ~a)" e)]
     [(CustodianBox: e) (fp "(CustodianBoxof ~a)" e)]
     [(Set: e) (fp "(Setof ~a)" e)]

collects/typed-racket/types/subtype.rkt

@@ -413,6 +413,9 @@
               [((Struct: nm _ _ _ _ _ _ _) (StructTop: (Struct: nm* _ _ _ _ _ _ _))) (=> nevermind)
                (unless (free-identifier=? nm nm*) (nevermind))
                A0]
+              ;; Promises are covariant
+              [((Promise: s) (Promise: t))
+               (subtype* A0 s t)]
               ;ephemerons are covariant
               [((Ephemeron: s) (Ephemeron: t))
                (subtype* A0 s t)]
@@ -432,10 +435,6 @@
               [((Struct: nm (? Type? parent) flds proc _ _ _ _) other)
                ;(dprintf "subtype - hierarchy : ~a ~a ~a\n" nm parent other)
                (subtype* A0 parent other)]
-              ;; Promises are covariant
-              [((Struct: (? (lambda (n) (free-identifier=? n promise-id))) _ (list t) _ _ _ _ _)
-                (Struct: (? (lambda (n) (free-identifier=? n promise-id))) _ (list t*) _ _ _ _ _))
-               (subtype* A0 t t*)]
               ;; subtyping on values is pointwise
               [((Values: vals1) (Values: vals2)) (subtypes* A0 vals1 vals2)]
               ;; trivial case for Result