WIP

Author: capfredf

typed-racket-lib/typed-racket/env/type-alias-helper.rkt

@@ -85,9 +85,6 @@
 (define (make-placeholder-type id)
   (make-Opaque id))
 
-(define (free-id-table-union! a b)
-  (for ([(id v) (in-free-id-table b)])
-    (free-id-table-set! a id v)))
 ;; register-all-type-aliases : Listof<Id> Dict<Id, TypeAliasInfo> -> Void
 ;;
 ;; Given parsed type aliases and a type alias map, do the work
@@ -106,6 +103,14 @@
   ;; #:implements clauses and to determine the order in which
   ;; recursive type aliases should be initialized.
 
+  (define (free-id-table-union! a b)
+    (define struct-names (list->set (free-id-table-keys b)))
+    (for ([(id deps) (in-free-id-table b)])
+      (free-id-table-set! a id (filter (lambda (v)
+                                         (or (free-id-table-ref type-alias-map v #f)
+                                             (set-member? struct-names v)))
+                                       deps))))
+
   (define-values (type-alias-dependency-map type-alias-class-map type-alias-productivity-map)
     (for/lists (_1 _2 _3 #:result (values (let ([tbl1 (make-free-id-table _1)])
                                             (free-id-table-union! tbl1 dependency-map)

typed-racket-lib/typed-racket/private/parse-type.rkt

@@ -1304,7 +1304,8 @@
                    (add-disappeared-use (syntax-local-introduce #'id)))
               t)]
            [else
-            (parse-error #:delayed? #t (~a "type name `" v "' is unbound"))
+            (unless (side-effect-mode? mode)
+              (parse-error #:delayed? #t (~a "type name `" v "' is unbound")))
             Err])]
         [(:Opaque^ . rest)
          (parse-error "bad syntax in Opaque")]

typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt

@@ -432,23 +432,18 @@
 ;; Listof[Expr] -> Promise[Listof[binding]]
 (define (register-struct-type-info! form-li)
   ;; register type name and alias first
-  (define (names-referred-in-struct stx)
+  (define (names-referred-in-struct name stx)
     (define-values (tvars field-types)
       (syntax-parse stx
         [t:typed-struct (values (attribute t.tvars)
                                 (attribute t.types))]))
     (cond
       [(null? tvars) null]
       [else
-       (let recur ([types field-types])
-         (match types
-           [(list-rest h t)
-            (syntax-parse h
-              [(rator rand ...)
-               (cons #'rator
-                     (recur (syntax->list #'(rand ...))))]
-              [_:id
-               null])]))]))
+       (append-map (lambda (t)
+                     (define-values (r _ __) (parse-for-effects name (cons tvars t)))
+                     r)
+                   field-types)]))
 
   (define-values (poly-names binding-reg dependency-map)
     (for/fold ([poly-names '()]
@@ -459,7 +454,7 @@
                                 dependency-map))
               ([form (in-list form-li)])
       (define name (name-of-struct form))
-      (define other-names (names-referred-in-struct form))
+      (define other-names (names-referred-in-struct name form))
       (define tvars (type-vars-of-struct form))
       (register-resolved-type-alias name (make-Name name (length tvars) #t))
       (register-type-name name)