From f3eb3154258a66b9b0678759f00065f5505f0a71 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Sat, 12 Jul 2008 22:30:00 -0400 Subject: [PATCH] I'm not sure if this is correct, but this handles the cases where we're instantiating dotted pre-types where the bound is _not_ free in the pre-type base. I checked in a test case for this, that's something like: (inst (plambda: (a ...) [ys : (Number ... a -> Number)] (apply + ys)) Integer Boolean String) = (Number Number Number -> Number) These changes introduce no extra test failures, and we really have to account for the bound here, and really even if the variable _does_ appear free within the pre-type base, it shouldn't be counted as a "regular" variable outside of that scope. Actually, maybe Dotted should behave like Constant, where it just propogates until there's a separate free use that we're merging with, in which case we just treat it like the free use (which will eventually get fix-bound applied to it anyway). I think I'll make that change next. --- collects/typed-scheme/private/free-variance.ss | 5 +++-- collects/typed-scheme/private/infer-unit.ss | 3 ++- collects/typed-scheme/private/type-rep.ss | 7 ++++--- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/collects/typed-scheme/private/free-variance.ss b/collects/typed-scheme/private/free-variance.ss index 2562dcb404..efa84ddbe3 100644 --- a/collects/typed-scheme/private/free-variance.ss +++ b/collects/typed-scheme/private/free-variance.ss @@ -43,7 +43,8 @@ (cond [(eq? v w) v] [(or (eq? v Dotted) (eq? w Dotted)) - (int-err "Cannot combine Dotted w/ not Dotted: ~a ~a" v w)] + Invariant + #;(int-err "Cannot combine Dotted w/ not Dotted: ~a ~a" v w)] [(eq? v Constant) w] [(eq? w Constant) v] [else Invariant])) @@ -63,7 +64,7 @@ (define (fix-bound vs bound) (define vs* (hash-map* (lambda (k v) v) vs)) (hash-remove! vs* bound) - (hash-set! vs* bound (cons bound Dotted)) + (hash-set! vs* bound Dotted) vs*) ;; frees -> frees diff --git a/collects/typed-scheme/private/infer-unit.ss b/collects/typed-scheme/private/infer-unit.ss index 8d197b94e0..27ec65707c 100644 --- a/collects/typed-scheme/private/infer-unit.ss +++ b/collects/typed-scheme/private/infer-unit.ss @@ -413,7 +413,8 @@ [Constant S] [Covariant S] [Contravariant T] - [Invariant S]))])) + [Invariant S] + [Dotted T]))])) (match (car (cset-maps C)) [(cons cmap (struct dmap (dm))) (check-vars diff --git a/collects/typed-scheme/private/type-rep.ss b/collects/typed-scheme/private/type-rep.ss index e43ca99da1..270ce36a76 100644 --- a/collects/typed-scheme/private/type-rep.ss +++ b/collects/typed-scheme/private/type-rep.ss @@ -101,9 +101,8 @@ (dt arr (dom rng rest drest thn-eff els-eff) [#:frees (combine-frees (append (map flip-variances (map free-vars* (append (if rest (list rest) null) dom))) (match drest - #;[(cons t (? symbol? bnd)) - (let ([vs (free-vars* t)]) - (list (flip-variances vs)))] + [(cons t (? symbol? bnd)) + (list (fix-bound (flip-variances (free-vars* t)) bnd))] [(cons t bnd) (list (flip-variances (free-vars* t)))] [_ null]) (list (free-vars* rng)) @@ -111,6 +110,8 @@ (map free-vars* (append thn-eff els-eff))))) (combine-frees (append (map flip-variances (map free-idxs* (append (if rest (list rest) null) dom))) (match drest + [(cons t (? number? bnd)) + (list (fix-bound (flip-variances (free-idxs* t)) bnd))] [(cons t bnd) (list (flip-variances (free-idxs* t)))] [_ null]) (list (free-idxs* rng))