From dc30b8be303c0cf001bc97b396bc9aa7eca2d597 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Sun, 18 May 2014 17:02:01 -0400 Subject: [PATCH] Add one-sided contract for ClassTop types Closes PR 14486 original commit: 8b245240ea41630905b5a66eb76485a15c113b7a --- .../typed-racket-lib/typed-racket/private/type-contract.rkt | 1 + .../typed-racket/static-contracts/combinators/derived.rkt | 5 ++++- .../tests/typed-racket/succeed/make-top-predicate.rkt | 1 + 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt index 6540f68c..398ec089 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -335,6 +335,7 @@ [(ThreadCellTop:) (only-untyped thread-cell?/sc)] [(Prompt-TagTop:) (only-untyped prompt-tag?/sc)] [(Continuation-Mark-KeyTop:) (only-untyped continuation-mark-key?/sc)] + [(ClassTop:) (only-untyped class?/sc)] ;; TODO Figure out how this should work ;[(StructTop: s) (struct-top/sc s)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt index 12f0deea..43f5bd31 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt @@ -5,7 +5,8 @@ ;; Ex: (listof/sc any/sc) => list?/sc (require "simple.rkt" "structural.rkt" - (for-template racket/base racket/list racket/set racket/promise racket/mpair)) + (for-template racket/base racket/list racket/set racket/promise racket/mpair + racket/class)) (provide (all-defined-out)) (define identifier?/sc (flat/sc #'identifier?)) @@ -30,3 +31,5 @@ (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?)) + +(define class?/sc (flat/sc #'class?)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/make-top-predicate.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/make-top-predicate.rkt index c0750844..30322ace 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/make-top-predicate.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/make-top-predicate.rkt @@ -8,6 +8,7 @@ (make-predicate Thread-CellTop) (make-predicate Prompt-TagTop) (make-predicate Continuation-Mark-KeyTop) +(make-predicate ClassTop)