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:
parent
b214fa01c1
commit
18d4eb5135
|
@ -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)]
|
||||
|
|
Loading…
Reference in New Issue
Block a user