suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Catch error before internal error, more informative internal error.

Browse Source 
svn: r11837

original commit: 88d44f9c5b37b17e43cac04d918eff5a34870334
This commit is contained in:
Sam Tobin-Hochstadt 2008-09-22 18:35:24 +00:00
parent dd61d2e865
commit d417ac6a55
2 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/typed-scheme/private/type-utils.ss
View File

@ -163,7 +163,8 @@
(match t
[(PolyDots: (list fixed ... dotted) body)
(unless (= (length fixed) (length types))
(int-err "instantiate-poly-dotted: wrong number of types: expected ~a, got ~a" (length fixed) (length types)))
(int-err "instantiate-poly-dotted: wrong number of types: expected ~a, got ~a, types were ~a"
(length fixed) (length types) types))
(let ([body* (subst-all (map list fixed types) body)])
(substitute-dotted image var dotted body*))]
[_ (int-err "instantiate-poly-dotted: requires PolyDots type, got ~a" t)]))

17
collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -74,13 +74,16 @@
[(cons last-ty-stx (? identifier? last-id-stx))
(unless (Dotted? (lookup (current-tvars) (syntax-e last-id-stx) (lambda _ #f)))
(tc-error/stx last-id-stx "~a is not a type variable bound with ..." (syntax-e last-id-stx)))
(let* ([last-id (syntax-e last-id-stx)]
[last-ty
(parameterize ([current-tvars (extend-env (list last-id)
(list (make-DottedBoth (make-F last-id)))
(current-tvars))])
(parse-type last-ty-stx))])
(instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id))]
(if (= (length all-but-last) (sub1 (PolyDots-n ty)))
(let* ([last-id (syntax-e last-id-stx)]
[last-ty
(parameterize ([current-tvars (extend-env (list last-id)
(list (make-DottedBoth (make-F last-id)))
(current-tvars))])
(parse-type last-ty-stx))])
(instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id))
(tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:~nexpected: ~a~ngot: ~a"
ty (sub1 (PolyDots-n ty)) (length all-but-last)))]
[_
(instantiate-poly ty (map parse-type (syntax->list inst)))]))]
[else