Revert accidentally-pushed changes with HISTORY update.

Revert "Merge pull request #1263 from capfredf/fix-contract"

This reverts commit dbe5a6b, reversing
changes made to 460916a.

Author: samth

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

@@ -57,11 +57,10 @@
     (map vertex-data component)))
 
 
-;; register-all-type-aliases : Listof<Syntax> IDTable<ID, Listof<ID>> -> Void
+;; register-all-type-aliases : Listof<Syntax> -> Void
 ;;
 ;; register all type alias definitions carried by the input syntaxes
-;; dependency-map accounts for the dependencies of struct declarations
-(define (register-all-type-aliases type-aliases [dependency-map (make-immutable-free-id-table)])
+(define (register-all-type-aliases type-aliases)
   (parameterize ([incomplete-name-alias-map (make-free-id-table)])
     (define-values (type-alias-names type-alias-map)
       (for/lists (_1 _2 #:result (values _1 (make-free-id-table
@@ -75,7 +74,7 @@
         (values id (list id type-stx args))))
 
     (begin0
-      (register-all-type-alias-info type-alias-names type-alias-map dependency-map)
+      (register-all-type-alias-info type-alias-names type-alias-map)
       (unless (zero? (free-id-table-count (incomplete-name-alias-map)))
         (define names (free-id-table-keys (incomplete-name-alias-map)))
         (int-err "not all type alias names are fully registered: ~n ~a"
@@ -92,7 +91,7 @@
 ;; of actually registering the type aliases. If struct names or
 ;; other definitions need to be registered, do that before calling
 ;; this function.
-(define (register-all-type-alias-info type-alias-names type-alias-map dependency-map)
+(define (register-all-type-alias-info type-alias-names type-alias-map)
   ;; Find type alias dependencies
   ;; The two maps defined here contains the dependency structure
   ;; of type aliases in two senses:
@@ -103,19 +102,8 @@
   ;; The second is necessary in order to prevent recursive
   ;; #: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)
-                                            tbl1)
+    (for/lists (_1 _2 _3 #:result (values (make-free-id-table _1)
                                           (make-free-id-table _2)
                                           (make-free-id-table _3)))
                ([(name alias-info) (in-free-id-table type-alias-map)])
@@ -179,7 +167,6 @@
                               recursive-aliases
                               free-identifier=?))
       (car component)))
-
   (define other-recursive-aliases
     (for/list ([alias (in-list recursive-aliases)]
                #:unless (member alias
@@ -217,9 +204,8 @@
   ;; reverse order of that to avoid unbound type aliases.
   (define acyclic-constr-names
     (for/fold ([acc '()])
-              ([id (in-list acyclic-singletons)]
-               #:when (free-id-table-ref type-alias-map id #f))
-      (match-define (list _ type-stx args) (free-id-table-ref type-alias-map id #f))
+              ([id (in-list acyclic-singletons)])
+      (match-define (list _ type-stx args) (free-id-table-ref type-alias-map id))
       (define acc^
         (cond
           [(not (null? args))
@@ -265,8 +251,7 @@
                #:result
                (values (reverse type-records)
                        (reverse type-op-records)))
-              ([id (in-list (append other-recursive-aliases class-aliases))]
-               #:when (free-id-table-ref type-alias-map id #f))
+              ([id (in-list (append other-recursive-aliases class-aliases))])
       (define record (free-id-table-ref type-alias-map id))
       (match-define (list _ type-stx args) record)
       (if (null? args)
@@ -307,8 +292,7 @@
                                                          (define res (in-same-component? id x))
                                                          res)
                                                        type-alias-productivity-map
-                                                       #:delay-variances? #t
-                                                       #:recursive? #t))
+                                                       #:delay-variances? #t))
         (register-type-constructor! id ty-op)
         (complete-type-alias-registration! id)
         (reset-resolver-cache!)

typed-racket-lib/typed-racket/env/type-constr-env.rkt

@@ -2,12 +2,10 @@
 (require "../rep/type-constr.rkt"
          syntax/id-table
          "../env/env-utils.rkt"
-         "../private/user-defined-type-constr.rkt"
          "../typecheck/renamer.rkt")
 
 (provide register-type-constructor!
          lookup-type-constructor
-         simple-type-constructor?
          kind-env-map)
 
 (define kind-env (make-free-id-table))
@@ -23,14 +21,3 @@
 
 (define (register-type-constructor! name type-constr)
   (free-id-table-set! kind-env name type-constr))
-
-
-;; returns true if id refers to a built-in or non-recursive type constructor
-(define (simple-type-constructor? id)
-  (cond
-    [(lookup-type-constructor id)
-     =>
-     (lambda (constr)
-       (not (and (user-defined-type-constr? constr)
-                 (recursive-type-constr? constr))))]
-    [else #f]))

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

@@ -66,8 +66,7 @@
  [parse-type-operator-abstraction (c:->* (identifier? (c:listof identifier?) syntax?)
                                          ((c:or/c (c:-> identifier? boolean?) #f)
                                           (free-id-table/c identifier? boolean?)
-                                          #:delay-variances? boolean?
-                                          #:recursive? boolean?)
+                                          #:delay-variances? boolean?)
                                          TypeConstructor?)]
  [parse-for-effects (c:-> identifier? (c:cons/c (c:listof identifier?) syntax?)
                           (values (c:listof identifier?)
@@ -652,8 +651,7 @@
 (define (parse-type-operator-abstraction name arg-names stx [opt-in-same-component? #f]
                                          [type-op-productivity-map (make-immutable-free-id-table)]
                                          #:delay-variances?
-                                         [delay-variances? #f]
-                                         #:recursive? [recursive? #f])
+                                         [delay-variances? #f])
   (define syms (map syntax-e arg-names))
   (define mode (synth-mode name syms opt-in-same-component?))
   (define var-kind-level-env
@@ -672,10 +670,7 @@
                                    var-kind-level-env
                                    #:mode mode)))
 
-  (make-type-constr (user-defined-type-op syms res (if (equal? (symbol->string (syntax-e name))
-                                                               "Formula")
-                                                       #t
-                                                       recursive?))
+  (make-type-constr (user-defined-type-op syms res)
                     (length syms)
                     (free-id-table-ref type-op-productivity-map name #f)
                     #:variances
@@ -1304,8 +1299,7 @@
                    (add-disappeared-use (syntax-local-introduce #'id)))
               t)]
            [else
-            (unless (side-effect-mode? mode)
-              (parse-error #:delayed? #t (~a "type name `" v "' is unbound")))
+            (parse-error #:delayed? #t (~a "type name `" v "' is unbound"))
             Err])]
         [(:Opaque^ . rest)
          (parse-error "bad syntax in Opaque")]

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

@@ -17,7 +17,6 @@
  "../env/type-name-env.rkt"
  "../env/row-constraint-env.rkt"
  "../env/lexical-env.rkt"
- "../env/type-constr-env.rkt"
 
  "../rep/core-rep.rkt"
  "../rep/rep-utils.rkt"
@@ -413,23 +412,17 @@
         ;; Key with (cons name 'app) instead of just name because the
         ;; application of the Name is not necessarily the same as the
         ;; Name type alone
-        (cond
-          ;; when constr is a built-in or non-recursive user-defined type
-          ;; constructor, don't generate a recursive static contract
-          ;; for the resulting type.
-          [(simple-type-constructor? name)
-           (t->sc (resolve-once type))]
-          [(hash-ref recursive-values (cons name 'app) #f)]
-          [else
-           (define name* (generate-temporary name))
-           (recursive-sc (list name*)
-                         (list
-                          (t->sc (resolve-once type)
-                                 #:recursive-values
-                                 (hash-set recursive-values
-                                           (cons name 'app)
-                                           (recursive-sc-use name*))))
-                         (recursive-sc-use name*))])]
+        (cond [(hash-ref recursive-values (cons name 'app) #f)]
+              [else
+               (define name* (generate-temporary name))
+               (recursive-sc (list name*)
+                             (list
+                              (t->sc (resolve-once type)
+                                     #:recursive-values
+                                     (hash-set recursive-values
+                                               (cons name 'app)
+                                               (recursive-sc-use name*))))
+                             (recursive-sc-use name*))])]
        ;; Implicit recursive aliases
        [(Name: name-id args #f)
         (cond [;; recursive references are looked up in a special table

typed-racket-lib/typed-racket/private/user-defined-type-constr.rkt

@@ -7,30 +7,22 @@
                (subst-all make-simple-substitution)])
 
 (provide (struct-out user-defined-type-op)
-         user-defined-type-constr?
-         recursive-type-constr?)
+         user-defined-type-constr?)
 
-(struct user-defined-type-op (vars type recursive?) #:transparent
+(struct user-defined-type-op (vars type) #:transparent
   #:methods gen:type-rep-maker
   [(define (gen-create-type-rep me args)
-     (match-define (user-defined-type-op vars type recursive?) me)
+     (match-define (user-defined-type-op vars type) me)
      (subst-all (make-simple-substitution vars args)
                 type))
    (define (gen-serialize-type-rep me t->s)
-     (match-define (user-defined-type-op vars type recursive?) me)
+     (match-define (user-defined-type-op vars type) me)
      `(user-defined-type-op (list ,@(for/list ([i (in-list vars)])
                                       `(quote ,i)))
-                            ,(t->s type)
-                            ,recursive?))])
+                            ,(t->s type)))])
 
 (define (user-defined-type-constr? constr-rep)
   (match constr-rep
     [(struct* TypeConstructor ([real-trep-constr (? user-defined-type-op?)]))
      #t]
     [_ #f]))
-
-(define (recursive-type-constr? constr)
-  (match constr
-    [(struct* TypeConstructor
-              ([real-trep-constr (struct* user-defined-type-op ([recursive? recursive?]))]))
-     recursive?]))

typed-racket-lib/typed-racket/rep/free-variance.rkt

@@ -210,7 +210,7 @@
         (match-define (struct* TypeConstructor ([real-trep-constr maker]
                                                 [variances old-variances]))
           constr)
-        (match-define (struct user-defined-type-op [tvars type _]) maker)
+        (match-define (struct user-defined-type-op [tvars type]) maker)
         (cond
           [(or (not tvars) (null? tvars)) #t]
           [else

typed-racket-lib/typed-racket/rep/type-rep.rkt

@@ -185,12 +185,13 @@
              #:with fld-frees #'(make-invariant (frees name))))
   (syntax-parse stx
     [(_ name:var-name ((~var flds (structural-flds #'frees)) ...) . rst)
-     (with-syntax ([constructor-name (format-id #'name "make-~a-rep" (syntax-e #'name))]
+     (with-syntax ([contructor-name (format-id #'name "make-~a-rep" (syntax-e #'name))]
                    [type-constructor-name (format-id #'name "make-~a" (syntax-e #'name))])
        (define arity (length (syntax->list #'(flds ...))))
        (quasisyntax/loc stx
          (begin
            (def-rep (name #:constructor-name constructor-name) ([flds.name Type?] ...)
+             #:no-provide (constructor-name)
              [#:parent Type]
              [#:frees (frees) . #,(if (= 1 (length (syntax->list #'(flds.name ...))))
                                       #'(flds.fld-frees ...)

typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt

@@ -10,7 +10,6 @@
          "../find-annotation.rkt"
          "../tc-metafunctions.rkt"
          "../../types/abbrev.rkt"
-         "../../types/resolve.rkt"
          "../../types/utils.rkt"
          "../../types/generalize.rkt"
          "../../types/type-table.rkt"
@@ -109,8 +108,8 @@
                        (generalize (tc-expr/t ac)))))]
            [acc-ty (or
                     (type-annotation #'val #:infer #t)
-                    (match (resolve expected)
-                      [(tc-result1: (app resolve (and t (Listof: _)))) t]
+                    (match expected
+                      [(tc-result1: (and t (Listof: _))) t]
                       [_ #f])
                     (generalize -Null))])
        ;; this check is needed because the type annotation may come

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

@@ -44,9 +44,7 @@
 (provide tc/struct
          tc/struct-prop-values
          tc/make-struct-type-property
-         name-of-struct
-         names-referred-in-struct
-         d-s
+         name-of-struct d-s
          register-parsed-struct-sty!
          register-parsed-struct-bindings!)
 
@@ -92,21 +90,6 @@
   (syntax-parse stx
     [t:typed-struct #'t.type-name]))
 
-(define (names-referred-in-struct stx)
-  (define-values (tvars field-types)
-    (syntax-parse stx
-      [t:typed-struct (values (attribute t.tvars)
-                              (attribute t.types))]))
-  (define name (name-of-struct stx))
-
-  (cond
-    [(null? tvars) null]
-    [else
-     (append-map (lambda (t)
-                   (define-values (r _ __) (parse-for-effects name (cons tvars t)))
-                   r)
-                 field-types)]))
-
 ;; a simple wrapper to get proc from a polymorphic or monomorhpic structure
 (define/cond-contract (get-struct-proc sty)
   (c:-> (c:or/c Struct? Poly?) (c:or/c #f Fun?))
@@ -250,7 +233,7 @@
                       (make-Poly (struct-desc-tvars desc) sty))
   (unless (empty? (struct-desc-tvars desc))
     (define variances (map (lambda _ variance:const) (struct-desc-tvars desc)))
-    (define ty-op (make-type-constr (user-defined-type-op (struct-desc-tvars desc) sty #f)
+    (define ty-op (make-type-constr (user-defined-type-op (struct-desc-tvars desc) sty)
                                     (length (struct-desc-tvars desc))
                                     #:variances
                                     variances))

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

@@ -428,23 +428,17 @@
               (~datum expand)))))
 
 ;; finish registering struct definitions in two steps with the second one being
-;; the return thunk, which can be invoked on demand. The function also returns a
-;; dependency mappping from struct type names to the type names used in their
-;; definitions.
-
-;; Listof[Expr] -> Values[Promise[Listof[binding]], FreeIDTable[Identifer, Identifer]]
+;; the return thunk, which can be invoked on demand.
+;; Listof[Expr] -> Promise[Listof[binding]]
 (define (register-struct-type-info! form-li)
   ;; register type name and alias first
-  (define-values (poly-names binding-reg dependency-map)
+  (define-values (poly-names binding-reg)
     (for/fold ([poly-names '()]
                [binding-reg '()]
-               [dependency-map (make-immutable-free-id-table)]
                #:result (values (reverse poly-names)
-                                (reverse binding-reg)
-                                dependency-map))
+                                (reverse binding-reg)))
               ([form (in-list form-li)])
       (define name (name-of-struct form))
-      (define other-names (names-referred-in-struct form))
       (define tvars (type-vars-of-struct form))
       (register-resolved-type-alias name (make-Name name (length tvars) #t))
       (register-type-name name)
@@ -454,14 +448,11 @@
                                name))
                     poly-names)
               (cons (delay (register-parsed-struct-bindings! (force parsed)))
-                    binding-reg)
-              (free-id-table-set dependency-map name other-names))))
-  (values
-   (delay (lambda (names)
-            (refine-user-defined-constructor-variances!
-             (append names (filter-map force poly-names)))
-            (map force binding-reg)))
-   dependency-map))
+                    binding-reg))))
+  (delay (lambda (names)
+           (refine-user-defined-constructor-variances!
+            (append names (filter-map force poly-names)))
+           (map force binding-reg))))
 
 
   ;; the resulting thunk finishes the rest work)
@@ -490,11 +481,11 @@
     (parse-and-register-signature! sig-form))
 
   ;; Add the struct names to the type table, but not with a type
-  (define-values (promise-reg-sty-info dependency-map) (register-struct-type-info! struct-defs))
+  (define promise-reg-sty-info (register-struct-type-info! struct-defs))
 
   (do-time "after adding type names")
 
-  (define names (register-all-type-aliases type-aliases dependency-map))
+  (define names (register-all-type-aliases type-aliases))
 
   (finalize-signatures!)
 
@@ -727,8 +718,7 @@
                                       'no-type)]
     [else
      (when (typed-struct? form)
-       (define-values (after-reg _) (register-struct-type-info! (list form)))
-       ((force after-reg) null))
+       ((force (register-struct-type-info! (list form))) null))
      (define all-forms (cond
                          [(typed-struct? form)
                           ;; after a struct type is registered, check the pending forms is in receiving order