Fail gracefully on TR struct arity errors
Closes PR 13209
This commit is contained in:
parent
7a190a41b4
commit
b4dd3b5e1d
|
@ -6,7 +6,8 @@
|
||||||
(utils tc-utils)
|
(utils tc-utils)
|
||||||
(types utils)
|
(types utils)
|
||||||
racket/match
|
racket/match
|
||||||
racket/contract)
|
racket/contract
|
||||||
|
racket/format)
|
||||||
|
|
||||||
(provide resolve-name resolve-app needs-resolving?
|
(provide resolve-name resolve-app needs-resolving?
|
||||||
resolve resolve-app-check-error)
|
resolve resolve-app-check-error)
|
||||||
|
@ -32,10 +33,21 @@
|
||||||
n (length rands)))]
|
n (length rands)))]
|
||||||
[(Name: n)
|
[(Name: n)
|
||||||
(when (and (current-poly-struct)
|
(when (and (current-poly-struct)
|
||||||
(free-identifier=? n (poly-name (current-poly-struct)))
|
(free-identifier=? n (poly-name (current-poly-struct))))
|
||||||
(not (or (ormap Error? rands)
|
(define num-rands (length rands))
|
||||||
(andmap type-equal? rands (poly-vars (current-poly-struct))))))
|
(define num-poly (length (poly-vars (current-poly-struct))))
|
||||||
(tc-error "Structure type constructor ~a applied to non-regular arguments ~a" rator rands))]
|
;; check arity of constructor first
|
||||||
|
(if (= num-rands num-poly)
|
||||||
|
(when (not (or (ormap Error? rands)
|
||||||
|
(andmap type-equal? rands
|
||||||
|
(poly-vars (current-poly-struct)))))
|
||||||
|
(tc-error (~a "Structure type constructor " rator
|
||||||
|
" applied to non-regular arguments " rands)))
|
||||||
|
(tc-error (~a "The expected number of arguments for"
|
||||||
|
" structure type constructor " rator
|
||||||
|
" does not match the given number:"
|
||||||
|
" expected " num-poly
|
||||||
|
", given " num-rands))))]
|
||||||
[(Mu: _ _) (void)]
|
[(Mu: _ _) (void)]
|
||||||
[(App: _ _ _) (void)]
|
[(App: _ _ _) (void)]
|
||||||
[(Error:) (void)]
|
[(Error:) (void)]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user