Add support for 1 sided contracts on Top types.

original commit: d7ed73d5ac34a666633b06dbae9d623455e0972b

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt

@@ -194,6 +194,11 @@
         (loop t 'both recursive-values))
       (define (t->sc/method t) (t->sc/function t fail typed-side recursive-values loop #t))
       (define (t->sc/fun t) (t->sc/function t fail typed-side recursive-values loop #f))
+
+      (define (only-untyped sc)
+        (if (from-typed? typed-side)
+            (fail #:reason "contract generation not supported for this type")
+            sc))
       (match type
         ;; Applications of implicit recursive type aliases
         ;;
@@ -322,6 +327,18 @@
              (λ () (error 'type->static-contract
                           "Recursive value lookup failed. ~a ~a" recursive-values v)))
            typed-side)]
+        [(VectorTop:) (only-untyped vector?/sc)]
+        [(BoxTop:) (only-untyped box?/sc)]
+        [(ChannelTop:) (only-untyped channel?/sc)]
+        [(HashtableTop:) (only-untyped hash?/sc)]
+        [(MPairTop:) (only-untyped mpair?/sc)]
+        [(ThreadCellTop:) (only-untyped thread-cell?/sc)]
+        [(Prompt-TagTop:) (only-untyped prompt-tag?/sc)]
+        [(Continuation-Mark-KeyTop:) (only-untyped continuation-mark-key?/sc)]
+        ;; TODO Figure out how this should work
+        ;[(StructTop: s) (struct-top/sc s)]
+
+
         [(Poly: vs b)
          (if (not (from-untyped? typed-side))
              ;; in positive position, no checking needed for the variables

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt

@@ -5,7 +5,7 @@
 ;; Ex: (listof/sc any/sc) => list?/sc
 
 (require "simple.rkt" "structural.rkt"
-         (for-template racket/base racket/list racket/set racket/promise))
+         (for-template racket/base racket/list racket/set racket/promise racket/mpair))
 (provide (all-defined-out))
 
 (define identifier?/sc (flat/sc #'identifier?))
@@ -16,6 +16,8 @@
 (define cons?/sc (flat/sc #'cons?))
 (define list?/sc (flat/sc #'list?))
 
+(define mpair?/sc (flat/sc #'mpair?))
+
 (define set?/sc (flat/sc #'set?))
 (define empty-set/sc (and/sc set?/sc (flat/sc #'set-empty?)))
 
@@ -23,3 +25,8 @@
 
 (define hash?/sc (flat/sc #'hash?))
 (define empty-hash/sc (and/sc hash?/sc (flat/sc #'(λ (h) (zero? (hash-count h))))))
+
+(define channel?/sc (flat/sc #'channel?))
+(define thread-cell?/sc (flat/sc #'thread-cell?))
+(define prompt-tag?/sc (flat/sc #'continuation-prompt-tag?))
+(define continuation-mark-key?/sc (flat/sc #'continuation-mark-key?))

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/make-top-predicate.rkt

@@ -0,0 +1,13 @@
+#lang typed/racket
+
+(make-predicate VectorTop)
+(make-predicate BoxTop)
+(make-predicate ChannelTop)
+(make-predicate HashTableTop)
+(make-predicate MPairTop)
+(make-predicate Thread-CellTop)
+(make-predicate Prompt-TagTop)
+(make-predicate Continuation-Mark-KeyTop)
+
+
+