diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
index 19b9b710..ecc87bc7 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
@@ -64,61 +64,75 @@
        (if reason (~a ": " reason) "."))
    to-check))
 
-(define (generate-contract-def stx)
+;; The cache/sc-cache are used to share contract and static contract
+;; definitions respectively across multiple calls to type->contract.
+;; This saves computation time and zo space for excessively large types
+;; (such as mutually recursive class types).
+(define (generate-contract-def stx cache sc-cache)
   (define prop (get-contract-def-property stx))
   (match-define (contract-def type-stx flat? maker? typed-side) prop)
-  (define typ (parse-type type-stx))
+  (define *typ (parse-type type-stx))
   (define kind (if flat? 'flat 'impersonator))
   (syntax-parse stx #:literals (define-values)
     [(define-values (n) _)
-     (let ([typ (if maker?
-                    ((map fld-t (Struct-flds (lookup-type-name (Name-id typ)))) #f . t:->* . typ)
-                    typ)])
-         (with-syntax ([cnt (type->contract
-                             typ
-                             ;; this value is from the typed side (require/typed, make-predicate, etc)
-                             ;; unless it's used for with-type
-                             #:typed-side (from-typed? typed-side)
-                             #:kind kind
-                             (type->contract-fail
-                              typ type-stx
-                              #:ctc-str (if flat? "predicate" "contract")))])
-           (ignore ; should be ignored by the optimizer
-            (quasisyntax/loc stx (define-values (n) cnt)))))]
+     (define typ
+       (if maker?
+           ((map fld-t (Struct-flds (lookup-type-name (Name-id *typ)))) #f . t:->* . *typ)
+           *typ))
+     (match-define (list defs ctc)
+       (type->contract
+        typ
+        ;; this value is from the typed side (require/typed, make-predicate, etc)
+        ;; unless it's used for with-type
+        #:typed-side (from-typed? typed-side)
+        #:kind kind
+        #:cache cache
+        #:sc-cache sc-cache
+        (type->contract-fail
+         typ type-stx
+         #:ctc-str (if flat? "predicate" "contract"))))
+     (ignore ; should be ignored by the optimizer
+      (quasisyntax/loc stx
+        (begin #,@defs (define-values (n) #,ctc))))]
     [_ (int-err "should never happen - not a define-values: ~a"
                 (syntax->datum stx))]))
 
 ;; Generate a contract for a TR provide form
-(define (generate-contract-def/provide stx)
+(define (generate-contract-def/provide stx cache sc-cache)
   (match-define (list type untyped-id orig-id blame-id)
                 (contract-def/provide-property stx))
   (define failure-reason #f)
-  (define ctc
+  (define result
     (type->contract type
                     #:typed-side #t
                     #:kind 'impersonator
+                    #:cache cache
+                    #:sc-cache sc-cache
                     ;; FIXME: get rid of this interface, make it functional
                     (λ (#:reason [reason #f]) (set! failure-reason reason))))
   (syntax-parse stx
     #:literal-sets (kernel-literals)
     [(define-values ctc-id _)
      ;; no need for ignore, the optimizer doesn't run on this code
-     (if failure-reason
-         #`(define-syntax (#,untyped-id stx)
-             (tc-error/fields #:stx stx
-                              "could not convert type to a contract"
-                              #:more #,failure-reason
-                              "identifier" #,(symbol->string (syntax-e orig-id))
-                              "type" #,(pretty-format-type type #:indent 8)))
-         #`(begin (define ctc-id #,ctc)
-                  (define-module-boundary-contract #,untyped-id
-                    #,orig-id ctc-id
-                    #:pos-source #,blame-id
-                    #:srcloc (vector (quote #,(syntax-source orig-id))
-                                     #,(syntax-line orig-id)
-                                     #,(syntax-column orig-id)
-                                     #,(syntax-position orig-id)
-                                     #,(syntax-span orig-id)))))]))
+     (cond [failure-reason
+            #`(define-syntax (#,untyped-id stx)
+                (tc-error/fields #:stx stx
+                                 "could not convert type to a contract"
+                                 #:more #,failure-reason
+                                 "identifier" #,(symbol->string (syntax-e orig-id))
+                                 "type" #,(pretty-format-type type #:indent 8)))]
+           [else
+            (match-define (list defs ctc) result)
+            #`(begin #,@defs
+                     (define ctc-id #,ctc)
+                     (define-module-boundary-contract #,untyped-id
+                       #,orig-id ctc-id
+                       #:pos-source #,blame-id
+                       #:srcloc (vector (quote #,(syntax-source orig-id))
+                                        #,(syntax-line orig-id)
+                                        #,(syntax-column orig-id)
+                                        #,(syntax-position orig-id)
+                                        #,(syntax-span orig-id))))])]))
 
 (define extra-requires
   #'(require
@@ -135,18 +149,24 @@
 (define include-extra-requires? (box #f))
 
 (define (change-contract-fixups forms)
-  (for/list ((e (in-list forms)))
-    (if (not (get-contract-def-property e))
-        e
-        (begin (set-box! include-extra-requires? #t)
-               (generate-contract-def e)))))
+  (define ctc-cache (make-hash))
+  (define sc-cache (make-hash))
+  (with-new-name-tables
+   (for/list ((e (in-list forms)))
+     (if (not (get-contract-def-property e))
+         e
+         (begin (set-box! include-extra-requires? #t)
+                (generate-contract-def e ctc-cache sc-cache))))))
 
 (define (change-provide-fixups forms)
-  (for/list ([form (in-list forms)])
-    (cond [(contract-def/provide-property form)
-           (set-box! include-extra-requires? #t)
-           (generate-contract-def/provide form)]
-          [else form])))
+  (define ctc-cache (make-hash))
+  (define sc-cache (make-hash))
+  (with-new-name-tables
+   (for/list ([form (in-list forms)])
+     (cond [(contract-def/provide-property form)
+            (set-box! include-extra-requires? #t)
+            (generate-contract-def/provide form ctc-cache sc-cache)]
+           [else form]))))
 
 ;; To avoid misspellings
 (define impersonator-sym 'impersonator)
@@ -195,17 +215,25 @@
    [(untyped) 'typed]
    [(both) 'both]))
 
-(define (type->contract ty init-fail #:typed-side [typed-side #t] #:kind [kind 'impersonator])
-  (with-new-name-tables
-   (let/ec escape
-     (define (fail #:reason [reason #f]) (escape (init-fail #:reason reason)))
-     (instantiate
-         (optimize
-          (type->static-contract ty #:typed-side typed-side fail)
-          #:trusted-positive typed-side
-          #:trusted-negative (not typed-side))
-         fail
-       kind))))
+;; type->contract : Type Procedure
+;;                  #:typed-side Boolean #:kind Symbol #:cache Hash
+;;                  -> (U Any (List (Listof Syntax) Syntax))
+(define (type->contract ty init-fail
+                        #:typed-side [typed-side #t]
+                        #:kind [kind 'impersonator]
+                        #:cache [cache (make-hash)]
+                        #:sc-cache [sc-cache (make-hash)])
+  (let/ec escape
+    (define (fail #:reason [reason #f]) (escape (init-fail #:reason reason)))
+    (instantiate
+     (optimize
+      (type->static-contract ty #:typed-side typed-side fail
+                             #:cache sc-cache)
+      #:trusted-positive typed-side
+      #:trusted-negative (not typed-side))
+     fail
+     kind
+     #:cache cache)))
 
 
 
@@ -224,8 +252,33 @@
 (define (same sc)
   (triple sc sc sc))
 
+;; Keep track of the bound names and don't cache types where those are free
+(define bound-names (make-parameter null))
 
-(define (type->static-contract type init-fail #:typed-side [typed-side #t])
+;; Macro to simplify (and avoid reindentation) of the match below
+;;
+;; The sc-cache hashtable is used to memoize static contracts. The keys are
+;; a pair of the Type-seq number for a type and 'untyped or 'typed
+(define-syntax (cached-match stx)
+  (syntax-case stx ()
+    [(_ sc-cache type-expr typed-side-expr match-clause ...)
+     #'(let ([type type-expr]
+             [typed-side typed-side-expr])
+         (define key (cons (Type-seq type) typed-side))
+         (cond [(hash-ref sc-cache key #f)]
+               [else
+                (define sc (match type match-clause ...))
+                (define fvs (fv type))
+                (unless (or (ormap (λ (n) (member n fvs)) (bound-names))
+                            ;; Don't cache types with applications of Name types because
+                            ;; it does the wrong thing for recursive references
+                            (has-name-app? type))
+                  (hash-set! sc-cache key sc))
+                sc]))]))
+
+(define (type->static-contract type init-fail
+                               #:typed-side [typed-side #t]
+                               #:cache [sc-cache (make-hash)])
   (let/ec return
     (define (fail #:reason reason) (return (init-fail #:reason reason)))
     (let loop ([type type] [typed-side (if typed-side 'typed 'untyped)] [recursive-values (hash)])
@@ -242,13 +295,13 @@
         (if (from-typed? typed-side)
             (fail #:reason "contract generation not supported for this type")
             sc))
-      (match type
+      (cached-match sc-cache type typed-side
         ;; Applications of implicit recursive type aliases
         ;;
         ;; We special case this rather than just resorting to standard
         ;; App resolution (see case below) because the resolution process
         ;; will make type->static-contract infinite loop.
-        [(App: (Name: name _ #f) rands _)
+        [(App: (Name: name _ #f) _ _)
          ;; 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
@@ -352,8 +405,9 @@
                  (define rv (for/fold ((rv recursive-values)) ((temp temporaries)
                                                                (v-nm vs-nm))
                               (hash-set rv v-nm (same (parametric-var/sc temp)))))
-                 (parametric->/sc temporaries
-                    (t->sc b #:recursive-values rv)))))]
+                 (parameterize ([bound-names (append (bound-names) vs-nm)])
+                   (parametric->/sc temporaries
+                     (t->sc b #:recursive-values rv))))))]
         [(PolyDots: (list vs ... dotted-v) b)
          (if (not (from-untyped? typed-side))
              ;; in positive position, no checking needed for the variables
@@ -373,13 +427,17 @@
          (case typed-side
            [(both) (recursive-sc
                      (list both-n*)
-                     (list (loop b 'both rv))
+                     (parameterize ([bound-names (cons n (bound-names))])
+                       (list (loop b 'both rv)))
                      (recursive-sc-use both-n*))]
            [(typed untyped)
+            (define (rec b side rv)
+              (parameterize ([bound-names (cons n (bound-names))])
+                (loop b side rv)))
             ;; TODO not fail in cases that don't get used
-            (define untyped (loop b 'untyped rv))
-            (define typed (loop b 'typed rv))
-            (define both (loop b 'both rv))
+            (define untyped (rec b 'untyped rv))
+            (define typed (rec b 'typed rv))
+            (define both (rec b 'both rv))
   
             (recursive-sc
                      n*s
@@ -541,6 +599,20 @@
            ((f #f) (first arrs))
            (case->/sc (map (f #t) arrs)))])]))
 
+;; Predicate that checks for an App type with a recursive
+;; Name type in application position
+(define (has-name-app? type)
+  (let/ec escape
+    (let loop ([type type])
+      (type-case
+       (#:Type loop #:Filter (sub-f loop) #:Object (sub-o loop))
+       type
+       [#:App arg _ _
+        (match arg
+          [(Name: _ _ #f) (escape #t)]
+          [_ type])]))
+    #f))
+
 (module predicates racket/base
   (require racket/extflonum)
   (provide nonnegative? nonpositive?
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/any.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/any.rkt
index ee873022..83943321 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/any.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/any.rkt
@@ -23,6 +23,7 @@
       (display "#<any/sc>" port)))
 
 (struct any-combinator combinator ()
+        #:transparent
         #:methods gen:sc
           [(define (sc-map v f) v)
            (define (sc-traverse v f) (void))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/case-lambda.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/case-lambda.rkt
index 3ef102c8..3c262ea1 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/case-lambda.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/case-lambda.rkt
@@ -18,7 +18,8 @@
                 (maybe/c (listof static-contract?))
                 static-contract?)])
   case->/sc:
-  arr/sc:)
+  arr/sc:
+  (rename-out [arr-combinator? arr/sc?]))
 
 
 (define (case->/sc arrs)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt
index 2c79bc0b..44981dba 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/name.rkt
@@ -13,10 +13,16 @@
          "../constraints.rkt"
          racket/contract
          racket/dict
+         racket/match
          racket/syntax
-         syntax/id-table)
+         syntax/id-table
+         (for-syntax racket/base
+                     syntax/parse))
 
 (provide with-new-name-tables
+         name/sc:
+         lookup-name-defined
+         set-name-defined
          (contract-out
           [get-all-name-defs
            (-> (listof (list/c (listof identifier?)
@@ -33,9 +39,22 @@
 (define name-sc-table (make-parameter (make-free-id-table)))
 (define name-defs-table (make-parameter (make-free-id-table)))
 
+;; Use this table to track whether a contract has already been
+;; generated for this name type yet. Stores booleans.
+(define name-defined-table (make-parameter (make-free-id-table)))
+
+;; Lookup whether a contract has been defined for this name
+(define (lookup-name-defined name)
+  (free-id-table-ref (name-defined-table) name #f))
+
+;; Use when a contract has been defined for this name
+(define (set-name-defined name)
+  (free-id-table-set! (name-defined-table) name #t))
+
 (define-syntax-rule (with-new-name-tables e)
   (parameterize ([name-sc-table (make-free-id-table)]
-                 [name-defs-table (make-free-id-table)])
+                 [name-defs-table (make-free-id-table)]
+                 [name-defined-table (make-free-id-table)])
     e))
 
 (define (get-all-name-defs)
@@ -81,3 +100,7 @@
      (name-combinator-gen-name v))
    (define (sc->constraints v f)
      (variable-contract-restrict (name-combinator-gen-name v)))])
+
+(define-match-expander name/sc:
+  (syntax-parser
+    [(_ var) #'(name-combinator _ var)]))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/none.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/none.rkt
index 74e64fe1..111f4244 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/none.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/none.rkt
@@ -23,6 +23,7 @@
       (display "#<none/sc>" port)))
 
 (struct none-combinator combinator ()
+        #:transparent
         #:methods gen:sc
           [(define (sc-map v f) v)
            (define (sc-traverse v f) (void))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt
index c9e2e7d5..e3ece08a 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt
@@ -18,7 +18,8 @@
     [parametric-var/sc (identifier? . -> . static-contract?)])
   parametric->/sc:
   (rename-out
-    [parametric-var/sc parametric-var/sc:]))
+    [parametric-var/sc parametric-var/sc:]
+    [parametric-combinator? parametric->/sc?]))
 
 
 (struct parametric-combinator combinator (vars)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt
index ff9256b4..922cc42d 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt
@@ -34,6 +34,7 @@
 
 
 (struct simple-contract static-contract (syntax kind name)
+        #:transparent
         #:methods gen:sc
          [(define (sc-map v f) v)
           (define (sc-traverse v f) (void))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/instantiate.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/instantiate.rkt
index d35a5277..674e14b0 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/instantiate.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/instantiate.rkt
@@ -8,8 +8,12 @@
   racket/dict
   racket/sequence
   racket/contract
+  racket/syntax
   (for-template racket/base racket/contract)
+  "combinators.rkt"
   "combinators/name.rkt"
+  "combinators/case-lambda.rkt"
+  "combinators/parametric.rkt"
   "kinds.rkt"
   "parametric-check.rkt"
   "structures.rkt"
@@ -20,7 +24,8 @@
   (contract-out
     [instantiate
       (parametric->/c (a) ((static-contract? (-> #:reason (or/c #f string?) a))
-                             (contract-kind?) . ->* . (or/c a syntax?)))]))
+                           (contract-kind? #:cache hash?)
+                           . ->* . (or/c a (list/c (listof syntax?) syntax?))))]))
 
 ;; Providing these so that tests can work directly with them.
 (module* internals #f
@@ -30,23 +35,34 @@
 
 ;; kind is the greatest kind of contract that is supported, if a greater kind would be produced the
 ;; fail procedure is called.
-(define (instantiate sc fail [kind 'impersonator])
+;;
+;; The cache is used to share contract definitions across multiple calls to
+;; type->contract in a given contract fixup pass. If it's #f then that means don't
+;; do any sharing (useful for testing).
+(define (instantiate sc fail [kind 'impersonator] #:cache [cache #f])
   (if (parametric-check sc)
       (fail #:reason "multiple parametric contracts are not supported")
       (with-handlers [(exn:fail:constraint-failure?
                         (lambda (exn) (fail #:reason (exn:fail:constraint-failure-reason exn))))]
         (instantiate/inner sc
           (compute-recursive-kinds
-            (contract-restrict-recursive-values (compute-constraints sc kind)))))))
+            (contract-restrict-recursive-values (compute-constraints sc kind)))
+          cache))))
 
 (define (compute-constraints sc max-kind)
+  (define memo-table (make-hash))
   (define name-defs (get-all-name-defs))
   (define (recur sc)
-    (match sc
-      [(recursive-sc names values body)
-       (close-loop names (map recur values) (recur body))]
-      [(? sc?)
-       (sc->constraints sc recur)]))
+    (cond [(hash-ref memo-table sc #f)]
+          [else
+           (define result
+             (match sc
+               [(recursive-sc names values body)
+                (close-loop names (map recur values) (recur body))]
+               [(? sc?)
+                (sc->constraints sc recur)]))
+           (hash-set! memo-table sc result)
+           result]))
   (define constraints
     (if (null? name-defs)
         (recur sc)
@@ -78,31 +94,85 @@
     (values name (hash-ref var-values var))))
 
 
-(define (instantiate/inner sc recursive-kinds)
+(define (instantiate/inner sc recursive-kinds cache)
+  (define bound-names (make-parameter null))
+  ;; sc-queue : records the order in which to return syntax objects
+  (define sc-queue null)
   (define (recur sc)
+    (cond [(and cache (hash-ref cache sc #f)) => car]
+          [(arr/sc? sc) (make-contract sc)]
+          [(parametric->/sc? sc)
+           (match-define (parametric->/sc: vars _) sc)
+           (parameterize ([bound-names (append vars (bound-names))])
+             (make-contract sc))]
+          ;; If any names are bound, the contract can't be shared
+          ;; becuase it depends on the scope it's in
+          [(ormap (λ (n) (name-free-in? n sc)) (bound-names))
+           (make-contract sc)]
+          [else
+           (define ctc (make-contract sc))
+           (cond [cache
+                  (define fresh-id (generate-temporary))
+                  (hash-set! cache sc (cons fresh-id ctc))
+                  (set! sc-queue (cons sc sc-queue))
+                  fresh-id]
+                 [else ctc])]))
+  (define (make-contract sc)
     (match sc
       [(recursive-sc names values body)
        (define raw-names (generate-temporaries names))
        (define raw-bindings
-          (for/list ([raw-name (in-list raw-names)]
-                     [value (in-list values)])
-            #`[#,raw-name #,(recur value)]))
+         (parameterize ([bound-names (append names (bound-names))])
+           (for/list ([raw-name (in-list raw-names)]
+                      [value (in-list values)])
+             #`[#,raw-name #,(recur value)])))
        (define bindings
          (for/list ([name (in-list names)]
                     [raw-name (in-list raw-names)])
             #`[#,name (recursive-contract #,raw-name
                                             #,(kind->keyword
                                                 (hash-ref recursive-kinds name)))]))
-       #`(letrec (#,@bindings #,@raw-bindings) #,(recur body))]
+       #`(letrec (#,@bindings #,@raw-bindings)
+           #,(parameterize ([bound-names (append names (bound-names))])
+               (recur body)))]
       [(? sc? sc)
        (sc->contract sc recur)]))
+  (define ctc (recur sc))
   (define name-defs (get-all-name-defs))
-  (cond [(null? name-defs) (recur sc)]
-        [else
-         (define bindings
-           (for/list ([name (in-list (apply append (dict-keys name-defs)))]
-                      [sc   (in-list (apply append (dict-values name-defs)))])
-             #`[#,name (recursive-contract #,(recur sc)
-                                           #,(kind->keyword
-                                              (hash-ref recursive-kinds name)))]))
-         #`(letrec (#,@bindings) #,(recur sc))]))
+  ;; These are extra contract definitions for the name static contracts
+  ;; that are used for this type. Since these are shared across multiple
+  ;; contracts from a single contract fixup pass, we use the name-defined
+  ;; table to see if we've already defined it. If so, we avoid duplicating
+  ;; the definition later.
+  (define extra-defs
+    (cond [(null? name-defs) null]
+          [else
+           (define names (apply append (dict-keys name-defs)))
+           (for/list ([name (in-list names)]
+                      [sc   (in-list (apply append (dict-values name-defs)))]
+                      #:unless (lookup-name-defined name))
+             (set-name-defined name)
+             #`(define #,name
+                 (recursive-contract #,(recur sc)
+                                     #,(kind->keyword (hash-ref recursive-kinds name)))))]))
+  (list (append ;; These contracts are sub-contract definitions used to
+                ;; increase sharing among contracts in a given fixup pass
+                extra-defs
+                (for/list ([sc (in-list (reverse sc-queue))])
+                  (match-define (cons id ctc) (hash-ref cache sc))
+                  #`(define #,id #,ctc)))
+        ctc))
+
+;; determine if a given name is free in the sc
+(define (name-free-in? name sc)
+  (let/ec escape
+    (define/match (free? sc _)
+      [((or (recursive-sc-use name*)
+            (parametric-var/sc: name*)
+            (name/sc: name*))
+        _)
+       (when (free-identifier=? name name*)
+         (escape #t))]
+      [(_ _) (sc-traverse sc free?)])
+    (free? sc 'dummy)
+    #f))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/parametric-check.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/parametric-check.rkt
index c3b1fa03..6810dd10 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/parametric-check.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/parametric-check.rkt
@@ -29,8 +29,14 @@
   (define (get-rec-var id)
     (dict-ref! rec-vars id (lambda () (add-variable! eqs 0))))
 
+  (define seen (make-hash))
+
   (define (recur sc variance)
+    (define seen? #f)
     (match sc
+      ;; skip already seen sc
+      [(? (λ (sc) (hash-ref seen (list sc variance) #f)))
+       (set! seen? #t)]
       [(or (or/sc: elems ...) (and/sc: elems ...))
        (add-equation! eqs (get-var sc)
                       (lambda () (for/sum ((e elems))
@@ -45,7 +51,9 @@
        (add-equation! eqs (get-var sc) (lambda () (variable-ref (get-rec-var id))))]
       [else
        (get-var sc)])
-    (sc-traverse sc recur))
+    (unless seen?
+      (hash-set! seen (list sc variance) #t)
+      (sc-traverse sc recur)))
 
   (recur sc 'covariant)
 
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt
index e9462d05..a9a426c7 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt
@@ -11,6 +11,7 @@
          (submod typed-racket/private/type-contract numeric-contracts)
          (submod typed-racket/private/type-contract test-exports)
          (only-in racket/contract contract)
+         racket/match
          rackunit)
 (provide tests)
 (gen-test-main)
@@ -99,16 +100,20 @@
      #`(test-case (format "~a for ~a in ~a" 'type-expr 'val-expr 'fun-expr)
          (let ([type-val type-expr] [fun-val fun-expr] [val val-expr])
            (with-check-info (['type type-val] ['test-value val])
-             (define ctc-stx
+             (define ctc-result
                (type->contract type-val
                                #:typed-side typed-side
                                (λ (#:reason [reason #f])
                                  (fail-check (or reason "Type could not be converted to contract")))))
+             (match-define (list extra-stxs ctc-stx) ctc-result)
              (define ctced-val
-               (eval #`(contract #,(syntax-shift-phase-level ctc-stx 1)
-                                 #,val
-                                 #,(quote (quote #,pos))
-                                 #,(quote (quote #,neg)))
+               (eval #`(let ()
+                         #,@(map (λ (stx) (syntax-shift-phase-level stx 1))
+                                 extra-stxs)
+                         (contract #,(syntax-shift-phase-level ctc-stx 1)
+                                   #,val
+                                   #,(quote (quote #,pos))
+                                   #,(quote (quote #,neg))))
                      (ctc-namespace)))
              (check (λ () (fun-val ctced-val))))))]))
 
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-conversion-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-conversion-tests.rkt
index 2d4ab655..eeb87090 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-conversion-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-conversion-tests.rkt
@@ -28,8 +28,9 @@
              (if sc
                  #`(with-check-info (['static '#,sc])
                      (phase1-phase0-eval
-                       (define ctc (instantiate '#,sc
-                                     (lambda (#:reason _) (error "static-contract could not be converted to a contract"))))
+                       (define ctc (cadr
+                                     (instantiate '#,sc
+                                       (lambda (#:reason _) (error "static-contract could not be converted to a contract")))))
                        #,#'#`(with-check-info (['contract '#,ctc])
                           (define runtime-contract #,ctc)
                           (check-pred contract? runtime-contract))))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
index 3928e869..ac9167b8 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
@@ -48,10 +48,11 @@
                  (make-check-expected expected))
            (λ ()
              (let ([ctc (syntax->datum
+                         (cadr
                           (instantiate
                             (optimize argument #:trusted-positive #t)
                             (λ (#:reason [reason #f]) (error 'nyi))
-                            'impersonator))])
+                            'impersonator)))])
                (with-check-info* (list (make-check-actual ctc))
                  (λ ()
                    (unless (equal? ctc expected)