From f77e4eeb418ffc1a626d40b97e56d1cfbac6c47d Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 19 May 2010 11:04:08 -0400 Subject: [PATCH] Added some special cases to type signatures for pair accessors. --- collects/typed-scheme/private/base-env.rkt | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt index 8c1d45c402..ae94e3110e 100644 --- a/collects/typed-scheme/private/base-env.rkt +++ b/collects/typed-scheme/private/base-env.rkt @@ -40,15 +40,20 @@ (->acc (list (-pair a b)) b (list -cdr)) (->* (list (-lst a)) (-lst a))))] +;; these type signatures do not cover all valid uses of these pair accessors [caar (-poly (a b c) (cl->* [->acc (list (-pair (-pair a b) c)) a (list -car -car)] + [-> (-lst (-pair a b)) a] + [-> (-pair (-lst a) b) a] [-> (-lst (-lst a)) a]))] [cdar (-poly (a b c) (cl->* [->acc (list (-pair (-pair a b) c)) b (list -cdr -car)] + [-> (-lst (-pair a b)) b] + [-> (-pair (-lst a) b) (-lst a)] [-> (-lst (-lst a)) (-lst a)]))] [cadr (-poly (a b c) (cl->* [->acc (list (-pair a (-pair b c))) b (list -car -cdr)] - [-> (-lst a) a]))] + [-> (-lst a) a]))] [cddr (-poly (a b c) (cl->* [->acc (list (-pair a (-pair b c))) c (list -cdr -cdr)] [-> (-lst a) (-lst a)]))]