From 534e5e48aa92403ff595d33224b4d985e42d1731 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 11 Aug 2009 20:19:19 +0000 Subject: [PATCH] Move student expansion above or. Improve printing when no object. svn: r15704 original commit: 28be0897c32bf7d614c0a339c9a6d1271e709b57 --- collects/typed-scheme/typecheck/tc-expr-unit.ss | 9 +++++++-- collects/typed-scheme/typecheck/tc-metafunctions.ss | 4 ++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss index f4d867e1..b80d8fb3 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.ss +++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss @@ -127,6 +127,11 @@ (match (tc-expr/check e t) [(tc-result1: t) t])) +(define (print-object o) + (match o + [(Empty:) "no object"] + [_ (format "object ~a" o)])) + ;; check-below : (/\ (Results Type -> Result) ;; (Results Results -> Result) ;; (Type Results -> Type) @@ -157,7 +162,7 @@ [(not (subtype t1 t2)) (tc-error/expr "Expected ~a, but got ~a" t2 t1)] [(not (and (equal? f1 f2) (equal? o1 o2))) - (tc-error/expr "Expected result with filter ~a and object ~a, got filter ~a and object ~a" f2 o2 f1 o1)]) + (tc-error/expr "Expected result with filter ~a and ~a, got filter ~a and ~a" f2 (print-object o2) f1 (print-object o1))]) expected] [((tc-results: t1 f o dty dbound) (tc-results: t2 f o dty dbound)) (unless (andmap subtype t1 t2) @@ -179,7 +184,7 @@ t1] [((? Type? t1) (tc-result1: t2 f o)) (if (subtype t1 t2) - (tc-error/expr "Expected result with filter ~a and object ~a, got ~a" f 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)) t1] [((? Type? t1) (? Type? t2)) diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.ss b/collects/typed-scheme/typecheck/tc-metafunctions.ss index 10ec8de7..1ece7083 100644 --- a/collects/typed-scheme/typecheck/tc-metafunctions.ss +++ b/collects/typed-scheme/typecheck/tc-metafunctions.ss @@ -134,6 +134,8 @@ (match* (f1 f2 f3) [((T-FS:) f _) (ret t2 f o2)] [((F-FS:) _ f) (ret t3 f o3)] + ;; the student expansion + [(f (T-FS:) (F-FS:)) (mk f)] ;; skipping the general or/predicate rule because it's really complicated ;; or/predicate special case for one elem lists ;; note that we are relying on equal? on identifiers here @@ -153,8 +155,6 @@ (for/list ([f f2-]) (make-ImpFilter f1+ f)))))] [(f f* f*) (mk f*)] - ;; the student expansion - [(f (T-FS:) (F-FS:)) (mk f)] [(_ _ _) ;; could intersect f2 and f3 here (mk (make-FilterSet null null))]))