Move student expansion above or.
Improve printing when no object. svn: r15704 original commit: 28be0897c32bf7d614c0a339c9a6d1271e709b57
This commit is contained in:
parent
4a448aa21d
commit
534e5e48aa
|
@ -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))
|
||||
|
|
|
@ -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))]))
|
||||
|
|
Loading…
Reference in New Issue
Block a user