From 1d6fa7e4b1f36f661bd63128388ca46123928c25 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sun, 18 May 2014 17:04:15 -0700 Subject: [PATCH] Fix uniform arg checking, and minor cleanup. original commit: 8a07889d08b111c5dfc2db4480bdcd07e978c924 --- .../typed-racket-lib/typed-racket/infer/infer-unit.rkt | 6 ++---- .../tests/typed-racket/unit-tests/infer-tests.rkt | 1 + 2 files changed, 3 insertions(+), 4 deletions(-) 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 0dd7cbb1..9c2d6e4d 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 @@ -231,9 +231,7 @@ ;; One is null-end the other is uniform-end [((seq ss (null-end)) (seq ts (uniform-end t-rest))) - (and - (<= (length ts) (length ss))) - (cgen/list V X Y ss (extend ss ts t-rest))] + (cgen/list V X Y ss (extend ss ts t-rest))] [((seq ss (uniform-end s-rest)) (seq ts (null-end))) #f] @@ -241,7 +239,7 @@ [((seq ss (uniform-end s-rest)) (seq ts (uniform-end t-rest))) (cgen/list V X Y - (cons s-rest (extend ts ss s-rest)) + (cons s-rest ss) (cons t-rest (extend ss ts t-rest)))] ;; dotted below, nothing above [((seq ss (dotted-end 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 c114ac3f..565adff8 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 @@ -155,6 +155,7 @@ [infer-t (make-ListDots -String 'a) (make-ListDots -Symbol 'b) #:indices '(b) #:fail] [infer-t (make-ListDots -String 'a) (make-ListDots -Symbol 'b) #:indices '(a) #:fail] [infer-t (-lst* -String) (make-ListDots -Symbol 'b) #:indices '(b) #:fail] + [infer-t (->* (list -Symbol) -Symbol -Void) (->* (list) (-v a) -Void) #:vars '(a) #:fail] ;; Currently Broken ;(infer-t (make-ListDots -Symbol 'b) (-pair -Symbol (-lst -Symbol)) #:indices '(b))