From e26742e736f59ebb4beada50dd813105de89948d Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Wed, 23 Oct 2013 02:14:19 -0400
Subject: [PATCH] Add ClassTop type

Still TODO are better error messages when a ClassTop
is encountered for subclassing or instantiation.
---
 .../typed-racket/scribblings/reference/typed-classes.scrbl | 7 +++++++
 .../typed-racket-lib/typed-racket/base-env/base-env.rkt    | 5 +++++
 .../typed-racket-lib/typed-racket/base-env/base-types.rkt  | 1 +
 .../typed-racket-lib/typed-racket/rep/type-rep.rkt         | 4 ++++
 .../typed-racket-lib/typed-racket/types/printer.rkt        | 1 +
 .../typed-racket-lib/typed-racket/types/subtype.rkt        | 1 +
 6 files changed, 19 insertions(+)

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 6dc5ddf49d..0baab18cde 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 7b662d1d43..7b2b241a9a 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 30db7d545d..6d95d4c070 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 95b24ae34e..5c721e2184 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 3a76603fc3..331a17e100 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 8b5156c968..ecd037fbcb 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?