Fix inference for dotted and starred arr types.

original commit: 7a435b154ca517b1fcae2ddd3f4387e8f2f82ef0
This commit is contained in:
Eric Dobson 2014-04-23 23:57:11 -07:00
parent 7d10ce5d54
commit 9bf4fa62e0
2 changed files with 8 additions and 2 deletions

View File

@ -311,12 +311,14 @@
[new-s-arr (make-arr (append ss new-tys) s #f (cons s-dty dbound) null)]
[new-cset (cgen/arr V (append vars X) Y new-s-arr t-arr)])
(move-vars+rest-to-dmap new-cset dbound vars #:exact #t))]
[else
[(= (length ss) (length ts))
;; the simple case
(let* ([arg-mapping (cgen/list V X Y (extend ss ts t-rest) ss)]
[darg-mapping (move-rest-to-dmap (cgen V (cons dbound X) Y t-rest s-dty) dbound #:exact #t)]
[ret-mapping (cg s t)])
(cset-meet* (list arg-mapping darg-mapping ret-mapping)))])]
(cset-meet* (list arg-mapping darg-mapping ret-mapping)))]
[else
(fail! s-arr t-arr)])]
[(_ _) (fail! s-arr t-arr)]))
(define/cond-contract (cgen/flds V X Y flds-s flds-t)

View File

@ -244,6 +244,10 @@
[(-polydots (a) (->... (list) (a a) (make-ListDots a 'a)))
(-polydots (b a) (->... (list b) (a a) (-pair b (make-ListDots a 'a))))]
[FAIL
(-polydots (c a b) (->... (list (->... (list a) (b b) c) (-vec a)) ((-vec b) b) (-vec c)))
(->* (list (->* (list) -Symbol -Symbol)) (-vec -Symbol) (-vec -Symbol))]
[(-> Univ -Boolean : (-FS (-filter -Symbol 0) (-not-filter -Symbol 0)))
(-> Univ -Boolean : -top-filter)]
[(-> Univ -Boolean : -bot-filter)