Infer in dotted lists when we can infer on the bound.
This commit is contained in:
parent
7f400e7bde
commit
3ccc14432b
|
@ -591,9 +591,11 @@
|
|||
(and v (move-rest-to-dmap v dbound #:exact #t))]
|
||||
|
||||
;; two ListDots with the same bound, just check the element type
|
||||
;; This is conservative because we don't try to infer a constraint on dbound.
|
||||
[((ListDots: s-dty dbound) (ListDots: t-dty dbound))
|
||||
(cgen V X Y s-dty t-dty)]
|
||||
(if (memq dbound Y)
|
||||
(extend-tvars (list dbound)
|
||||
(% move-rest-to-dmap (cgen V (cons dbound X) Y s-dty t-dty) dbound))
|
||||
(cgen V X Y s-dty t-dty))]
|
||||
[((ListDots: s-dty (? (λ (db) (memq db Y)) s-dbound)) (ListDots: t-dty t-dbound))
|
||||
;; What should we do if both are in Y?
|
||||
#:return-when (memq t-dbound Y) #f
|
||||
|
|
|
@ -105,6 +105,8 @@
|
|||
(infer-t (-lst -Symbol) (make-ListDots -Symbol 'b) #:indices '(b))
|
||||
(infer-t (make-ListDots (-v b) 'b) (-lst Univ) #:indices '(b))
|
||||
(infer-t (make-ListDots (-v a) 'b) (make-ListDots -Symbol 'b) #:vars '(a))
|
||||
(infer-t (make-ListDots (-v b) 'b) (make-ListDots -Symbol 'b) #:indices '(b))
|
||||
(infer-t (make-ListDots -Symbol 'b) (make-ListDots (-v b) 'b) #:indices '(b))
|
||||
(infer-t (make-ListDots -Symbol 'b) (make-ListDots Univ 'b) #:indices '(b))
|
||||
(infer-t (make-ListDots (-v b) 'b) (make-ListDots (-v b) 'b) #:indices '(b))
|
||||
(infer-t (make-ListDots (-v b) 'b) (make-ListDots Univ 'b) #:indices '(b))
|
||||
|
@ -131,8 +133,6 @@
|
|||
[infer-t (-lst* -String) (make-ListDots -Symbol 'b) #:indices '(b) #:fail]
|
||||
|
||||
;; Currently Broken
|
||||
;(infer-t (make-ListDots (-v b) 'b) (make-ListDots -Symbol 'b) #:indices '(b))
|
||||
;(infer-t (make-ListDots -Symbol 'b) (make-ListDots (-v b) 'b) #:indices '(b))
|
||||
;(infer-t (make-ListDots -Symbol 'b) (-pair -Symbol (-lst -Symbol)) #:indices '(b))
|
||||
[i2-t (-v a) N ('a N)]
|
||||
[i2-t (-pair (-v a) (-v a)) (-pair N (Un N B)) ('a (Un N B))]
|
||||
|
|
Loading…
Reference in New Issue
Block a user