Make inference work with lists under dotted lists.

endobson · endobson · commit 7f400e7bdea2 · 2014-05-17T22:13:49.000-07:00
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt
@@ -585,6 +585,11 @@
            (if (memq dbound Y)
                (% 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))]
+          [((Listof: s-elem) (ListDots: t-dty dbound))
+           #:return-unless (memq dbound Y) #f
+           (define v (cgen V (cons dbound X) Y s-elem t-dty))
+           (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))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/infer-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/infer-tests.rkt
@@ -102,6 +102,7 @@
     (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 (-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 -Symbol 'b) (make-ListDots Univ 'b) #:indices '(b))
@@ -130,7 +131,6 @@
     [infer-t (-lst* -String) (make-ListDots -Symbol 'b) #:indices '(b) #:fail]
 
     ;; Currently Broken
-    ;(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 -Symbol 'b) (make-ListDots (-v b) 'b) #:indices '(b))
     ;(infer-t (make-ListDots -Symbol 'b) (-pair -Symbol (-lst -Symbol)) #:indices '(b))
