From 410ed0526a0df80b9ab888d9e322e4506c24b1da Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 14 Dec 2011 16:38:15 -0500 Subject: [PATCH] Better types for `fourth' -- `tenth'. original commit: 7802eda6051913dc9bb8fd67f50ec468b9b39d26 --- .../unit-tests/typecheck-tests.rkt | 10 ++++++ collects/typed-racket/base-env/base-env.rkt | 36 +++++++++++++------ 2 files changed, 35 insertions(+), 11 deletions(-) diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index e09d8c33..acf64eda 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -1385,6 +1385,16 @@ (for/and: : Any ([i (in-range 4)]) (my-pred))) #:ret (ret Univ (-FS -top -top) (make-NoObject))] + [tc-e + (let () + (define: long : (List 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 Integer) + (list 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)) + + (define-syntax-rule (go acc ...) + (begin (ann (acc long) One) ...)) + + (go first second third fourth fifth sixth seventh eighth ninth tenth)) + (-val 1)] ) (test-suite "check-type tests" diff --git a/collects/typed-racket/base-env/base-env.rkt b/collects/typed-racket/base-env/base-env.rkt index 20167645..0cbabceb 100644 --- a/collects/typed-racket/base-env/base-env.rkt +++ b/collects/typed-racket/base-env/base-env.rkt @@ -175,19 +175,33 @@ (cl->* (->acc (list (-pair a (-lst b))) a (list -car)) (->* (list (-lst a)) a)))] -[second (-poly (a b c) - (cl->* [->acc (list (-pair a (-pair b (-lst c)))) b (list -car -cdr)] +[second (-poly (a r t) + (cl->* [->acc (list (-lst* a r #:tail (-lst t))) r (list -car -cdr)] [->* (list (-lst a)) a]))] -[third (-poly (a b c d) - (cl->* [->acc (list (-pair a (-pair b (-pair c (-lst d))))) c (list -car -cdr -cdr)] +[third (-poly (a b r t) + (cl->* [->acc (list (-lst* a b r #:tail (-lst t))) r (list -car -cdr -cdr)] + [->* (list (-lst a)) a]))] +[fourth (-poly (a b c r t) + (cl->* [->acc (list (-lst* a b c r #:tail (-lst t))) r (list -car -cdr -cdr -cdr)] + [->* (list (-lst a)) a]))] +[fifth (-poly (a b c d r t) + (cl->* [->acc (list (-lst* a b c d r #:tail (-lst t))) r (list -car -cdr -cdr -cdr -cdr)] + [->* (list (-lst a)) a]))] +[sixth (-poly (a b c d e r t) + (cl->* [->acc (list (-lst* a b c d e r #:tail (-lst t))) r (list -car -cdr -cdr -cdr -cdr -cdr)] + [->* (list (-lst a)) a]))] +[seventh (-poly (a b c d e f r t) + (cl->* [->acc (list (-lst* a b c d e f r #:tail (-lst t))) r (list -car -cdr -cdr -cdr -cdr -cdr -cdr)] + [->* (list (-lst a)) a]))] +[eighth (-poly (a b c d e f g r t) + (cl->* [->acc (list (-lst* a b c d e f g r #:tail (-lst t))) r (list -car -cdr -cdr -cdr -cdr -cdr -cdr -cdr)] + [->* (list (-lst a)) a]))] +[ninth (-poly (a b c d e f g h r t) + (cl->* [->acc (list (-lst* a b c d e f g h r #:tail (-lst t))) r (list -car -cdr -cdr -cdr -cdr -cdr -cdr -cdr -cdr)] + [->* (list (-lst a)) a]))] +[tenth (-poly (a b c d e f g h i r t) + (cl->* [->acc (list (-lst* a b c d e f g h i r #:tail (-lst t))) r (list -car -cdr -cdr -cdr -cdr -cdr -cdr -cdr -cdr -cdr)] [->* (list (-lst a)) a]))] -[fourth (-poly (a) ((-lst a) . -> . a))] -[fifth (-poly (a) ((-lst a) . -> . a))] -[sixth (-poly (a) ((-lst a) . -> . a))] -[seventh (-poly (a) ((-lst a) . -> . a))] -[eighth (-poly (a) ((-lst a) . -> . a))] -[ninth (-poly (a) ((-lst a) . -> . a))] -[tenth (-poly (a) ((-lst a) . -> . a))] [rest (-poly (a b) (cl->* (->acc (list (-pair a (-lst b))) (-lst b) (list -cdr))