Handle inference of list dots under regular lists.

This commit is contained in:
Eric Dobson 2014-05-10 17:09:53 -07:00
parent b87e6a4496
commit 7af943e41d
2 changed files with 5 additions and 3 deletions

View File

@ -582,8 +582,9 @@
;; ListDots can be below a Listof ;; ListDots can be below a Listof
;; must be above mu unfolding ;; must be above mu unfolding
[((ListDots: s-dty dbound) (Listof: t-elem)) [((ListDots: s-dty dbound) (Listof: t-elem))
#:return-when (memq dbound Y) #f (if (memq dbound Y)
(cgen V X Y (substitute Univ dbound s-dty) t-elem)] (% move-rest-to-dmap (cgen V (cons dbound X) Y s-dty t-elem) dbound)
(cgen V X Y (substitute Univ dbound s-dty) t-elem))]
;; two ListDots with the same bound, just check the element type ;; 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. ;; This is conservative because we don't try to infer a constraint on dbound.
[((ListDots: s-dty dbound) (ListDots: t-dty dbound)) [((ListDots: s-dty dbound) (ListDots: t-dty dbound))

View File

@ -100,6 +100,8 @@
(infer-t (-v a) (-v b) #:vars '(b)) (infer-t (-v a) (-v b) #:vars '(b))
(infer-t (make-ListDots -Symbol 'b) (-lst -Symbol) #:indices '(b)) (infer-t (make-ListDots -Symbol 'b) (-lst -Symbol) #:indices '(b))
(infer-t (make-ListDots (-v a) 'b) (-lst -Symbol) #:vars '(a) #:indices '(b))
(infer-t (make-ListDots (-v b) 'b) (-lst -Symbol) #:indices '(b))
(infer-t (make-ListDots (-v b) 'b) (-lst Univ) #: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 a) 'b) (make-ListDots -Symbol 'b) #:vars '(a))
(infer-t (make-ListDots -Symbol 'b) (make-ListDots Univ 'b) #:indices '(b)) (infer-t (make-ListDots -Symbol 'b) (make-ListDots Univ 'b) #:indices '(b))
@ -128,7 +130,6 @@
[infer-t (-lst* -String) (make-ListDots -Symbol 'b) #:indices '(b) #:fail] [infer-t (-lst* -String) (make-ListDots -Symbol 'b) #:indices '(b) #:fail]
;; Currently Broken ;; Currently Broken
;(infer-t (make-ListDots (-v b) 'b) (-lst -Symbol) #:indices '(b))
;(infer-t (-lst -Symbol) (make-ListDots -Symbol 'b) #:indices '(b)) ;(infer-t (-lst -Symbol) (make-ListDots -Symbol 'b) #:indices '(b))
;(infer-t (make-ListDots (-v b) 'b) (make-ListDots -Symbol 'b) #:indices '(b)) ;(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 (-v b) 'b) #:indices '(b))