add support to struct/dc to name the selector directly

and use that in struct/c

closes PR 13054
closes PR 13461
related to PR 13050

collects/racket/contract/private/struct-dc.rkt

@@ -533,6 +533,9 @@
            [sel-id
             (identifier? #'sel-id) 
             #t]
+           [(#:selector sel-id)
+            (identifier? #'sel-id)
+           #t]
            [(sel-id #:parent struct-id)
             (and (identifier? #'sel-id)
                  (identifier? #'struct-id))
@@ -547,8 +550,6 @@
              [(sel-name (dep-name ...) stuff1 . stuff) ;; need stuff1 here so that things like [a (>=/c x)] do not fall into this case
               (sel-name? #'sel-name)
               (let ()
-                (unless (sel-name? #'sel-name)
-                  (raise-syntax-error 'struct/dc not-field-name-str stx #'sel-name))
                 (for ([name (in-list (syntax->list #'(dep-name ...)))])
                   (unless (sel-name? name)
                     (raise-syntax-error 'struct/dc not-field-name-str stx name)))
@@ -668,6 +669,9 @@
     [x 
      (identifier? #'x)
      (combine struct-id id)]
+    [(#:selector sel-id)
+     (identifier? #'sel-id)
+     #'sel-id]
     [(sel-id #:parent parent-id)
      (combine #'parent-id #'sel-id)]))
 
@@ -1069,7 +1073,7 @@
                                        (string->symbol (regexp-replace strip-reg (symbol->string (syntax-e sel)) ""))))
                       (cond
                         [(free-identifier=? #'struct-name struct-id)
-                         field-name]
+                         #`(#:selector #,sel)]
                         [else
                          #`(#,field-name #:parent #,struct-id)])]
                      [else #f])])]
@@ -1085,8 +1089,8 @@
        (do-struct/dc
         #t
         (with-syntax ([(fields ...) (for/list ([selector-id (in-list selector-ids)]
-                                                     [i (in-naturals)])
+                                               [i (in-naturals)])
-                                            (selector-id->field selector-id i))])
+                                      (selector-id->field selector-id i))])
           #`(-struct/dc struct-name [fields args] ...))))]
     [(_ struct-name anything ...)
      (raise-syntax-error 'struct/c "expected a struct identifier" stx (syntax struct-name))]))

collects/scribblings/reference/contracts.scrbl

@@ -418,6 +418,7 @@ produced.  Otherwise, an impersonator contract is produced.
                                        maybe-dep-state
                                        contract-expr]]
                [field-name field-id
+                           (#:selector selector-id)
                            (field-id #:parent struct-id)]
                [maybe-lazy (code:line) #:lazy]
                [maybe-flat-or-impersonator (code:line) #:flat #:impersonator]
@@ -432,13 +433,19 @@ expression is evaluated each time a selector is applied, building a new contract
 for the fields based on the values of the @racket[dep-field-name] fields (the
 @racket[dep-field-name] syntax is the same as the @racket[field-name] syntax).
 If the field is a dependent field, then it is assumed that the contract is
-a chaperone, but not always a flat contract (and theus the entire @racket[struct/dc]
+a chaperone, but not always a flat contract (and thus the entire @racket[struct/dc]
 contract is not a flat contract).
 If this is not the case, and the contract is
 always flat then the field must be annotated with
 the @racket[#:flat], or the field must be annotated with
 @racket[#:chaperone] (in which case, it must be a mutable field).
 
+A @racket[field-name] is either an identifier naming a field in the first
+case, an identifier naming a selector in the second case indicated
+by the @racket[#:selector] keyword, or
+a field id for a struct that is a parent of @racket[struct-id], indicated
+by the @racket[#:parent] keyword.
+
 If the @racket[#:lazy] keyword appears, then the contract
 on the field is check lazily (only when a selector is applied);
 @racket[#:lazy] contracts cannot be put on mutable fields.

collects/tests/racket/contract-test.rktl

@@ -14402,6 +14402,45 @@ so that propagation occurs.
       (eval '(require 'provide/contract42-m2))
       (eval 'provide/contract42-x))
    10)
+  
+  (test/spec-passed/result
+   'provide/contract43
+   '(begin
+      (eval '(module provide/contract43-m1 racket/base
+               (require racket/contract)
+               (struct spider (legs))
+               (provide (contract-out (struct spider ([legs number?]))))))
+      
+      (eval '(module provide/contract43-m2 racket/base
+               (require racket/contract 'provide/contract43-m1)
+               (provide provide/contract43-x)
+               (define provide/contract43-x
+                 (spider-legs
+                  (contract (struct/c spider integer?)
+                            (spider 121)
+                            'pos
+                            'neg)))))
+
+      (eval '(require 'provide/contract43-m2))
+      (eval 'provide/contract43-x))
+   121)
+  
+  (test/spec-passed
+   'provide/contract44
+   '(begin
+      (eval '(module provide/contract44-m1 racket/base
+               (require racket/contract)
+                (struct heap (v) #:transparent)
+               (provide (rename-out (heap new-heap)))))
+      
+      (eval '(module provide/contract44-m2 racket/base
+               (require racket/contract 'provide/contract44-m1)
+               (contract (struct/c new-heap any/c)
+                         (new-heap 121)
+                         'pos
+                         'neg)))
+
+      (eval '(require 'provide/contract44-m2))))
 
   (contract-error-test
    'contract-error-test8