Simplify constraint->type.

This commit is contained in:
Eric Dobson 2014-05-18 15:23:36 -07:00
parent 6cc10cdb18
commit 993748909f

View File

@ -693,24 +693,21 @@
. -> . (or/c #f substitution/c)) . -> . (or/c #f substitution/c))
(define var-hash (free-vars-hash (free-vars* R))) (define var-hash (free-vars-hash (free-vars* R)))
(define idx-hash (free-vars-hash (free-idxs* R))) (define idx-hash (free-vars-hash (free-idxs* R)))
;; v : Symbol - variable for which to check variance ;; c : Constaint
;; h : (Hash Symbol Variance) - hash to check variance in (either var or idx hash) ;; variance : Variance
;; variable: Symbol - variable to use instead, if v was a temp var for idx extension (define (constraint->type v variance)
(define (constraint->type v h #:variable [variable #f])
(match v (match v
[(c S X T) [(c S _ T)
(let ([var (hash-ref h (or variable X) Constant)]) (evcase variance
;(printf "variance was: ~a\nR was ~a\nX was ~a\nS T ~a ~a\n" var R (or variable X) S T)
(evcase var
[Constant S] [Constant S]
[Covariant S] [Covariant S]
[Contravariant T] [Contravariant T]
[Invariant [Invariant
(let ([gS (generalize S)]) (let ([gS (generalize S)])
;(printf "Inv var: ~a ~a ~a ~a\n" v S gS T)
(if (subtype gS T) (if (subtype gS T)
gS gS
S))]))])) S))])]))
;; Since we don't add entries to the empty cset for index variables (since there is no ;; Since we don't add entries to the empty cset for index variables (since there is no
;; widest constraint, due to dcon-exacts), we must add substitutions here if no constraint ;; widest constraint, due to dcon-exacts), we must add substitutions here if no constraint
;; was found. If we're at this point and had no other constraints, then adding the ;; was found. If we're at this point and had no other constraints, then adding the
@ -732,31 +729,23 @@
[(cons cmap (dmap dm)) [(cons cmap (dmap dm))
(let ([subst (hash-union (let ([subst (hash-union
(for/hash ([(k dc) (in-hash dm)]) (for/hash ([(k dc) (in-hash dm)])
(define (c->t c) (constraint->type c (hash-ref idx-hash k Constant)))
(values (values
k k
(match dc (match dc
[(dcon fixed #f) [(dcon fixed #f)
(i-subst (i-subst (map c->t fixed))]
(for/list ([f fixed]) [(or (dcon fixed rest) (dcon-exact fixed rest))
(constraint->type f idx-hash #:variable k)))]
[(dcon fixed rest)
(i-subst/starred (i-subst/starred
(for/list ([f (in-list fixed)]) (map c->t fixed)
(constraint->type f idx-hash #:variable k)) (c->t rest))]
(constraint->type rest idx-hash))]
[(dcon-exact fixed rest)
(i-subst/starred
(for/list ([f (in-list fixed)])
(constraint->type f idx-hash #:variable k))
(constraint->type rest idx-hash))]
[(dcon-dotted fixed dc dbound) [(dcon-dotted fixed dc dbound)
(i-subst/dotted (i-subst/dotted
(for/list ([f (in-list fixed)]) (map c->t fixed)
(constraint->type f idx-hash #:variable k)) (c->t dc)
(constraint->type dc idx-hash #:variable k)
dbound)]))) dbound)])))
(for/hash ([(k v) (in-hash cmap)]) (for/hash ([(k v) (in-hash cmap)])
(values k (t-subst (constraint->type v var-hash)))))]) (values k (t-subst (constraint->type v (hash-ref var-hash k Constant))))))])
;; verify that we got all the important variables ;; verify that we got all the important variables
(and (for/and ([v (in-list X)]) (and (for/and ([v (in-list X)])
(let ([entry (hash-ref subst v #f)]) (let ([entry (hash-ref subst v #f)])