Change ascription to annotate the #%expression.

Also remove the now useless type-annotation tests.

original commit: 6cd79b6b7e57d54a43140e544ac0bcb6aedd2433
This commit is contained in:
Eric Dobson 2013-05-27 13:22:48 -07:00
parent e80df03958
commit 2efc8a92bf
4 changed files with 16 additions and 40 deletions

View File

@ -418,10 +418,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
(add-ann #'arg #'ty)]))
(define-for-syntax (add-ann expr-stx ty-stx)
(type-ascription-property
(quasisyntax/loc expr-stx
(#%expression #,expr-stx))
ty-stx))
(quasisyntax/loc expr-stx
(#,(type-ascription-property #'#%expression ty-stx)
#,expr-stx)))
(define-syntax (inst stx)

View File

@ -15,8 +15,6 @@
get-type
get-types
get-type/infer
type-ascription
remove-ascription
check-type
dotted?)
@ -50,19 +48,6 @@
#:attr type (type-annotation #'i)
#:when (attribute type)])
(define (type-ascription stx)
(syntax-parse stx
[s:type-ascription^
(define prop (attribute s.value))
(unless (syntax? prop)
(int-err "Type ascription is bad: ~a" prop))
(add-scoped-tvars stx (parse-literal-alls prop))
(parse-tc-results prop)]
[_ #f]))
(define (remove-ascription stx)
(type-ascription-property stx #f))
;; get the type annotation of this identifier, otherwise error
;; if #:default is provided, return that instead of error
;; identifier #:default Type -> Type

View File

@ -9,7 +9,7 @@
(private-in parse-type type-annotation syntax-properties)
(rep type-rep filter-rep object-rep)
(utils tc-utils)
(env lexical-env tvar-env index-env)
(env lexical-env tvar-env index-env scoped-tvar-env)
racket/format racket/list
racket/private/class-internal
syntax/parse syntax/stx
@ -153,17 +153,7 @@
(int-err "bad form input to tc-expr: ~a" form))
;; typecheck form
(let loop ([form* form] [expected expected] [checked? #f])
(cond [(type-ascription form*)
=>
(lambda (ann)
(let* ([r (tc-expr/check/internal form* ann)]
[r* (check-below (check-below r ann) expected)])
;; add this to the *original* form, since the newer forms aren't really in the program
(add-typeof-expr form r)
;; around again in case there is an instantiation
;; remove the ascription so we don't loop infinitely
(loop (remove-ascription form*) r* #t)))]
[(external-check-property form*)
(cond [(external-check-property form*)
=>
(lambda (check)
(check form*)
@ -269,6 +259,9 @@
[((~and exp #%expression) e)
#:when (type-inst-property #'exp)
(do-inst (tc-expr #'e) (type-inst-property #'exp))]
[((~and exp:type-ascription^ #%expression) e)
(add-scoped-tvars #'e (parse-literal-alls (attribute exp.value)))
(tc-expr/check #'e (parse-tc-results (attribute exp.value)))]
[(#%expression e)
(tc-expr/check #'e expected)]
;; syntax
@ -306,7 +299,7 @@
(tc-expr/check/type #'fun (kw-convert f #:split #t))
expected]
[(or (tc-results: _) (tc-any-results:))
(tc-expr (remove-ascription form))])]
(tc-expr form)])]
;; opt function def
[(~and (let-values ([(f) fun]) . body) opt:opt-lambda^)
(define conv-type
@ -318,7 +311,7 @@
[_ #f]))
(if conv-type
(begin (tc-expr/check/type #'fun conv-type) expected)
(tc-expr (remove-ascription form)))]
(tc-expr form))]
;; let
[(let-values ([(name ...) expr] ...) . body)
(tc/let-values #'((name ...) ...) #'(expr ...) #'body expected)]
@ -437,6 +430,9 @@
[((~and exp #%expression) e)
#:when (type-inst-property #'exp)
(do-inst (tc-expr #'e) (type-inst-property #'exp))]
[((~and exp:type-ascription^ #%expression) e)
(add-scoped-tvars #'e (parse-literal-alls (attribute exp.value)))
(tc-expr/check #'e (parse-tc-results (attribute exp.value)))]
[(#%expression e) (tc-expr #'e)]
;; #%variable-reference
[(#%variable-reference . _)
@ -470,12 +466,9 @@
(unless (syntax? form)
(int-err "bad form input to tc-expr: ~a" form))
;; typecheck form
(cond
[(type-ascription form) => (lambda (ann) (tc-expr/check form ann))]
[else
(let ([ty (internal-tc-expr form)])
(add-typeof-expr form ty)
ty)])))
(let ([ty (internal-tc-expr form)])
(add-typeof-expr form ty)
ty)))
(define (single-value form [expected #f])
(define t (if expected (tc-expr/check form expected) (tc-expr form)))

View File

@ -28,7 +28,6 @@
"parse-type-tests.rkt"
"subst-tests.rkt"
"infer-tests.rkt"
"type-annotation-test.rkt"
"keyword-expansion-test.rkt"
"special-env-typecheck-tests.rkt"
"contract-tests.rkt"