Simplify constraint->type.
This commit is contained in:
parent
6cc10cdb18
commit
993748909f
|
@ -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)])
|
||||||
|
|
Loading…
Reference in New Issue
Block a user