Improved error messages given by typed/racket, by always including the type name and arguments in the error message.

When a typing error is located inside macro-expanded code, a message such as “wrong number of arguments to polymorphic type: expected 1 and got 2” does not help much in locating which instantiation is wrong.
This commit is contained in:
Georges Dupéron 2015-11-18 20:17:58 +01:00 committed by Sam Tobin-Hochstadt
parent 3a7e616f97
commit ce4a2b3d36
5 changed files with 30 additions and 11 deletions

View File

@ -7,7 +7,12 @@
[(_ nm ...)
#'(begin (define-syntax nm
(lambda (stx)
(raise-syntax-error 'type-check "type name used out of context"
(raise-syntax-error 'type-check
(format "type name ~a used out of context in ~a"
(syntax->datum (if (stx-pair? stx)
(stx-car stx)
stx))
(syntax->datum stx))
stx
(and (stx-pair? stx) (stx-car stx)))))
...
@ -26,4 +31,3 @@
[List Tuple]
[Rec mu]
[Parameterof Parameter]))

View File

@ -52,7 +52,11 @@
;; lift out to utility module maybe
(define-syntax (type stx)
(raise-syntax-error 'type-check
"type name used out of context"
(format "type name ~a used out of context in ~a"
(syntax->datum (if (stx-pair? stx)
(stx-car stx)
stx))
(syntax->datum stx))
stx
(and (stx-pair? stx) (stx-car stx))))
(provide type pred))))

View File

@ -197,7 +197,9 @@
#'(lambda (stx)
(raise-syntax-error
'type-check
"type name used out of context"
(format "type name ~a used out of context in ~a"
(syntax->datum (if (stx-pair? stx) (stx-car stx) stx))
(syntax->datum stx))
stx
(and (stx-pair? stx) (stx-car stx)))))
#`(begin

View File

@ -9,7 +9,10 @@
(begin
(define-syntax (nm stx)
(raise-syntax-error
'type-check "type name used out of context"
'type-check
(format "type name ~a used out of context in ~a"
(syntax->datum (if (stx-pair? stx) (stx-car stx) stx))
(syntax->datum stx))
stx
(and (stx-pair? stx) (stx-car stx))))
...

View File

@ -43,8 +43,10 @@
(match rator
[(Poly-unsafe: n _)
(unless (= n (length rands))
(tc-error "wrong number of arguments to polymorphic type: expected ~a and got ~a"
n (length rands)))]
(tc-error (~a "wrong number of arguments to polymorphic type " rator
": expected " n
" and got " (length rands)
", arguments were: " rands)))]
[(Name/struct: n)
(when (and (current-poly-struct)
(free-identifier=? n (poly-name (current-poly-struct))))
@ -61,7 +63,8 @@
" structure type constructor " rator
" does not match the given number:"
" expected " num-poly
", given " num-rands))))]
", given " num-rands
", arguments were: " rands))))]
[(Name: name-id num-args #f)
(cond [(> num-args 0)
(define num-rands (length rands))
@ -69,7 +72,8 @@
(tc-error (~a "The expected number of arguments for "
rator " does not match the given number:"
" expected " num-args
", given " num-rands)))
", given " num-rands
", arguments were: " rands)))
;; Does not allow polymorphic recursion since both type
;; inference and equirecursive subtyping for polymorphic
;; recursion are difficult.
@ -98,7 +102,8 @@
(not (member (syntax-e arg-name) (fv given-type)))))
(unless ok?
(tc-error (~a "Recursive type " rator " cannot be applied at"
" a different type in its recursive invocation"))))
" a different type in its recursive invocation,"
" new arguments were: " rands))))
(match (current-check-polymorphic-recursion)
[`#s(poly-rec-info ,same-component? ,current-vars)
#:when (same-component? name-id)
@ -125,7 +130,8 @@
[(Poly: _ _) (instantiate-poly rator rands)]
[(Mu: _ _) (resolve-app (unfold rator) rands stx)]
[(App: r r* s) (resolve-app (resolve-app r r* s) rands stx)]
[_ (tc-error "cannot apply a non-polymorphic type: ~a" rator)])))
[_ (tc-error (~a "cannot apply a non-polymorphic type: " rator
" with arguments: " rands))])))
(define (needs-resolving? t)