suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move student expansion above or.

Browse Source 
Improve printing when no object.

svn: r15704
This commit is contained in:
Sam Tobin-Hochstadt 2009-08-11 20:19:19 +00:00
parent 9649e10df8
commit 28be0897c3
2 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -127,6 +127,11 @@
(match (tc-expr/check e t) (match (tc-expr/check e t)
[(tc-result1: t) t])) [(tc-result1: t) t]))
(define (print-object o)
(match o
[(Empty:) "no object"]
[_ (format "object ~a" o)]))
;; check-below : (/\ (Results Type -> Result) ;; check-below : (/\ (Results Type -> Result)
;; (Results Results -> Result) ;; (Results Results -> Result)
;; (Type Results -> Type) ;; (Type Results -> Type)
@ -157,7 +162,7 @@
[(not (subtype t1 t2)) [(not (subtype t1 t2))
(tc-error/expr "Expected ~a, but got ~a" t2 t1)] (tc-error/expr "Expected ~a, but got ~a" t2 t1)]
[(not (and (equal? f1 f2) (equal? o1 o2))) [(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] expected]
[((tc-results: t1 f o dty dbound) (tc-results: t2 f o dty dbound)) [((tc-results: t1 f o dty dbound) (tc-results: t2 f o dty dbound))
(unless (andmap subtype t1 t2) (unless (andmap subtype t1 t2)
@ -179,7 +184,7 @@
t1] t1]
[((? Type? t1) (tc-result1: t2 f o)) [((? Type? t1) (tc-result1: t2 f o))
(if (subtype t1 t2) (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)) (tc-error/expr "Expected ~a, but got ~a" t2 t1))
t1] t1]
[((? Type? t1) (? Type? t2)) [((? Type? t1) (? Type? t2))

4
collects/typed-scheme/typecheck/tc-metafunctions.ss
View File

@ -134,6 +134,8 @@
(match* (f1 f2 f3) (match* (f1 f2 f3)
[((T-FS:) f _) (ret t2 f o2)] [((T-FS:) f _) (ret t2 f o2)]
[((F-FS:) _ f) (ret t3 f o3)] [((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 ;; skipping the general or/predicate rule because it's really complicated
;; or/predicate special case for one elem lists ;; or/predicate special case for one elem lists
;; note that we are relying on equal? on identifiers here ;; note that we are relying on equal? on identifiers here
@ -153,8 +155,6 @@
(for/list ([f f2-]) (for/list ([f f2-])
(make-ImpFilter f1+ f)))))] (make-ImpFilter f1+ f)))))]
[(f f* f*) (mk f*)] [(f f* f*) (mk f*)]
;; the student expansion
[(f (T-FS:) (F-FS:)) (mk f)]
[(_ _ _) [(_ _ _)
;; could intersect f2 and f3 here ;; could intersect f2 and f3 here
(mk (make-FilterSet null null))])) (mk (make-FilterSet null null))]))