Make TR's ignore-some property work even if there isn't an internal form.
This commit is contained in:
parent
9e5060ef5b
commit
bb67e37c49
|
@ -100,7 +100,7 @@
|
||||||
expected)
|
expected)
|
||||||
|
|
||||||
;; typecheck the expansion of a with-handlers form
|
;; typecheck the expansion of a with-handlers form
|
||||||
;; syntax -> any
|
;; syntax -> void
|
||||||
(define (check-subforms/ignore form)
|
(define (check-subforms/ignore form)
|
||||||
(let loop ([form form])
|
(let loop ([form form])
|
||||||
(kernel-syntax-case* form #f ()
|
(kernel-syntax-case* form #f ()
|
||||||
|
@ -108,7 +108,7 @@
|
||||||
;; if this needs to be checked
|
;; if this needs to be checked
|
||||||
(syntax-property form 'typechecker:with-type)
|
(syntax-property form 'typechecker:with-type)
|
||||||
;; the form should be already ascribed the relevant type
|
;; the form should be already ascribed the relevant type
|
||||||
(tc-expr form)]
|
(void (tc-expr form))]
|
||||||
[(a . b)
|
[(a . b)
|
||||||
(loop #'a)
|
(loop #'a)
|
||||||
(loop #'b)]
|
(loop #'b)]
|
||||||
|
|
|
@ -286,10 +286,9 @@
|
||||||
(check-subforms/with-handlers/check form expected)]
|
(check-subforms/with-handlers/check form expected)]
|
||||||
[stx
|
[stx
|
||||||
#:when (syntax-property form 'typechecker:ignore-some)
|
#:when (syntax-property form 'typechecker:ignore-some)
|
||||||
(let ([ty (check-subforms/ignore form)])
|
(check-subforms/ignore form)
|
||||||
(unless ty
|
;; We trust ignore to be only on syntax objects objects that are well typed
|
||||||
(int-err "internal error: ignore-some"))
|
expected]
|
||||||
(check-below ty expected))]
|
|
||||||
;; explicit failure
|
;; explicit failure
|
||||||
[(quote-syntax ((~literal typecheck-fail-internal) stx msg:str var))
|
[(quote-syntax ((~literal typecheck-fail-internal) stx msg:str var))
|
||||||
(explicit-fail #'stx #'msg #'var)]
|
(explicit-fail #'stx #'msg #'var)]
|
||||||
|
@ -397,10 +396,8 @@
|
||||||
ty)]
|
ty)]
|
||||||
[stx
|
[stx
|
||||||
#:when (syntax-property form 'typechecker:ignore-some)
|
#:when (syntax-property form 'typechecker:ignore-some)
|
||||||
(let ([ty (check-subforms/ignore form)])
|
(check-subforms/ignore form)
|
||||||
(unless ty
|
Univ]
|
||||||
(int-err "internal error: ignore-some"))
|
|
||||||
ty)]
|
|
||||||
;; explicit failure
|
;; explicit failure
|
||||||
[(quote-syntax ((~literal typecheck-fail-internal) stx msg var))
|
[(quote-syntax ((~literal typecheck-fail-internal) stx msg var))
|
||||||
(explicit-fail #'stx #'msg #'var)]
|
(explicit-fail #'stx #'msg #'var)]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user