improve new or/c's stronger predicate

2014-05-14 08:40:04 -05:00 · 2014-05-14 08:40:04 -05:00 · e1bd6bab6a
commit e1bd6bab6a
parent 7da7eacbda
1 changed files with 8 additions and 1 deletions
--- a/racket/collects/racket/contract/private/orc.rkt
+++ b/racket/collects/racket/contract/private/orc.rkt
@ -447,7 +447,14 @@
   #:name
   (λ (ctc) (flat-rec-contract-name ctc))
   #:stronger
-   (λ (this that) (equal? this that))
+   (let ([recur? (make-parameter #t)])
+     (λ (this that) 
+       (cond
+         [(equal? this that) #t]
+         [(recur?) 
+          (parameterize ([recur? #f])
+            (contract-stronger? (get-flat-rec-me this) that))]
+         [else #f])))
   #:first-order
   (λ (ctc) 
     (λ (v)