diff --git a/collects/typed-scheme/private/infer-unit.ss b/collects/typed-scheme/private/infer-unit.ss index f8add2261b..ff3fe1b38e 100644 --- a/collects/typed-scheme/private/infer-unit.ss +++ b/collects/typed-scheme/private/infer-unit.ss @@ -319,23 +319,28 @@ [else (fail! S T)])])))) (define (subst-gen C R) - (for/list ([(k v) (car (car (cset-maps C)))]) + (define (constraint->type v #:variable [variable #f]) (match v [(struct c (S X T)) - (let ([var (hash-ref (free-vars* R) X Constant)]) - ;(printf "variance was: ~a~nR was ~a~n" var R) - (list - X - (evcase var + (let ([var (hash-ref (free-vars* R) (or variable X) Constant)]) + ;(printf "variance was: ~a~nR was ~a~nX was ~a~n" var R (or variable X)) + (evcase var [Constant S] [Covariant S] [Contravariant T] - [Invariant - #; ; don't fail, we just pretend in covariance - (unless (type-equal? S T) - ;(printf "invariant and not equal ~a ~a" S T) - (fail! S T)) - S])))]))) + [Invariant S]))])) + (match (car (cset-maps C)) + [(cons cmap (struct dmap (dm))) + (append + (for/list ([(k dc) dm]) + (match dc + [(struct dcon (fixed rest)) + (list k + (for/list ([f fixed]) + (constraint->type f #:variable k)) + (and rest (constraint->type rest)))])) + (for/list ([(k v) cmap]) + (list k (constraint->type v))))])) (define (cgen/list X V S T) (cset-meet* (for/list ([s S] [t T]) (cgen V X s t)))) diff --git a/collects/typed-scheme/private/type-rep.ss b/collects/typed-scheme/private/type-rep.ss index b15df1cbd4..12d80c3fc3 100644 --- a/collects/typed-scheme/private/type-rep.ss +++ b/collects/typed-scheme/private/type-rep.ss @@ -101,9 +101,9 @@ (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)) + #;[(cons t (? symbol? bnd)) (let ([vs (free-vars* t)]) - (list (flip-variances (fix-bound vs bnd))))] + (list (flip-variances vs)))] [(cons t bnd) (list (flip-variances (free-vars* t)))] [_ null]) (list (free-vars* rng)) @@ -111,9 +111,9 @@ (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)) + #;[(cons t (? number? bnd)) (let ([vs (free-idxs* t)]) - (list (flip-variances (fix-bound vs bnd))))] + (list (flip-variances vs)))] [(cons t bnd) (list (flip-variances (free-idxs* t)))] [_ null]) (list (free-idxs* rng)) diff --git a/collects/typed-scheme/private/type-utils.ss b/collects/typed-scheme/private/type-utils.ss index 4022514d43..c78ea3eaaf 100644 --- a/collects/typed-scheme/private/type-utils.ss +++ b/collects/typed-scheme/private/type-utils.ss @@ -54,7 +54,6 @@ (define (sb t) (substitute-dots images name t)) (if (hash-ref (free-vars* target) name #f) (type-case sb target - [#:F name* target] [#:arr dom rng rest drest thn-eff els-eff (if (and (pair? drest) (eq? name (cdr drest))) @@ -101,7 +100,14 @@ ;; substitution = Listof[List[Name,Type]] ;; subst-all : substition Type -> Type (define (subst-all s t) - (foldr (lambda (e acc) (substitute (cadr e) (car e) acc)) t s)) + (for/fold ([t t]) ([e s]) + (match e + [(list v (list imgs ...) #f) + (substitute-dots imgs v t)] + [(list v (list ts) starred) + (int-err "subst-all: nyi")] + [(list v img) + (substitute img v t)]))) ;; unfold : Type -> Type