Make TR provided struc-infos act like constructors. Closes PR11578.

Closes PR11866.

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

@@ -0,0 +1,12 @@
+#lang racket/load
+
+(module a typed/racket/base
+  (provide foo)
+    (struct: foo ()))
+
+(module b racket/base
+  (require 'a)
+    (foo))
+
+
+(require 'b)

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

@@ -0,0 +1,10 @@
+#lang racket/load
+(module a typed/racket
+  (struct: S ((x : Integer)) #:transparent)
+    (provide (all-defined-out)))
+
+(module b typed/racket/no-check
+  (require 'a)
+    (S 5))
+
+(require 'b)

collects/typed-scheme/typecheck/provide-handling.rkt

@@ -51,6 +51,7 @@
     (define (mk-untyped-syntax b defn-id internal-id)
       (match b
         [(def-struct-stx-binding _ (? struct-info? si))
+         (define type-is-constructor? #t) ;Conservative estimate (provide/contract does the same)
          (match-let ([(list type-desc constr pred (list accs ...) muts super) (extract-struct-info si)])
            (let-values ([(defns new-ids) (map/values 2 (lambda (e) (if (identifier? e)
                                                                        (mk e)
@@ -63,7 +64,10 @@
                #`(begin
                    #,@defns
                    (define-syntax #,defn-id
-                     (list type-desc* constr* pred* (list accs* ...) (list #,@(map (lambda x #'#f) accs)) super*))))))]
+                     (let ((info (list type-desc* constr* pred* (list accs* ...) (list #,@(map (lambda x #'#f) accs)) super*)))
+                      #,(if type-is-constructor?
+                            #'(make-struct-info-self-ctor constr* info)
+                            #'info)))))))]
         [_
          #`(define-syntax #,defn-id
              (lambda (stx)

collects/typed-scheme/utils/utils.rkt

@@ -8,7 +8,7 @@ at least theoretically.
 (require (for-syntax racket/base syntax/parse racket/string)
          racket/contract racket/require-syntax
 	 racket/provide-syntax racket/unit (prefix-in d: unstable/debug)
-	 racket/pretty mzlib/pconvert syntax/parse)
+	 racket/struct-info racket/pretty mzlib/pconvert syntax/parse)
 
 ;; to move to unstable
 (provide reverse-begin list-update list-set debugf debugging? dprintf)
@@ -237,3 +237,30 @@ at least theoretically.
 (define debugging? (make-parameter #f))
 (define-syntax-rule (debugf f . args) (if (debugging?) (d:debugf f . args) (f . args)))
 (define (dprintf . args) (when (debugging?) (apply d:dprintf args)))
+
+
+(provide make-struct-info-self-ctor)
+;Copied from racket/private/define-struct
+;FIXME when multiple bindings are supported
+(define (self-ctor-transformer orig stx)
+  (define (transfer-srcloc orig stx)
+    (datum->syntax orig (syntax-e orig) stx orig))
+  (syntax-case stx ()
+    [(self arg ...) (datum->syntax stx
+                                   (cons (syntax-property (transfer-srcloc orig #'self)
+                                                          'constructor-for
+                                                          (syntax-local-introduce #'self))
+                                         (syntax-e (syntax (arg ...))))
+                                   stx
+                                   stx)]
+    [_ (transfer-srcloc orig stx)]))
+
+
+(define make-struct-info-self-ctor
+ (let ()
+  (struct struct-info-self-ctor (id info)
+          #:property prop:procedure
+                     (lambda (ins stx)
+                      (self-ctor-transformer (struct-info-self-ctor-id ins) stx))
+          #:property prop:struct-info (lambda (x) (extract-struct-info (struct-info-self-ctor-info x))))
+  struct-info-self-ctor))