diff --git a/pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/typed-classes.scrbl b/pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/typed-classes.scrbl index 6dc5ddf4..0baab18c 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/typed-classes.scrbl +++ b/pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/typed-classes.scrbl @@ -58,6 +58,13 @@ library. clause may appear in a class type. } +@defidform[ClassTop]{ + The supertype of all class types. A value of this type + cannot be used for subclassing, object creation, or most + other class functions. Its primary use is for reflective + operations such as @racket[is-a?]. +} + @defform[#:literals (field) (Object object-type-clause ...) #:grammar ([object-type-clause name+type 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 7b662d1d..7b2b241a 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 @@ -22,6 +22,8 @@ (only-in (types numeric-tower) [-Number N]) (only-in (rep type-rep) make-Class + make-ClassTop + make-Instance make-Name make-ValuesDots make-MPairTop @@ -962,6 +964,9 @@ ;; Section 6.2 (Classes) [object% (make-Class #f null null null null)] +[is-a? (-> (make-Instance (make-Class #f null null null null)) + (make-ClassTop) + -Boolean)] ;; Section 9.1 [exn:misc:match? (-> Univ B)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types.rkt index 30db7d54..6d95d4c0 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types.rkt @@ -114,6 +114,7 @@ [Prompt-TagTop -Prompt-TagTop] [Continuation-Mark-KeyTop -Continuation-Mark-KeyTop] [Struct-TypeTop (make-StructTypeTop)] +[ClassTop (make-ClassTop)] [Keyword -Keyword] [Thread -Thread] [Resolved-Module-Path -Resolved-Module-Path] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt index 95b24ae3..5c721e21 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt @@ -487,6 +487,10 @@ (map list mname (map type-rec-id mty)) (map list aname (map type-rec-id aty)))])]) +;; Supertype of all Class types, cannot instantiate +;; or subclass these +(def-type ClassTop () [#:fold-rhs #:base]) + ;; row-ext : Option<(U F B Row)> ;; row : Row ;; diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt index 3a76603f..331a17e1 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt @@ -499,6 +499,7 @@ [(Syntax: t) `(Syntaxof ,(t->s t))] [(Instance: (and (? has-name?) cls)) `(Instance ,(t->s cls))] [(Instance: (? Class? cls)) (class->sexp cls #:object? #t)] + [(ClassTop:) 'ClassTop] [(? Class?) (class->sexp type)] [(Result: t (FilterSet: (Top:) (Top:)) (Empty:)) (type->sexp t)] [(Result: t fs (Empty:)) `(,(type->sexp t) : ,(filter->sexp fs))] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt index 8b5156c9..ecd037fb 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt @@ -599,6 +599,7 @@ (and ;; Note that init & augment clauses don't matter for objects (subtype-clause? method-map method-map*) (subtype-clause? field-map field-map*))] + [((? Class?) (ClassTop:)) A0] [((Class: row inits fields methods augments) (Class: row* inits* fields* methods* augments*)) ;; TODO: should the result be folded instead?