Make domain-mismatches have a more sensible default value.
original commit: 4e51b1d737004bd6d7b21c8d5f1b9d251174cb89
This commit is contained in:
parent
860f0933df
commit
5dfa1681ae
|
@ -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"
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Reference in New Issue
Block a user