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

subtype caching

Browse Source 
svn: r13615
This commit is contained in:
Sam Tobin-Hochstadt 2009-02-15 21:30:02 +00:00
parent aefaaa26d0
commit ed83737d5f
1 changed files with 16 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/typed-scheme/private/subtype.ss
View File

@ -40,13 +40,26 @@
(define (remember s t A) (cons (seen-before s t) A)) (define (remember s t A) (cons (seen-before s t) A))
(define (seen? s t) (member (seen-before s t) (current-seen))) (define (seen? s t) (member (seen-before s t) (current-seen)))
(define subtype-cache (make-hash))
(define (cache-types s t)
(cache-keys (Type-seq s) (Type-seq t)))
(define (cache-keys ks kt)
(hash-set! subtype-cache (cons ks kt) #t))
(define (cached? s t)
(hash-ref subtype-cache (cons (Type-seq s) (Type-seq t)) #f))
;; is s a subtype of t? ;; is s a subtype of t?
;; type type -> boolean ;; type type -> boolean
(define (subtype s t) (define (subtype s t)
(with-handlers (define k (cons (Type-seq s) (Type-seq t)))
([exn:subtype? (lambda _ #f)]) (define lookup? (hash-ref subtype-cache k 'no))
(subtype* (current-seen) s t))) (if (eq? 'no lookup?)
(let ([result (with-handlers
([exn:subtype? (lambda _ #f)])
(subtype* (current-seen) s t))])
(hash-set! subtype-cache k result)
result)
lookup?))
;; are all the s's subtypes of all the t's? ;; are all the s's subtypes of all the t's?
;; [type] [type] -> boolean ;; [type] [type] -> boolean