diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt index 57c2810e..cc4b5847 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt @@ -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) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt index 76df1fcc..21b5bd07 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt @@ -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 diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt index 6b0aeb3e..78e21bf7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt @@ -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))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt index 086457c9..141591fa 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt @@ -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"