suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

change the recursive contract stronger implementation

Browse Source 
to use hash tables instead of association lists
This commit is contained in:
Robby Findler 2014-09-29 16:08:40 -05:00
parent 43ffd4b6ce
commit 221519f47f
1 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
racket/collects/racket/contract/private/prop.rkt
View File

@ -111,16 +111,24 @@
(define prop (contract-struct-property a)) (define prop (contract-struct-property a))
(define stronger? (contract-property-stronger prop)) (define stronger? (contract-property-stronger prop))
(cond (cond
[(let ([tc (trail)]) [(let ([th (trail)])
(and tc (and th
(ormap (λ (pr) (and (equal? (car pr) a) (equal? (cdr pr) b))) (for/or ([(a2 bs-h) (in-hash th)])
(unbox tc)))) (and (eq? a a2)
(for/or ([(b2 _) (in-hash bs-h)])
(eq? b b2))))))
#t] #t]
[(or (prop:recursive-contract? a) (prop:recursive-contract? b)) [(or (prop:recursive-contract? a) (prop:recursive-contract? b))
(parameterize ([trail (or (trail) (box '()))]) (parameterize ([trail (or (trail) (make-hasheq))])
(define trail-b (trail)) (define trail-h (trail))
(define trail-c (unbox trail-b)) (let ([a-h (hash-ref trail-h a #f)])
(set-box! trail-b (cons (cons a b) trail-c)) (cond
[a-h
(hash-set! a-h b #t)]
[else
(define a-h (make-hasheq))
(hash-set! trail-h a a-h)
(hash-set! a-h b #t)]))
(contract-struct-stronger? (if (prop:recursive-contract? a) (contract-struct-stronger? (if (prop:recursive-contract? a)
((prop:recursive-contract-unroll a) a) ((prop:recursive-contract-unroll a) a)
a) a)