From 727c5bb0b0f4d25dc546fc42151620478e08f2fb Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sun, 15 Feb 2009 21:30:02 +0000 Subject: [PATCH] subtype caching svn: r13615 original commit: ed83737d5f6943687c2148457e582dc707363f34 --- collects/typed-scheme/private/subtype.ss | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/private/subtype.ss b/collects/typed-scheme/private/subtype.ss index 513c4535..0c2ffdb7 100644 --- a/collects/typed-scheme/private/subtype.ss +++ b/collects/typed-scheme/private/subtype.ss @@ -40,13 +40,26 @@ (define (remember s t A) (cons (seen-before s t) A)) (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? ;; type type -> boolean (define (subtype s t) - (with-handlers - ([exn:subtype? (lambda _ #f)]) - (subtype* (current-seen) s t))) + (define k (cons (Type-seq s) (Type-seq t))) + (define lookup? (hash-ref subtype-cache k 'no)) + (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? ;; [type] [type] -> boolean