From d93ac7e2fffd4e29dc14ebddf7185afa7c6f633c Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Tue, 25 Feb 2014 15:53:19 -0500
Subject: [PATCH] Add static contracts for instanceof

original commit: 4bc4a74d00b62522caaf0fd9a4d334e440d5a56b
---
 .../typed-racket/private/type-contract.rkt    |  2 ++
 .../static-contracts/combinators/object.rkt   | 29 ++++++++++++++++++-
 2 files changed, 30 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 557ab05e..719c4c5b 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
@@ -376,6 +376,8 @@
                      (recursive-sc-use (if (from-typed? typed-side) typed-n* untyped-n*)))])]
         [(Instance: (? Mu? t))
          (t->sc (make-Instance (resolve-once t)))]
+        [(Instance: (? Name? t))
+         (instanceof/sc (t->sc t))]
         [(Instance: (Class: _ _ fields methods _ _))
          (match-define (list (list field-names field-types) ...) fields)
          (match-define (list (list public-names public-types) ...) methods)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt
index b6ec3f14..64435001 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt
@@ -14,7 +14,8 @@
   (contract-out
     [struct member-spec ([modifier symbol?] [id symbol?] [sc static-contract?])]
     [object/sc ((listof object-member-spec?) . -> . static-contract?)]
-    [class/sc ((listof member-spec?) boolean? (listof identifier?) (listof identifier?) . -> . static-contract?)]))
+    [class/sc ((listof member-spec?) boolean? (listof identifier?) (listof identifier?) . -> . static-contract?)]
+    [instanceof/sc (static-contract? . -> . static-contract?)]))
 
 
 
@@ -55,6 +56,26 @@
      (define (sc->constraints v f)
        (merge-restricts* 'impersonator (map f (member-seq->list (combinator-args v)))))])
 
+(struct instanceof-combinator combinator ()
+  #:transparent
+  #:property prop:combinator-name "instanceof/sc"
+  #:methods gen:sc
+    [(define (sc-map v f)
+       (match v
+         [(instanceof-combinator (list class))
+          (instanceof-combinator (list (f class 'covariant)))]))
+     (define (sc-traverse v f)
+       (match v
+         [(instanceof-combinator (list class))
+          (f class 'covariant)
+          (void)]))
+     (define (sc->contract v f)
+       (instance/sc->contract v f))
+     (define (sc->constraints v f)
+       (match v
+         [(instanceof-combinator (list class))
+          (f class)]))])
+
 
 (define member-seq->list
   (match-lambda
@@ -81,6 +102,8 @@
   (object-combinator (member-seq specs)))
 (define (class/sc specs opaque absent-fields absent-methods)
   (class-combinator (member-seq specs) opaque absent-fields absent-methods))
+(define (instanceof/sc class)
+  (instanceof-combinator (list class)))
 
 (define (wrap mod ctc)
   (define mod-stx
@@ -115,3 +138,7 @@
     #`(class/c #,@(if opaque (list '#:opaque) empty)
                #,@(map (member-spec->form f) vals)
                (absent #,@absent-methods (field #,@absent-fields)))]))
+(define (instance/sc->contract v f)
+  (match v
+   [(instanceof-combinator (list class))
+    #`(instanceof/c #,(f class))]))