suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Strengthen contracts to require syntax lists.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2011-07-18 17:41:17 -04:00
parent 25cdd87405
commit 23c47728c5
2 changed files with 2 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/typed-scheme/typecheck/tc-app-helper.rkt
View File

@ -13,7 +13,7 @@
;; syntax? syntax? arr? (listof tc-results?) (or/c #f tc-results) [boolean?] -> tc-results? ;; 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]) (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) (match* (ftype0 argtys)
;; we check that all kw args are optional ;; 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) ...))) [((arr: dom (Values: (and results (list (Result: t-r f-r o-r) ...))) rest #f (and kws (list (Keyword: _ _ #f) ...)))

2
collects/typed-scheme/typecheck/tc-funapp.rkt
View File

@ -39,7 +39,7 @@
(poly-fail f-stx args-stx t argtys #:name (and (identifier? f-stx) f-stx) #:expected expected))))])) (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) (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) (match* (ftype0 argtys)
;; we special-case this (no case-lambda) for improved error messages ;; 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) [((tc-result1: (and t (Function: (list (and a (arr: dom (Values: _) rest #f kws)))))) argtys)