Abstract out "Expected foo, but got bar" errors

Use the new helper function to report errors more
helpfully when two identically named type variables
from different scopes are encountered.
This commit is contained in:
Asumu Takikawa 2013-10-16 14:37:40 -04:00
parent b214fa01c1
commit 18d4eb5135

View File

@ -22,6 +22,24 @@
(define (cond-check-below tr1 expected)
(if expected (check-below tr1 expected) tr1))
;; expected-but-got : (U Type String) (U Type String) -> Void
;;
;; Helper to print messages of the form
;; "Expected a, but got b"
;;
;; Also handles cases like two type variables that
;; have the same name.
(define (expected-but-got t1 t2)
(match* (t1 t2)
[((F: s1) (F: s2))
(=> fail)
(unless (string=? (symbol->string s1) (symbol->string s2))
(fail))
(tc-error/expr "Expected ~a, but got a different ~a (bound in another scope)"
t1 t2)]
[(_ _)
(tc-error/expr "Expected ~a, but got ~a" t1 t2)]))
;; check-below : (/\ (Results Type -> Result)
;; (Results Results -> Result)
;; (Type Results -> Type)
@ -51,19 +69,19 @@
(unless (= (length ts) (length ts2))
(tc-error/expr "Expected ~a values, but got ~a" (length ts2) (length ts)))
(unless (for/and ([t (in-list ts)] [s (in-list ts2)]) (subtype t s))
(tc-error/expr "Expected ~a, but got ~a" (stringify ts2) (stringify ts)))
(expected-but-got (stringify ts2) (stringify ts)))
(if (= (length ts) (length ts2))
(ret ts2 fs os)
(ret ts2))]
[((tc-result1: t1 f1 o1) (tc-result1: t2 (FilterSet: (Top:) (Top:)) (Empty:)))
(cond
[(not (subtype t1 t2))
(tc-error/expr "Expected ~a, but got ~a" t2 t1)])
(expected-but-got t2 t1)])
expected]
[((tc-result1: t1 f1 o1) (tc-result1: t2 f2 o2))
(cond
[(not (subtype t1 t2))
(tc-error/expr "Expected ~a, but got ~a" t2 t1)]
(expected-but-got t2 t1)]
[(and (not (filter-better? f1 f2))
(object-better? o1 o2))
(tc-error/expr "Expected result with filter ~a, got filter ~a" f2 f1)]
@ -80,7 +98,7 @@
(tc-error/expr "Expected ~a values and ~a ..., but got ~a values"
(length t2) dty (length t1)))
(unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
(tc-error/expr "Expected ~a, but got ~a" (stringify t2) (stringify t1)))
(expected-but-got (stringify t2) (stringify t1)))
expected]
;; case where you have (Values a ... a) but expected something else
[((tc-results: t1 f o dty dbound) (tc-results: t2 f o))
@ -88,13 +106,13 @@
(tc-error/expr "Expected ~a values, but got ~a values and ~a ..."
(length t2) (length t1) dty))
(unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
(tc-error/expr "Expected ~a, but got ~a" (stringify t2) (stringify t1)))
(expected-but-got (stringify t2) (stringify t1)))
expected]
[((tc-results: t1 f o dty1 dbound) (tc-results: t2 f o dty2 dbound))
(unless (= (length t1) (length t2))
(tc-error/expr "Expected ~a non dotted values, but got ~a" (length t2) (length t1)))
(unless (andmap subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" (stringify t2) (stringify t1)))
(expected-but-got (stringify t2) (stringify t1)))
(unless (subtype dty1 dty2)
(tc-error/expr "Expected ~a in ..., but got ~a" dty2 dty1))
expected]
@ -102,7 +120,7 @@
(unless (= (length t1) (length t2))
(tc-error/expr "Expected ~a values, but got ~a" (length t2) (length t1)))
(unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
(tc-error/expr "Expected ~a, but got ~a" (stringify t2) (stringify t1)))
(expected-but-got (stringify t2) (stringify t1)))
expected]
[((tc-any-results:) (or (? Type/c? t) (tc-result1: t _ _)))
(tc-error/expr "Expected 1 value, but got unknown number")
@ -113,26 +131,26 @@
[((tc-result1: t1 f o) (? Type/c? t2))
(unless (subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(expected-but-got t2 t1))
(ret t2 f o)]
[((? Type/c? t1) (tc-any-results:)) t1]
[((? Type/c? t1) (tc-result1: t2 (FilterSet: (list) (list)) (Empty:)))
(unless (subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(expected-but-got t2 t1))
t1]
[((? Type/c? t1) (tc-result1: t2 f o))
(if (subtype t1 t2)
(tc-error/expr "Expected result with filter ~a and ~a, got ~a" f (print-object o) t1)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(expected-but-got t2 t1))
t1]
[((? Type/c? t1) (tc-results: ts2 fs os))
(tc-error/expr "Expected one value, but got ~a" (length ts2))
t1]
[((? Type/c? t1) (? Type/c? t2))
(unless (subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(expected-but-got t2 t1))
expected]
[((tc-results: ts fs os dty dbound) (tc-results: ts* fs* os* dty* dbound*))
(int-err "dotted types with different bounds/filters/objects in check-below nyi: ~a ~a" tr1 expected)]