From b054cf0cdb4de487b09ea97d90447a591dbfb1f6 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 10 May 2014 17:23:35 -0700 Subject: [PATCH] Make inference work with lists under dotted lists. original commit: 7f400e7bdea2e4845fd3801226f8c9a943faf982 --- .../typed-racket-lib/typed-racket/infer/infer-unit.rkt | 5 +++++ .../tests/typed-racket/unit-tests/infer-tests.rkt | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) 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 index eb231945..c37964cd 100644 --- 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 index 8f45f195..e65440fa 100644 --- 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))