From 2022bc7b8007d1024c26d605c3ada7a149f07c8d Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 11 Jan 2010 22:13:22 +0000 Subject: [PATCH] `reverse' is special on all tuples svn: r17612 original commit: 81e963bd465ed66018506002a3b9a18f9c648493 --- collects/typed-scheme/typecheck/tc-app.ss | 11 ++++++++--- collects/typed-scheme/types/abbrev.ss | 2 +- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-app.ss b/collects/typed-scheme/typecheck/tc-app.ss index 4b002114..6dcd92ac 100644 --- a/collects/typed-scheme/typecheck/tc-app.ss +++ b/collects/typed-scheme/typecheck/tc-app.ss @@ -563,15 +563,20 @@ (ret (foldr make-Pair last tys)))] ;; special case for `reverse' to propogate expected type info [(#%plain-app reverse arg) - #:when expected (match expected [(tc-result1: (Listof: _)) (tc-expr/check #'arg expected)] [(tc-result1: (List: ts)) (tc-expr/check #'arg (ret (-Tuple (reverse ts)))) expected] - [_ - (tc/funapp #'reverse #'(arg) (single-value #'reverse) (list (single-value #'arg)) expected)])] + [_ + (match (single-value #'arg) + [(tc-result1: (List: ts)) + (if expected + (check-below (ret (-Tuple (reverse ts))) expected) + (ret (-Tuple (reverse ts))))] + [arg-ty + (tc/funapp #'reverse #'(arg) (single-value #'reverse) (list arg-ty) expected)])])] ;; inference for ((lambda [(#%plain-app (#%plain-lambda (x ...) . body) args ...) #:fail-unless (= (length (syntax->list #'(x ...))) diff --git a/collects/typed-scheme/types/abbrev.ss b/collects/typed-scheme/types/abbrev.ss index ee4ffb99..8c58bdc6 100644 --- a/collects/typed-scheme/types/abbrev.ss +++ b/collects/typed-scheme/types/abbrev.ss @@ -60,7 +60,7 @@ (lambda (stx) (syntax-parse stx [(_ elem-pats) - #'(app untuple elem-pats)]))) + #'(app untuple (? values elem-pats))]))) (d/c (-result t [f -no-lfilter] [o -no-lobj])