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

Update current-seen

Browse Source
This commit is contained in:
Eric Dobson 2014-03-21 09:21:39 -07:00
parent 31469441dc
commit 534f41e729
2 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/current-seen.rkt
View File

@ -2,11 +2,16 @@
(require "../utils/utils.rkt" racket/unsafe/ops) (require "../utils/utils.rkt" racket/unsafe/ops)
(require (rep type-rep) (contract-req)) (require (rep type-rep) (contract-req))
(provide (except-out (all-defined-out) current-seen)) (provide (except-out (all-defined-out) current-seen-mark))
(provide/cond-contract [current-seen (parameter/c list?)])
(define current-seen-mark (make-continuation-mark-key 'current-seen))
(define (current-seen)
(continuation-mark-set-first #f current-seen-mark null))
(define (currently-subtyping?)
(and (continuation-mark-set-first #f current-seen-mark) #t))
(define-syntax-rule (update-current-seen new-value body)
(with-continuation-mark current-seen-mark new-value body))
(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 (seen-before s t) (cons (Type-seq s) (Type-seq t)))
(define (remember s t A) (define (remember s t A)

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt
View File

@ -264,7 +264,7 @@
(define A0 (remember s t A)) (define A0 (remember s t A))
(define r (define r
;; FIXME -- make this go into only the places that need it -- slows down new-metrics.rkt significantly ;; FIXME -- make this go into only the places that need it -- slows down new-metrics.rkt significantly
(parameterize ([current-seen A0]) (update-current-seen A0
(match* (s t) (match* (s t)
;; these cases are above as special cases ;; these cases are above as special cases
;; [((Union: (list)) _) A0] ;; this is extremely common, so it goes first ;; [((Union: (list)) _) A0] ;; this is extremely common, so it goes first