Use syntax-procedure-alias-property with struct constructor procedures as well.

This uses a new `racket/private/procedure-alias` module
which provides the relevant symbol via `protect-out`.

collects/racket/private/define-struct.rkt

@@ -4,6 +4,7 @@
 (module define-struct '#%kernel
   (#%require "small-scheme.rkt" "define.rkt" "../stxparam.rkt"
              (for-syntax '#%kernel "define.rkt"
+                         "procedure-alias.rkt"
                          "stx.rkt" "stxcase-scheme.rkt" "small-scheme.rkt" 
                          "stxloc.rkt" "qqstx.rkt"
                          "struct-info.rkt"))
@@ -57,12 +58,21 @@
       (datum->syntax orig (syntax-e orig) stx orig))
     (syntax-case stx ()
       [(self arg ...) (datum->syntax stx
-                                     (cons (syntax-property (transfer-srcloc orig #'self)
+                                     (cons 
-                                                            'constructor-for
+                                      (syntax-property
-                                                            (syntax-local-introduce #'self))
+                                       (syntax-property (transfer-srcloc orig #'self)
-                                           (syntax-e (syntax (arg ...))))
+                                                        'constructor-for
+                                                        (syntax-local-introduce #'self))
+                                       alias-of (syntax-local-introduce #'self))
+                                      (syntax-e (syntax (arg ...))))
                                      stx
                                      stx)]
+      [self (identifier? #'self)
+       (syntax-property
+        (syntax-property (transfer-srcloc orig #'self)
+                         'constructor-for
+                         (syntax-local-introduce #'self))
+        alias-of (syntax-local-introduce #'self))]
       [_ (transfer-srcloc orig stx)]))
   
   (define-values-for-syntax (make-self-ctor-struct-info)

collects/racket/private/kw.rkt

@@ -3,6 +3,7 @@
              "small-scheme.rkt"
              "more-scheme.rkt"
              (for-syntax '#%kernel
+                         "procedure-alias.rkt"
                          "stx.rkt"
                          "small-scheme.rkt"
                          "stxcase-scheme.rkt"
@@ -972,14 +973,11 @@
   (define-for-syntax kw-expander-impl (make-struct-field-accessor kw-expander-ref 1 'impl))
   (define-for-syntax kw-expander-proc (make-struct-field-accessor kw-expander-ref 2 'proc))
 
-  (define-for-syntax kw-alias-of (gensym 'alias-of))
   (define-for-syntax kw-converted-arguments-variant-of (gensym 'converted-arguments-variant-of))
 
-  (define-for-syntax (syntax-procedure-alias-property stx)
-    (unless (syntax? stx) (raise-argument-error 'syntax-procedure-alias "syntax?" stx))
-    (syntax-property stx kw-alias-of))
   (define-for-syntax (syntax-procedure-converted-arguments-property stx) 
-    (unless (syntax? stx) (raise-argument-error 'syntax-procedure-converted-arguments "syntax?" stx))
+    (unless (syntax? stx)
+      (raise-argument-error 'syntax-procedure-converted-arguments "syntax?" stx))
     (syntax-property stx kw-converted-arguments-variant-of))
 
   (define-for-syntax (make-keyword-syntax get-ids n-req n-opt rest? req-kws all-kws)
@@ -1015,7 +1013,7 @@
                                   (cons (syntax-taint (syntax-local-introduce #'self))
                                         (syntax-taint (syntax-local-introduce impl-id))))]
                 [wrap-id/prop
-                 (syntax-property wrap-id kw-alias-of 
+                 (syntax-property wrap-id alias-of 
                                   (cons (syntax-taint (syntax-local-introduce #'self))
                                         (syntax-taint (syntax-local-introduce wrap-id))))])
             (if (free-identifier=? #'new-app (datum->syntax stx '#%app))
@@ -1124,7 +1122,7 @@
                                 orig))))
                 (datum->syntax stx (cons wrap-id/prop #'(arg ...)) stx stx)))]
          [self
-          (syntax-property wrap-id kw-alias-of (cons (syntax-taint (syntax-local-introduce #'self))
+          (syntax-property wrap-id alias-of (cons (syntax-taint (syntax-local-introduce #'self))
                                                      (syntax-taint (syntax-local-introduce wrap-id))))]))
      (lambda () (define-values (impl-id wrap-id) (get-ids)) impl-id)
      (lambda () (define-values (impl-id wrap-id) (get-ids)) wrap-id)))

collects/racket/private/procedure-alias.rkt

@@ -0,0 +1,19 @@
+(module procedure-alias '#%kernel
+  (#%require "define.rkt"
+             "small-scheme.rkt"
+             "more-scheme.rkt"
+             (for-syntax '#%kernel
+                         "stx.rkt"
+                         "small-scheme.rkt"
+                         "stxcase-scheme.rkt"
+                         "name.rkt"
+                         "norm-define.rkt"
+                         "qqstx.rkt"
+                         "sort.rkt"))
+  
+  (#%provide syntax-procedure-alias-property (protect alias-of))
+  (define alias-of (gensym 'alias-of))
+  (define (syntax-procedure-alias-property stx)
+    (unless (syntax? stx)
+      (raise-argument-error 'syntax-procedure-alias "syntax?" stx))
+    (syntax-property stx alias-of)))

collects/scribblings/reference/define-struct.scrbl

@@ -66,6 +66,9 @@ to @math{4+2n} names:
        inaccessible identifier that is bound to the constructor
        procedure; the expanded identifier has a
        @racket['constructor-for] property whose value is an identifier
+       that is @racket[free-identifier=?] to @racket[id] as well as 
+       a syntax property accessible via 
+       @racket[syntax-procedure-alias-property] with an identifier
        that is @racket[free-identifier=?] to @racket[id].}
 
  @item{@racket[id]@racketidfont{?}, a @deftech{predicate} procedure