Make domain-mismatches have a more sensible default value.

original commit: 4e51b1d737004bd6d7b21c8d5f1b9d251174cb89
This commit is contained in:
Eric Dobson 2014-03-27 09:10:27 -07:00
parent 860f0933df
commit 5dfa1681ae
4 changed files with 2 additions and 8 deletions

View File

@ -109,7 +109,7 @@
#:msg-thunk (-> string? string?))
. ->* . tc-results/c)])
(define (domain-mismatches f-stx args-stx ty doms rests drests rngs arg-tys tail-ty tail-bound
#:expected [expected #f] #:return [return -Bottom]
#:expected [expected #f] #:return [return (ret -Bottom)]
#:msg-thunk [msg-thunk (lambda (dom) dom)])
(define arguments-str
(stringify-domain arg-tys
@ -354,7 +354,6 @@
"\n"))
(domain-mismatches f-stx args-stx t msg-doms msg-rests msg-drests
msg-rngs argtypes #f #f #:expected expected
#:return (ret (Un))
#:msg-thunk (lambda (dom)
(string-append
"Polymorphic " fcn-string " could not be applied to arguments:\n"
@ -377,7 +376,6 @@
"\n"))
(domain-mismatches f-stx args-stx t msg-doms msg-rests msg-drests
msg-rngs argtypes #f #f #:expected expected
#:return (ret (Un))
#:msg-thunk (lambda (dom)
(string-append
"Polymorphic " fcn-string " could not be applied to arguments:\n"

View File

@ -110,7 +110,6 @@
arities doms rests drests rngs
(stx-map tc-expr pos-args)
#f #f #:expected expected
#:return (ret (Un))
#:msg-thunk
(lambda (dom)
(string-append "No function domains matched in function application:\n"

View File

@ -47,7 +47,6 @@
;; we've run out of cases to try, so error out
[(null? doms*)
(domain-mismatches f args t doms rests drests rngs arg-tres tail-ty #f
#:return (ret (Un))
#:msg-thunk (lambda (dom)
(string-append
"Bad arguments to function in apply:\n"
@ -89,7 +88,6 @@
(match f-ty
[(tc-result1: (and t (Poly-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1)))))
(domain-mismatches f args t doms rests drests rngs arg-tres tail-ty tail-bound
#:return (ret (Un))
#:msg-thunk (lambda (dom)
(string-append
"Bad arguments to polymorphic function in apply:\n"
@ -152,7 +150,6 @@
(match f-ty
[(tc-result1: (and t (PolyDots-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1)))))
(domain-mismatches f args t doms rests drests rngs arg-tres tail-ty tail-bound
#:return (ret (Un))
#:msg-thunk (lambda (dom)
(string-append
"Bad arguments to polymorphic function in apply:\n"

View File

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