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)
|
(define (cond-check-below tr1 expected)
|
||||||
(if expected (check-below tr1 expected) tr1))
|
(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)
|
;; check-below : (/\ (Results Type -> Result)
|
||||||
;; (Results Results -> Result)
|
;; (Results Results -> Result)
|
||||||
;; (Type Results -> Type)
|
;; (Type Results -> Type)
|
||||||
|
@ -51,19 +69,19 @@
|
||||||
(unless (= (length ts) (length ts2))
|
(unless (= (length ts) (length ts2))
|
||||||
(tc-error/expr "Expected ~a values, but got ~a" (length ts2) (length ts)))
|
(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))
|
(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))
|
(if (= (length ts) (length ts2))
|
||||||
(ret ts2 fs os)
|
(ret ts2 fs os)
|
||||||
(ret ts2))]
|
(ret ts2))]
|
||||||
[((tc-result1: t1 f1 o1) (tc-result1: t2 (FilterSet: (Top:) (Top:)) (Empty:)))
|
[((tc-result1: t1 f1 o1) (tc-result1: t2 (FilterSet: (Top:) (Top:)) (Empty:)))
|
||||||
(cond
|
(cond
|
||||||
[(not (subtype t1 t2))
|
[(not (subtype t1 t2))
|
||||||
(tc-error/expr "Expected ~a, but got ~a" t2 t1)])
|
(expected-but-got t2 t1)])
|
||||||
expected]
|
expected]
|
||||||
[((tc-result1: t1 f1 o1) (tc-result1: t2 f2 o2))
|
[((tc-result1: t1 f1 o1) (tc-result1: t2 f2 o2))
|
||||||
(cond
|
(cond
|
||||||
[(not (subtype t1 t2))
|
[(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))
|
[(and (not (filter-better? f1 f2))
|
||||||
(object-better? o1 o2))
|
(object-better? o1 o2))
|
||||||
(tc-error/expr "Expected result with filter ~a, got filter ~a" f2 f1)]
|
(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"
|
(tc-error/expr "Expected ~a values and ~a ..., but got ~a values"
|
||||||
(length t2) dty (length t1)))
|
(length t2) dty (length t1)))
|
||||||
(unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
|
(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]
|
expected]
|
||||||
;; case where you have (Values a ... a) but expected something else
|
;; case where you have (Values a ... a) but expected something else
|
||||||
[((tc-results: t1 f o dty dbound) (tc-results: t2 f o))
|
[((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 ..."
|
(tc-error/expr "Expected ~a values, but got ~a values and ~a ..."
|
||||||
(length t2) (length t1) dty))
|
(length t2) (length t1) dty))
|
||||||
(unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
|
(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]
|
expected]
|
||||||
[((tc-results: t1 f o dty1 dbound) (tc-results: t2 f o dty2 dbound))
|
[((tc-results: t1 f o dty1 dbound) (tc-results: t2 f o dty2 dbound))
|
||||||
(unless (= (length t1) (length t2))
|
(unless (= (length t1) (length t2))
|
||||||
(tc-error/expr "Expected ~a non dotted values, but got ~a" (length t2) (length t1)))
|
(tc-error/expr "Expected ~a non dotted values, but got ~a" (length t2) (length t1)))
|
||||||
(unless (andmap subtype t1 t2)
|
(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)
|
(unless (subtype dty1 dty2)
|
||||||
(tc-error/expr "Expected ~a in ..., but got ~a" dty2 dty1))
|
(tc-error/expr "Expected ~a in ..., but got ~a" dty2 dty1))
|
||||||
expected]
|
expected]
|
||||||
|
@ -102,7 +120,7 @@
|
||||||
(unless (= (length t1) (length t2))
|
(unless (= (length t1) (length t2))
|
||||||
(tc-error/expr "Expected ~a values, but got ~a" (length t2) (length t1)))
|
(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))
|
(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]
|
expected]
|
||||||
[((tc-any-results:) (or (? Type/c? t) (tc-result1: t _ _)))
|
[((tc-any-results:) (or (? Type/c? t) (tc-result1: t _ _)))
|
||||||
(tc-error/expr "Expected 1 value, but got unknown number")
|
(tc-error/expr "Expected 1 value, but got unknown number")
|
||||||
|
@ -113,26 +131,26 @@
|
||||||
|
|
||||||
[((tc-result1: t1 f o) (? Type/c? t2))
|
[((tc-result1: t1 f o) (? Type/c? t2))
|
||||||
(unless (subtype t1 t2)
|
(unless (subtype t1 t2)
|
||||||
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
|
(expected-but-got t2 t1))
|
||||||
(ret t2 f o)]
|
(ret t2 f o)]
|
||||||
|
|
||||||
|
|
||||||
[((? Type/c? t1) (tc-any-results:)) t1]
|
[((? Type/c? t1) (tc-any-results:)) t1]
|
||||||
[((? Type/c? t1) (tc-result1: t2 (FilterSet: (list) (list)) (Empty:)))
|
[((? Type/c? t1) (tc-result1: t2 (FilterSet: (list) (list)) (Empty:)))
|
||||||
(unless (subtype t1 t2)
|
(unless (subtype t1 t2)
|
||||||
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
|
(expected-but-got t2 t1))
|
||||||
t1]
|
t1]
|
||||||
[((? Type/c? t1) (tc-result1: t2 f o))
|
[((? Type/c? t1) (tc-result1: t2 f o))
|
||||||
(if (subtype t1 t2)
|
(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 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]
|
t1]
|
||||||
[((? Type/c? t1) (tc-results: ts2 fs os))
|
[((? Type/c? t1) (tc-results: ts2 fs os))
|
||||||
(tc-error/expr "Expected one value, but got ~a" (length ts2))
|
(tc-error/expr "Expected one value, but got ~a" (length ts2))
|
||||||
t1]
|
t1]
|
||||||
[((? Type/c? t1) (? Type/c? t2))
|
[((? Type/c? t1) (? Type/c? t2))
|
||||||
(unless (subtype t1 t2)
|
(unless (subtype t1 t2)
|
||||||
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
|
(expected-but-got t2 t1))
|
||||||
expected]
|
expected]
|
||||||
[((tc-results: ts fs os dty dbound) (tc-results: ts* fs* os* dty* dbound*))
|
[((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)]
|
(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