From 33469762b7ff431f3b06a4ed0b46d2c41b5f85c0 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sat, 14 Jul 2012 18:47:42 -0400
Subject: [PATCH] Parse `(Struct t)` as StructTop.

Close PR 12903.

original commit: 546c12cf2a2205aa19b205fd45a4653e3a1d2448
---
 .../typed-racket/base-env/base-types-extra.rkt |  2 +-
 collects/typed-racket/private/parse-type.rkt   | 18 ++++++++++++++----
 2 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/collects/typed-racket/base-env/base-types-extra.rkt b/collects/typed-racket/base-env/base-types-extra.rkt
index 84313705..c5149fb6 100644
--- a/collects/typed-racket/base-env/base-types-extra.rkt
+++ b/collects/typed-racket/base-env/base-types-extra.rkt
@@ -14,7 +14,7 @@
 (define-other-types
   -> case-> U Rec All Opaque Vector
   Parameterof List List* Class Values Instance Refinement
-  pred)
+  pred Struct)
 
 (provide (rename-out [All ∀]
                      [U Un]
diff --git a/collects/typed-racket/private/parse-type.rkt b/collects/typed-racket/private/parse-type.rkt
index 685789f9..6e98936c 100644
--- a/collects/typed-racket/private/parse-type.rkt
+++ b/collects/typed-racket/private/parse-type.rkt
@@ -2,16 +2,19 @@
 
 (require "../utils/utils.rkt"
 	 (except-in (rep type-rep) make-arr)
-         (rename-in (types convenience union utils printer filter-ops) [make-arr* make-arr])
+         (rename-in (types convenience union utils printer filter-ops resolve)
+                    [make-arr* make-arr])
          (utils tc-utils stxclass-util)
          syntax/stx (prefix-in c: racket/contract)
          syntax/parse racket/dict
-         (env type-env-structs tvar-env type-name-env type-alias-env lexical-env index-env)
+         (env type-env-structs tvar-env type-name-env type-alias-env
+              lexical-env index-env)
          racket/match
          "parse-classes.rkt"
          (for-template racket/base "../base-env/colon.rkt")
          ;; needed at this phase for tests
-         (combine-in (prefix-in t: "../base-env/base-types-extra.rkt") "../base-env/colon.rkt")
+         "../base-env/colon.rkt"
+         (prefix-in t: "../base-env/base-types-extra.rkt")
          (for-template (prefix-in t: "../base-env/base-types-extra.rkt")))
 
 (define-struct poly (name vars) #:prefab)
@@ -132,7 +135,7 @@
     (syntax-parse
         stx
       #:literals (t:Class t:Refinement t:Instance t:List t:List* cons t:pred t:-> : case-lambda t:case->
-                          t:Rec t:U t:All t:Opaque t:Parameter t:Vector quote)
+                  t:Rec t:U t:All t:Opaque t:Parameter t:Vector quote t:Struct)
       [t
        #:declare t (3d Type?)
        (attribute t.datum)]
@@ -159,6 +162,13 @@
          [(and t (Function: (list (arr: (list dom) _ #f #f '()))))
           (make-Refinement dom #'p? (syntax-local-certifier))]
          [t (tc-error "cannot declare refinement for non-predicate ~a" t)])]
+      [((~and kw t:Struct) t)
+       (add-disappeared-use #'kw)
+       (let ([v (parse-type #'t)])
+         (match (resolve v)
+           [(and s (Struct: _ _ _ _ _ _ _ _)) (make-StructTop s)]
+           [_ (tc-error/delayed "Argument to Struct must be a structure type, got ~a" v)
+              (make-Instance (Un))]))]
       [((~and kw t:Instance) t)
        (add-disappeared-use #'kw)
        (let ([v (parse-type #'t)])