Don't treat Error types as potentially non-regular. (Reported by SK)
original commit: 431ff8d794425e12577c662be7827a38531ad39f
This commit is contained in:
parent
d19a3ff923
commit
1f05ee70e2
7
collects/tests/typed-scheme/fail/unbound-non-reg.rkt
Normal file
7
collects/tests/typed-scheme/fail/unbound-non-reg.rkt
Normal 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]))
|
|
@ -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 _)
|
||||
|
|
|
@ -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)))]
|
||||
|
|
Loading…
Reference in New Issue
Block a user