From 0a47887ef3b35053f48a714aeb2419b942f91f0a Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 18 Jul 2011 17:41:17 -0400 Subject: [PATCH] Strengthen contracts to require syntax lists. original commit: 23c47728c5e8db99da907312cc0ea466d02a3383 --- collects/typed-scheme/typecheck/tc-app-helper.rkt | 2 +- collects/typed-scheme/typecheck/tc-funapp.rkt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-app-helper.rkt b/collects/typed-scheme/typecheck/tc-app-helper.rkt index 5ca89167..c64b5ec1 100644 --- a/collects/typed-scheme/typecheck/tc-app-helper.rkt +++ b/collects/typed-scheme/typecheck/tc-app-helper.rkt @@ -13,7 +13,7 @@ ;; syntax? syntax? arr? (listof tc-results?) (or/c #f tc-results) [boolean?] -> tc-results? (define/cond-contract (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t]) - ((syntax? syntax? arr? (c:listof tc-results?) (c:or/c #f tc-results?)) (#:check boolean?) . c:->* . tc-results?) + ((syntax? (c:and/c syntax? syntax->list) arr? (c:listof tc-results?) (c:or/c #f tc-results?)) (#:check boolean?) . c:->* . tc-results?) (match* (ftype0 argtys) ;; we check that all kw args are optional [((arr: dom (Values: (and results (list (Result: t-r f-r o-r) ...))) rest #f (and kws (list (Keyword: _ _ #f) ...))) diff --git a/collects/typed-scheme/typecheck/tc-funapp.rkt b/collects/typed-scheme/typecheck/tc-funapp.rkt index 79ee7bf2..37da1bc3 100644 --- a/collects/typed-scheme/typecheck/tc-funapp.rkt +++ b/collects/typed-scheme/typecheck/tc-funapp.rkt @@ -39,7 +39,7 @@ (poly-fail f-stx args-stx t argtys #:name (and (identifier? f-stx) f-stx) #:expected expected))))])) (define/cond-contract (tc/funapp f-stx args-stx ftype0 argtys expected) - (syntax? syntax? tc-results? (c:listof tc-results?) (c:or/c #f tc-results?) . c:-> . tc-results?) + (syntax? (c:and/c syntax? syntax->list) tc-results? (c:listof tc-results?) (c:or/c #f tc-results?) . c:-> . tc-results?) (match* (ftype0 argtys) ;; we special-case this (no case-lambda) for improved error messages [((tc-result1: (and t (Function: (list (and a (arr: dom (Values: _) rest #f kws)))))) argtys)