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

Only generate ->* contracts when arguments are really optional arguments.

Browse Source 
Closes PR13274.

original commit: 6a7b971cd66b79e1aac0e0ea65bc59f667ef727e
This commit is contained in:
Vincent St-Amour 2012-11-19 17:24:40 -05:00
parent 690f54e633
commit dd27a40ad8
2 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/typed-racket/fail/pr13274.rkt Normal file
View File

@ -0,0 +1,16 @@
#;
(exn-pred exn:fail:contract?)
#lang racket/base
(module f-t typed/racket
(: flomap-transform (case-> (Integer Integer -> Integer)
(Integer Integer Integer Integer Integer Integer -> Integer)))
(define flomap-transform
(case-lambda
[(fm t) fm]
[(fm t x-start y-start x-end y-end) fm]))
(provide flomap-transform))
(require 'f-t)
(flomap-transform 2 3 4) ; only accepts 2 or 6 arguments

15
collects/typed-racket/private/type-contract.rkt
View File

@ -142,7 +142,11 @@
[_ #`(values #,@rngs*)]))
(cond
;; To generate a single `->*', everything must be the same for all arrs, except for positional
;; arguments which only need to be monotonically increasing.
;; arguments which can increase by at most one each time.
;; Note: optional arguments can only increase by 1 each time, to avoid problems with
;; functions that take, e.g., either 2 or 6 arguments. These functions shouldn't match,
;; since this code would generate contracts that accept any number of arguments between
;; 2 and 6, which is wrong.
;; TODO sufficient condition, but may not be necessary
[(and
(> (length arrs) 1)
@ -151,17 +155,20 @@
(list rng rest-spec kws)])
arrs)])
(foldl equal? (first xs) (rest xs)))
;; Positionals are monotonically increasing.
;; Positionals are monotonically increasing by at most one.
(let-values ([(_ ok?)
(for/fold ([positionals '()]
[ok-so-far? #t])
([arr (in-list arrs)])
(match arr
[(arr: dom _ _ _ _)
(define ldom (length dom))
(define lpositionals (length positionals))
(values dom
(and ok-so-far?
(>= (length dom) (length positionals))
(equal? positionals (take dom (length positionals)))))]))])
(or (= ldom lpositionals)
(= ldom (add1 lpositionals)))
(equal? positionals (take dom lpositionals))))]))])
ok?))
(match* ((first arrs) (last arrs))
[((arr: first-dom (Values: (list (Result: rngs (FilterSet: (Top:) (Top:)) (Empty:)) ...)) rst #f kws)