Move student expansion above or.

Improve printing when no object.

svn: r15704

original commit: 28be0897c32bf7d614c0a339c9a6d1271e709b57
This commit is contained in:
Sam Tobin-Hochstadt 2009-08-11 20:19:19 +00:00
parent 4a448aa21d
commit 534e5e48aa
2 changed files with 9 additions and 4 deletions

View File

@ -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))

View File

@ -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))]))