Do not update subtype and resolve caches when subtyping.

Closes PR13412.

original commit: 13ff5883fe097f8b37e6a7663e3e0d8baf8c466b
This commit is contained in:
Eric Dobson 2013-01-26 15:45:06 -08:00 committed by Sam Tobin-Hochstadt
parent ae3a41a9ab
commit e9e54d41a8
4 changed files with 31 additions and 13 deletions

View File

@ -0,0 +1,12 @@
#lang typed/racket
(define-type (Tree A) (U (Listof A) (node A)))
(struct: (A) node ([val : A]
[left : (Tree A)]
[right : (Tree A)]))
(: tree-set (All (A) (A (Tree A) -> (Tree A))))
(define (tree-set y t)
(cond [(node? t) (node y (node-left t) (node-right t))]
[else (list y)]))

View File

@ -0,0 +1,13 @@
#lang racket/base
(require "../utils/utils.rkt")
(require (rep type-rep))
(provide (all-defined-out))
(define current-seen (make-parameter null))
(define (currently-subtyping?) (not (null? (current-seen))))
(define (seen-before s t) (cons (Type-seq s) (Type-seq t)))
(define (remember s t A) (cons (seen-before s t) A))
(define (seen? s t) (member (seen-before s t) (current-seen)))

View File

@ -4,7 +4,7 @@
(require (rep type-rep rep-utils free-variance)
(env type-name-env)
(utils tc-utils)
(types utils)
(types utils current-seen)
racket/match
racket/contract
racket/format)
@ -82,7 +82,7 @@
[(App: r r* s)
(resolve-app r r* s)]
[(Name: _) (resolve-name t)])])
(when r*
(when (and r* (not (currently-subtyping?)))
(hash-set! resolver-cache seq r*))
r*)))

View File

@ -2,7 +2,7 @@
(require (except-in "../utils/utils.rkt" infer)
(rep type-rep filter-rep object-rep rep-utils)
(utils tc-utils)
(types utils resolve base-abbrev numeric-tower substitute)
(types utils resolve base-abbrev numeric-tower substitute current-seen)
(env type-name-env)
racket/match unstable/match
racket/function
@ -24,14 +24,6 @@
(syntax-rules ()
[(_ s t) (raise (make-exn:subtype "subtyping failed" (current-continuation-marks) s t))]))
;; data structures for remembering things on recursive calls
(define (empty-set) '())
(define current-seen (make-parameter (empty-set)))
(define (seen-before s t) (cons (Type-seq s) (Type-seq t)))
(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)
@ -54,7 +46,8 @@
(define result (handle-failure (and (subtype* (current-seen) s t) #t)))
;(printf "subtype cache miss ~a ~a\n" s t)
result)
(hash-ref! subtype-cache k new-val))
((if (currently-subtyping?) hash-ref hash-ref!)
subtype-cache k new-val))
;; are all the s's subtypes of all the t's?
;; [type] [type] -> boolean
@ -162,7 +155,7 @@
(define (subtypes/varargs args dom rst)
(with-handlers
([exn:subtype? (lambda _ #f)])
(subtypes*/varargs (empty-set) args dom rst)))
(subtypes*/varargs null args dom rst)))
(define (subtypes*/varargs A0 argtys dom rst)
(let loop-varargs ([dom dom] [argtys argtys] [A A0])