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

Control multiple errors with a parameter.

Browse Source 
Don't use same code for handling type ascription and annotation.

svn: r9529

original commit: 1d21ec5ddab6264cf5df4a9f9793f4b40e77d120
This commit is contained in:
Sam Tobin-Hochstadt 2008-04-29 01:42:07 +00:00
parent 16fffb8706
commit 6afac96172
1 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/typed-scheme/private/type-annotation.ss
View File

@ -8,6 +8,7 @@
get-type/infer
type-label-symbol
type-ascrip-symbol
type-ascription
check-type)
(define type-label-symbol 'type-label)
@ -23,7 +24,7 @@
;; get the type annotation of this syntax
;; syntax -> Maybe[Type]
(define (type-annotation stx)
(define (type-annotation stx #:infer [let-binding #f])
(define (pt prop)
(print-size prop)
(if (syntax? prop)
@ -32,13 +33,24 @@
(cond
[(syntax-property stx type-label-symbol) => pt]
[(syntax-property stx type-ascrip-symbol) => pt]
[(and (identifier? stx) (lookup-type stx (lambda () #f)))
;; this is so that : annotation works in internal def ctxts
[(and let-binding (identifier? stx) (lookup-type stx (lambda () #f)))
=>
(lambda (t)
(maybe-finish-register-type stx)
t)]
[else #f]))
(define (type-ascription stx)
(define (pt prop)
(print-size prop)
(if (syntax? prop)
(parse-type prop)
(parse-type/id stx prop)))
(cond
[(syntax-property stx type-ascrip-symbol) => pt]
[else #f]))
(define (log/ann stx ty)
(printf/log "Required Annotated Variable: ~a ~a~n" (syntax-e stx) ty))
(define (log/extra stx ty ty2)
@ -72,10 +84,11 @@
[else (log/noann stx ty) ty]))
stx ty)]
[(list (list stx) ty)
(cond [(type-annotation stx) => (lambda (ann)
(check-type stx ty ann)
(log/extra stx ty ann)
(list ann))]
(cond [(type-annotation stx #:infer #t)
=> (lambda (ann)
(check-type stx ty ann)
(log/extra stx ty ann)
(list ann))]
[else (log/noann stx ty) (list ty)])]
[else (int-err "wrong type arity - get-type/infer ~a ~a" stxs e-type)]))