From 2d27138aea057d69bee636b4ba1275cba1aa4176 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Fri, 21 Mar 2014 09:21:39 -0700 Subject: [PATCH] Update current-seen original commit: 534f41e729b8136e901359d38c946d8b23f637fb --- .../typed-racket/types/current-seen.rkt | 13 +++++++++---- .../typed-racket-lib/typed-racket/types/subtype.rkt | 2 +- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/current-seen.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/current-seen.rkt index 3cb86c08..ab9160be 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/current-seen.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/current-seen.rkt @@ -2,11 +2,16 @@ (require "../utils/utils.rkt" racket/unsafe/ops) (require (rep type-rep) (contract-req)) -(provide (except-out (all-defined-out) current-seen)) -(provide/cond-contract [current-seen (parameter/c list?)]) +(provide (except-out (all-defined-out) current-seen-mark)) + +(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 (remember s t A) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt index 6a64a91c..d44a9bf3 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt @@ -264,7 +264,7 @@ (define A0 (remember s t A)) (define r ;; 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) ;; these cases are above as special cases ;; [((Union: (list)) _) A0] ;; this is extremely common, so it goes first