Don't treat Error types as potentially non-regular. (Reported by SK)

original commit: 431ff8d794425e12577c662be7827a38531ad39f
This commit is contained in:
Sam Tobin-Hochstadt 2010-08-02 13:26:54 -04:00
parent d19a3ff923
commit 1f05ee70e2
3 changed files with 11 additions and 2 deletions

View File

@ -0,0 +1,7 @@
#;
(exn-pred 2)
#lang typed/racket
(define-struct: (T) Node ([v : T] [l : (BinTreeof t)] [r : (BinTreeof t)]))
(define-type (BinTreeof t) (U 'empty [Node t]))

View File

@ -311,7 +311,8 @@
[(Name: n)
(when (and (current-poly-struct)
(free-identifier=? n (poly-name (current-poly-struct)))
(not (andmap type-equal? args (poly-vars (current-poly-struct)))))
(not (or (ormap Error? args)
(andmap type-equal? args (poly-vars (current-poly-struct))))))
(tc-error "Structure type constructor ~a applied to non-regular arguments ~a" rator args))
(make-App rator args stx)]
[(Poly: ns _)

View File

@ -34,7 +34,8 @@
[(Name: n)
(when (and (current-poly-struct)
(free-identifier=? n (poly-name (current-poly-struct)))
(not (andmap type-equal? rands (poly-vars (current-poly-struct)))))
(not (or (ormap Error? rands)
(andmap type-equal? rands (poly-vars (current-poly-struct))))))
(tc-error "Structure type constructor ~a applied to non-regular arguments ~a" rator rands))
(let ([r (resolve-name rator)])
(and r (resolve-app r rands stx)))]