From ef8101bde3e547b44f3e76a7545d43ea546d5635 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 27 Apr 2018 14:43:38 -0500
Subject: [PATCH] Revert "change the strategy for recursive-contract's knot
 tying"

This reverts commit 2a1c8a78a59515d9f68bd1f98c1a26dec91ab6bf.

something goes wrong with large recursive nests with this commit
---
 .../racket/contract/recursive-contract.rkt    |  2 +-
 .../collects/racket/contract/private/base.rkt | 44 ++++++++++---------
 .../racket/contract/private/object.rkt        |  4 +-
 3 files changed, 27 insertions(+), 23 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/recursive-contract.rkt b/pkgs/racket-test/tests/racket/contract/recursive-contract.rkt
index 37be119356..92d658824d 100644
--- a/pkgs/racket-test/tests/racket/contract/recursive-contract.rkt
+++ b/pkgs/racket-test/tests/racket/contract/recursive-contract.rkt
@@ -111,7 +111,7 @@
       (for ([i (in-range 100)])
         (void (vector-ref v 0)))
       counter)
-   3)
+   2)
 
   (test/spec-passed/result
    'recursive-contract-not-too-slow
diff --git a/racket/collects/racket/contract/private/base.rkt b/racket/collects/racket/contract/private/base.rkt
index 6636d8fbc4..f39714890b 100644
--- a/racket/collects/racket/contract/private/base.rkt
+++ b/racket/collects/racket/contract/private/base.rkt
@@ -156,7 +156,6 @@
     #`(#,maker '#,stx
                (λ () #,arg)
                '#,(syntax-local-infer-name stx)
-               (make-parameter #f)
                #,(if list-contract? #'#t #'#f)
                #,@(if (equal? (syntax-e type) '#:flat)
                       (list (if extra-delay? #'#t #'#f))
@@ -205,27 +204,32 @@
     [else current]))
 
 (define (recursive-contract-late-neg-projection ctc)
-  (define p (recursive-contract-param ctc))
-  (λ (blame)
-    (cond
-      [(p) => (λ (b) (λ (val neg-party) ((unbox b) val neg-party)))]
-      [else
+  (cond
+    [(recursive-contract-list-contract? ctc)
+     (λ (blame)
        (define r-ctc (force-recursive-contract ctc))
        (define f (get/build-late-neg-projection r-ctc))
        (define blame-known (blame-add-context blame #f))
-       (define b (box 'uninitialized-recursive-contract))
-       (define func (parameterize ([p b]) (f blame-known)))
-       (set-box! b func)
-       (cond
-         [(recursive-contract-list-contract? ctc)
-          (λ (val neg-party)
-            (unless (list? val)
-              (raise-blame-error blame-known #:missing-party neg-party
-                                 val
-                                 '(expected: "list?" given: "~e")
-                                 val))
-            (func val neg-party))]
-         [else func])])))
+       (define f-blame-known (make-thread-cell #f))
+       (λ (val neg-party)
+         (unless (list? val)
+           (raise-blame-error blame-known #:missing-party neg-party
+                              val
+                              '(expected: "list?" given: "~e")
+                              val))
+         (unless (thread-cell-ref f-blame-known)
+           (thread-cell-set! f-blame-known (f blame-known)))
+         ((thread-cell-ref f-blame-known) val neg-party)))]
+    [else
+     (λ (blame)
+       (define r-ctc (force-recursive-contract ctc))
+       (define f (get/build-late-neg-projection r-ctc))
+       (define blame-known (blame-add-context blame #f))
+       (define f-blame-known (make-thread-cell #f))
+       (λ (val neg-party)
+         (unless (thread-cell-ref f-blame-known)
+           (thread-cell-set! f-blame-known (f blame-known)))
+         ((thread-cell-ref f-blame-known) val neg-party)))]))
 
 (define (flat-recursive-contract-late-neg-projection ctc)
   (cond
@@ -269,7 +273,7 @@
        (force-recursive-contract ctc)
        (contract-random-generate/choose (recursive-contract-ctc ctc) (- fuel 1))])))
 
-(struct recursive-contract ([name #:mutable] [thunk #:mutable] [ctc #:mutable] param list-contract?)
+(struct recursive-contract ([name #:mutable] [thunk #:mutable] [ctc #:mutable] list-contract?)
   #:property prop:recursive-contract (λ (this)
                                        (force-recursive-contract this)
                                        (recursive-contract-ctc this)))
diff --git a/racket/collects/racket/contract/private/object.rkt b/racket/collects/racket/contract/private/object.rkt
index 0f19692ff5..329a0ff6e8 100644
--- a/racket/collects/racket/contract/private/object.rkt
+++ b/racket/collects/racket/contract/private/object.rkt
@@ -65,9 +65,9 @@
      (define mtd-ctcs (object-contract-method-ctcs ctc))
      (λ (blame)
        (define p-app
-         (make-wrapper-object blame mtds mtd-ctcs flds fld-ctcs))
+         (make-wrapper-object blame mtds mtd-ctcs))
        (λ (val neg-party)
-         (p-app ctc val neg-party))))
+         (p-app ctc val neg-party flds fld-ctcs))))
    #:name
    (λ (ctc) `(object-contract ,@(map (λ (fld ctc) (build-compound-type-name 'field fld ctc))
                                      (object-contract-fields ctc)