Switched name field in struct type to identifier. Closes PR 11728.

Closes PR 11998. Closes PR11859.

collects/tests/typed-scheme/fail/pr11998.rkt

@@ -0,0 +1,15 @@
+#lang racket/load
+(module p typed/racket
+  (struct: (a) p ((v : a)))
+  (provide p p-v))
+
+(module p2 typed/racket
+  (struct: (a) p ((v : a)))
+  (provide p))
+
+
+(module m typed/racket
+  (require (only-in 'p p-v) 'p2)
+  (p-v (p 0)))
+
+(require 'm)

collects/tests/typed-scheme/succeed/pr11728.rkt

@@ -0,0 +1,27 @@
+#lang racket/load
+
+
+(module b typed/racket/base
+  (provide (all-defined-out))    
+  (define-struct: string-type () #:transparent))
+
+(module c typed/racket/base
+  (provide (all-defined-out))    
+  (define-struct: string-type () #:transparent))
+
+(module a typed/racket/base
+  
+
+  (require 
+   (prefix-in one: 'b)
+   (prefix-in two: 'c)
+   )  
+  
+  
+  (provide foo)
+  
+  (: foo two:string-type)
+  (define foo (two:string-type)))
+
+(require 'a)
+foo

collects/tests/typed-scheme/succeed/pr11859.rkt

@@ -0,0 +1,9 @@
+#lang racket/load
+(module stream typed/racket
+  (define-type (Stream a) (Rec s (Promise (U Null (Pair a s)))))
+  (provide Stream))
+(module m typed/racket
+  (require 'stream)
+  (: x (Stream Integer))
+  (define x (delay '())))
+(require 'm)

collects/tests/typed-scheme/unit-tests/subtype-tests.rkt

@@ -113,14 +113,14 @@
    [(-values (list -Number)) (-values (list Univ))]
 
    [(-poly (b) ((Un (make-Base 'foo #'dummy values #'values)
-                    (-struct 'bar #f
+                    (-struct #'bar #f
                              (list (make-fld -Number #'values #f) (make-fld b #'values #f))
                              #'values))
                 . -> . (-lst b)))
-    ((Un (make-Base 'foo #'dummy values #'values) (-struct 'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values))
+    ((Un (make-Base 'foo #'dummy values #'values) (-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values))
      . -> . (-lst (-pair -Number (-v a))))]
-   [(-poly (b) ((-struct 'bar #f (list (make-fld -Number #'values #f) (make-fld b #'values #f)) #'values) . -> . (-lst b)))
+   [(-poly (b) ((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld b #'values #f)) #'values) . -> . (-lst b)))
-    ((-struct 'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values) . -> . (-lst (-pair -Number (-v a))))]
+    ((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values) . -> . (-lst (-pair -Number (-v a))))]
 
    [(-poly (a) (a . -> . (make-Listof a))) ((-v b) . -> . (make-Listof (-v b)))]
    [(-poly (a) (a . -> . (make-Listof a))) ((-pair -Number (-v b)) . -> . (make-Listof (-pair -Number (-v b))))]
@@ -132,9 +132,9 @@
    (FAIL (-> Univ) (null Univ . ->* . Univ))
 
    [(cl->* (-Number . -> . -String) (-Boolean . -> . -String)) ((Un -Boolean -Number) . -> . -String)]
-   [(-struct 'a #f null #'values) (-struct 'a #f null #'values)]
+   [(-struct #'a #f null #'values) (-struct #'a #f null #'values)]
-   [(-struct 'a #f (list (make-fld -String #'values #f)) #'values) (-struct 'a #f (list (make-fld -String #'values #f)) #'values)]
+   [(-struct #'a #f (list (make-fld -String #'values #f)) #'values) (-struct #'a #f (list (make-fld -String #'values #f)) #'values)]
-   [(-struct 'a #f (list (make-fld -String #'values #f)) #'values) (-struct 'a #f (list (make-fld Univ #'values #f)) #'values)]
+   [(-struct #'a #f (list (make-fld -String #'values #f)) #'values) (-struct #'a #f (list (make-fld Univ #'values #f)) #'values)]
    ))
 
 (define-go

collects/tests/typed-scheme/unit-tests/type-equal-tests.rkt

@@ -39,12 +39,12 @@
    [(-mu x (Un -Number -Symbol x)) (-mu y (Un -Number -Symbol y))]
    ;; found bug
    [FAIL (Un (-mu heap-node
-                  (-struct 'heap-node #f
+                  (-struct #'heap-node #f
                            (map fld* (list (-base 'comparator) -Number (-v a) (Un heap-node (-base 'heap-empty))))
                            #'values))
              (-base 'heap-empty))
          (Un (-mu heap-node
-                  (-struct 'heap-node #f
+                  (-struct #'heap-node #f
                            (map fld* (list (-base 'comparator) -Number (-pair -Number -Number) (Un heap-node (-base 'heap-empty)))) #'values))
              (-base 'heap-empty))]))
 

collects/typed-scheme/env/init-envs.rkt

@@ -27,7 +27,7 @@
     [(Name: stx) `(make-Name (quote-syntax ,stx))]
     [(fld: t acc mut) `(make-fld ,(sub t) (quote-syntax ,acc) ,mut)]
     [(Struct: name parent flds proc poly? pred-id cert maker-id)
-     `(make-Struct ,(sub name) ,(sub parent)
+     `(make-Struct (quote-syntax ,name) ,(sub parent)
                    ,(sub flds) ,(sub proc) ,(sub poly?)
                    (quote-syntax ,pred-id) (syntax-local-certifier)
                    (quote-syntax ,maker-id))]

collects/typed-scheme/infer/infer-unit.rkt

@@ -292,7 +292,7 @@
     [(_ _) (fail! s-arr t-arr)]))
 
 (define/cond-contract (cgen/flds V X Y flds-s flds-t)
-  ((listof symbol?) (listof symbol?) (listof symbol?) Type? Type? . -> . cset?)
+  ((listof symbol?) (listof symbol?) (listof symbol?) (listof fld?) (listof fld?)  . -> . cset?)
   (cset-meet*
    (for/list ([s (in-list flds-s)] [t (in-list flds-t)])
      (match* (s t)
@@ -378,7 +378,8 @@
 
           ;; two structs with the same name and parent
           ;; just check pairwise on the fields
-          [((Struct: nm p flds proc _ _ _ _) (Struct: nm p flds* proc* _ _ _ _))
+          [((Struct: nm p flds proc _ _ _ _) (Struct: nm* p flds* proc* _ _ _ _)) (=> nevermind)
+           (unless (free-identifier=? nm nm*) (nevermind))
            (let ([proc-c
                   (cond [(and proc proc*)
                          (cg proc proc*)]

collects/typed-scheme/rep/type-rep.rkt

@@ -286,7 +286,7 @@
   [#:fold-rhs (*fld (type-rec-id t) acc mutable?)]
   [#:intern (list t (hash-id acc) mutable?)])
 
-;; name : symbol
+;; name : identifier
 ;; parent : Struct
 ;; flds : Listof[fld]
 ;; proc : Function Type
@@ -295,7 +295,7 @@
 ;; cert : syntax certifier for pred-id
 ;; acc-ids : names of the accessors
 ;; maker-id : name of the constructor
-(def-type Struct ([name symbol?]
+(def-type Struct ([name identifier?]
                   [parent (or/c #f Struct? Name?)]
                   [flds (listof fld?)]
                   [proc (or/c #f Function?)]

collects/typed-scheme/typecheck/tc-structs.rkt

@@ -118,13 +118,12 @@
            any/c)
   ;; create the approriate names that define-struct will bind
   (define-values (struct-type-id maker pred getters setters) (struct-names nm flds setters?))
-  (let* ([name (syntax-e nm)]
+  (let* ([fld-names flds]
-         [fld-names flds]
          [this-flds (for/list ([t (in-list types)]
                                [g (in-list getters)])
                        (make-fld t g setters?))]
          [flds (append parent-fields this-flds)]
-         [sty (make-Struct name parent flds proc-ty poly? pred
+         [sty (make-Struct nm parent flds proc-ty poly? pred
                            ;; this check is so that the tests work
                            (if (syntax-transforming?) (syntax-local-certifier) values)
                            (or maker* maker))]

collects/typed-scheme/types/abbrev.rkt

@@ -20,7 +20,7 @@
          ;; for base type predicates
          racket/promise racket/tcp racket/flonum)
 
-(provide (all-defined-out)
+(provide (except-out (all-defined-out) Promise)
          (rename-out [make-Listof -lst]
                      [make-MListof -mlst]))
 
@@ -107,12 +107,12 @@
 
 ;; basic types
 
-(define promise-sym (string->uninterned-symbol "Promise"))
 
+(define Promise #f)
+(define promise-id #'Promise)
 (define make-promise-ty
-  (let ([s promise-sym])
+ (lambda (t)
-    (lambda (t)
+   (make-Struct promise-id #f (list (make-fld t #'values #f)) #f #f #'promise? values #'values)))
-      (make-Struct s #f (list (make-fld t #'values #f)) #f #f #'promise? values #'values))))
 
 (define -Listof (-poly (list-elem) (make-Listof list-elem)))
 

collects/typed-scheme/types/printer.rkt

@@ -146,7 +146,7 @@
      (fp "~a" (cons 'List (tuple-elems t)))]
     [(Base: n cnt _ _) (fp "~s" n)]
     [(Opaque: pred _) (fp "(Opaque ~a)" (syntax->datum pred))]
-    [(Struct: (== promise-sym) #f  (list (fld: t _ _)) _    _ _ _ _) (fp "(Promise ~a)" t)]
+    [(Struct: (? (lambda (nm) (free-identifier=? promise-id nm)))  #f  (list (fld: t _ _)) _    _ _ _ _) (fp "(Promise ~a)" t)]
     [(Struct: nm       par (list (fld: t _ _) ...)       proc _ _ _ _)
      (fp "#(struct:~a ~a" nm t)
      (when proc

collects/typed-scheme/types/remove-intersect.rkt

@@ -60,12 +60,14 @@
               (list (Struct: n _ flds _ _ _ _ _) (Value: '())))
           #f]
          [(list (Struct: n _ flds _ _ _ _ _)
-                (Struct: n _ flds* _ _ _ _ _))
+                (Struct: n* _ flds* _ _ _ _ _)) (=> nevermind)
+          (unless (free-identifier=? n n*) (nevermind))
           (for/and ([f flds] [f* flds*])
             (match* (f f*)
               [((fld: t _ _) (fld: t* _ _)) (overlap t t*)]))]
          [(list (Struct: n #f _ _ _ _ _ _)
-                (StructTop: (Struct: n #f _ _ _ _ _ _)))
+                (StructTop: (Struct: n* #f _ _ _ _ _ _))) (=> nevermind)
+          (unless (free-identifier=? n n*) (nevermind))
           #t]
          ;; n and n* must be different, so there's no overlap
          [(list (Struct: n #f flds _ _ _ _ _)

collects/typed-scheme/types/subtype.rkt

@@ -221,7 +221,7 @@
       (match par
         [(Poly: _ (Struct: p-name _ _ _ _ _ _ _)) p-name]
         [(Struct: p-name _ _ _ _ _ _ _) p-name]))
-    (or (equal? s-name p-name)
+    (or (free-identifier=? s-name p-name)
         (match s
           [(Poly: _ (? Struct? s*)) (in-hierarchy? s* par)]
           [(Struct: _ (and (Name: _) p) _ _ _ _ _ _) (in-hierarchy? (resolve-once p) par)]
@@ -361,7 +361,8 @@
 	      [(s (Union: es)) (or (and (ormap (lambda (elem) (subtype*/no-fail A0 s elem)) es) A0)
                                    (fail! s t))]
 	      ;; subtyping on immutable structs is covariant
-	      [((Struct: nm _ flds proc _ _ _ _) (Struct: nm _ flds* proc* _ _ _ _))
+	      [((Struct: nm _ flds proc _ _ _ _) (Struct: nm* _ flds* proc* _ _ _ _)) (=> nevermind)
+               (unless (free-identifier=? nm nm*) (nevermind))
                (let ([A (cond [(and proc proc*) (subtype* proc proc*)]
                               [proc* (fail! proc proc*)]
                               [else A0])])
@@ -388,7 +389,9 @@
                ;(dprintf "subtype - hierarchy : ~a ~a ~a\n" nm parent other)
 	       (subtype* A0 parent other)]
 	      ;; Promises are covariant
-	      [((Struct: (== promise-sym) _ (list t) _ _ _ _ _) (Struct: (== promise-sym) _ (list t*) _ _ _ _ _)) (subtype* A0 t t*)]
+          [((Struct: (? (lambda (n) (free-identifier=? n promise-id))) _ (list t) _ _ _ _ _)
+            (Struct: (? (lambda (n) (free-identifier=? n promise-id))) _ (list t*) _ _ _ _ _))
+           (subtype* A0 t t*)]
 	      ;; subtyping on values is pointwise
 	      [((Values: vals1) (Values: vals2)) (subtypes* A0 vals1 vals2)]
               ;; trivial case for Result