Fix contracts and expected computation for tc-any-results.

original commit: e75e494e6a10b43b952de8d47c436c4f56e1fa41
This commit is contained in:
Sam Tobin-Hochstadt 2013-01-24 23:00:32 -05:00
parent 80ed6585fb
commit 96bb6af7c2
4 changed files with 9 additions and 9 deletions

View File

@ -27,12 +27,12 @@
(define (seen-before s t)
(cons (Type-seq s) (Type-seq t)))
(define/cond-contract (remember s t A)
(Values/c Values/c
((or/c AnyValues? Values/c) (or/c AnyValues? Values/c)
(listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?)) . -> .
(listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?)))
(cons (seen-before s t) A))
(define/cond-contract (seen? s t)
(Values/c Values/c . -> . any/c)
((or/c AnyValues? Values/c) (or/c AnyValues? Values/c) . -> . any/c)
(member (seen-before s t) (current-seen)))
@ -587,7 +587,7 @@
;; Y : (listof symbol?) - index variables that must have entries
;; R : Type/c - result type into which we will be substituting
(define/cond-contract (subst-gen C Y R)
(cset? (listof symbol?) (or/c Values/c ValuesDots?) . -> . (or/c #f substitution/c))
(cset? (listof symbol?) (or/c Values/c AnyValues? ValuesDots?) . -> . (or/c #f substitution/c))
(define var-hash (free-vars-hash (free-vars* R)))
(define idx-hash (free-vars-hash (free-idxs* R)))
;; v : Symbol - variable for which to check variance
@ -721,7 +721,7 @@
(define/cond-contract (infer X Y S T R [expected #f])
(((listof symbol?) (listof symbol?) (listof Type/c) (listof Type/c)
(or/c #f Values/c ValuesDots?))
((or/c #f Values/c ValuesDots?))
((or/c #f Values/c AnyValues? ValuesDots?))
. ->* . (or/c boolean? substitution/c))
(with-handlers ([exn:infer? (lambda _ #f)])
(let* ([expected-cset (if expected

View File

@ -41,7 +41,7 @@
;; range
(or/c #f Values/c ValuesDots?))
;; optional expected type
((or/c #f Values/c ValuesDots?))
((or/c #f Values/c AnyValues? ValuesDots?))
. ->* . any)]
[cond-contracted infer/vararg ((;; variables from the forall
(listof symbol?)
@ -56,7 +56,7 @@
;; range
(or/c #f Values/c ValuesDots?))
;; [optional] expected type
((or/c #f Values/c ValuesDots?)) . ->* . any)]
((or/c #f Values/c AnyValues? ValuesDots?)) . ->* . any)]
[cond-contracted infer/dots (((listof symbol?)
symbol?
(listof Values/c)
@ -64,4 +64,4 @@
Values/c
(or/c Values/c ValuesDots?)
(listof symbol?))
(#:expected (or/c #f Values/c ValuesDots?)) . ->* . any)]))
(#:expected (or/c #f Values/c AnyValues? ValuesDots?)) . ->* . any)]))

View File

@ -92,7 +92,7 @@
((syntax? syntax? Type/c (c:listof (c:listof Type/c)) (c:listof (c:or/c #f Type/c))
(c:listof (c:or/c #f (c:cons/c Type/c (c:or/c c:natural-number/c symbol?))))
(c:listof SomeValues/c) (c:listof tc-results?) (c:or/c #f Type/c) c:any/c)
(#:expected (c:or/c #f tc-results?) #:return tc-results?
(#:expected (c:or/c #f tc-results/c) #:return tc-results?
#:msg-thunk (c:-> string? string?))
. c:->* . tc-results/c)

View File

@ -67,7 +67,7 @@
;; if nothing matched, error
(domain-mismatches
f-stx args-stx t doms rests drests rngs argtys #f #f
#:expected expected #:return (or expected (ret (Un)))
#:expected expected #:return (if (tc-results? expected) expected (ret (Un)))
#:msg-thunk (lambda (dom)
(string-append
"No function domains matched in function application:\n"