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

Make external check be on an #%expression.

Browse Source
This commit is contained in:
Eric Dobson 2013-05-27 13:43:54 -07:00
parent 6cd79b6b7e
commit 6d841adb9a
2 changed files with 11 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
View File

@ -309,7 +309,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
type))) type)))
#`(ann #`(ann
#,(external-check-property (ignore-some name) check-valid-type) (#,(external-check-property #'#%expression check-valid-type)
#,(ignore-some name))
(Any -> Boolean : ty))) (Any -> Boolean : ty)))
(let ([typ (parse-type #'ty)]) (let ([typ (parse-type #'ty)])
(if (Error? typ) (if (Error? typ)
@ -360,7 +361,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
(tc-error/delayed (tc-error/delayed
"Type ~a could not be converted to a contract because it contains free variables." "Type ~a could not be converted to a contract because it contains free variables."
type))) type)))
(external-check-property (apply-contract ctc) check-valid-type))] #`(#,(external-check-property #'#%expression check-valid-type)
#,(apply-contract ctc)))]
[else [else
(let ([typ (parse-type #'ty)]) (let ([typ (parse-type #'ty)])
(if (Error? typ) (if (Error? typ)

19
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -152,20 +152,9 @@
(unless (syntax? form) (unless (syntax? form)
(int-err "bad form input to tc-expr: ~a" form)) (int-err "bad form input to tc-expr: ~a" form))
;; typecheck form ;; typecheck form
(let loop ([form* form] [expected expected] [checked? #f]) (define t (tc-expr/check/internal form expected))
(cond [(external-check-property form*)
=>
(lambda (check)
(check form*)
(loop (external-check-property form* #f)
expected
checked?))]
;; nothing to see here
[checked? expected]
[else
(define t (tc-expr/check/internal form* expected))
(add-typeof-expr form t) (add-typeof-expr form t)
(check-below t expected)])))) (check-below t expected)))
(define (explicit-fail stx msg var) (define (explicit-fail stx msg var)
(cond [(and (identifier? var) (lookup-type/lexical var #:fail (λ _ #f))) (cond [(and (identifier? var) (lookup-type/lexical var #:fail (λ _ #f)))
@ -262,6 +251,10 @@
[((~and exp:type-ascription^ #%expression) e) [((~and exp:type-ascription^ #%expression) e)
(add-scoped-tvars #'e (parse-literal-alls (attribute exp.value))) (add-scoped-tvars #'e (parse-literal-alls (attribute exp.value)))
(tc-expr/check #'e (parse-tc-results (attribute exp.value)))] (tc-expr/check #'e (parse-tc-results (attribute exp.value)))]
[((~and exp #%expression) e)
#:when (external-check-property #'exp)
((external-check-property #'exp) #'e)
(tc-expr/check #'e expected)]
[(#%expression e) [(#%expression e)
(tc-expr/check #'e expected)] (tc-expr/check #'e expected)]
;; syntax ;; syntax