Correctly report syntax def from define-struct:

Add alias in type env when rename transformer is used.

svn: r14034

original commit: 79ee9fbee8868a4f5911356d2c1d2a9b0d7fd016

collects/typed-scheme/env/type-name-env.ss

@@ -3,12 +3,15 @@
 
 (require syntax/boundmap
          mzlib/trace
+         (env type-alias-env)
          (utils tc-utils)
+         (rep type-rep)
          (private type-utils))
 
 (provide register-type-name
          lookup-type-name
          register-type-names
+         add-alias
          type-name-env-map)
 
 ;; a mapping from id -> type (where id is the name of the type)
@@ -42,3 +45,7 @@
 ;; (id type -> T) -> listof[T]
 (define (type-name-env-map f)
   (module-identifier-mapping-map the-mapping f))
+
+(define (add-alias from to)  
+  (when (lookup-type-name to (lambda () #f))
+    (register-resolved-type-alias from (make-Name to))))

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

@@ -3,6 +3,7 @@
 (require (except-in "../utils/utils.ss" extend))
 (require (only-in srfi/1/list s:member)
          syntax/kerncase syntax/boundmap
+         (env type-name-env type-alias-env)
          mzlib/trace
          (private type-contract)
          (rep type-rep)
@@ -73,7 +74,9 @@
                #`(begin                    
                    (define-syntax export-id
                      (if (unbox typed-context?)
-                         (make-rename-transformer #'id)
+                         (begin
+                           (add-alias #'export-id #'id)
+                           (make-rename-transformer #'id))
                          (lambda (stx)
                            (tc-error/stx stx "Macro ~a from typed module used in untyped code" (syntax-e #'out-id)))))
                    (provide (rename-out [export-id out-id]))))))]

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

@@ -132,11 +132,13 @@
          (map (lambda (g t) (cons g (wrapper (->* (list name t) -Void)))) setters external-fld-types/no-parent)
          null)))
   (register-type-name nm (wrapper sty))
-  (for/list ([e bindings])
-    (let ([nm (car e)]
-          [t (cdr e)])
-      (register-type nm t)
-      (make-def-binding nm t))))
+  (cons
+   (make-def-stx-binding nm)
+   (for/list ([e bindings])
+             (let ([nm (car e)]
+                   [t (cdr e)])
+               (register-type nm t)
+               (make-def-binding nm t)))))
 
 ;; check and register types for a polymorphic define struct
 ;; tc/poly-struct : Listof[identifier] (U identifier (list identifier identifier)) Listof[identifier] Listof[syntax] -> void