Change ascription to annotate the #%expression.

Also remove the now useless type-annotation tests.

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
-    (quasisyntax/loc expr-stx
+    (#,(type-ascription-property #'#%expression ty-stx)
-      (#%expression #,expr-stx))
+     #,expr-stx)))
-    ty-stx))
 
 
 (define-syntax (inst stx)

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

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*)
+      (cond [(external-check-property 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*)
              =>
              (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
+    (let ([ty (internal-tc-expr form)])
-      [(type-ascription form) => (lambda (ann) (tc-expr/check form ann))]
+      (add-typeof-expr form ty)
-      [else 
+      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)))

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"

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-annotation-test.rkt

@@ -1,36 +0,0 @@
-#lang racket/base
-(require "test-utils.rkt"
-         "evaluator.rkt"
-         (for-syntax
-           racket/base
-           racket/list
-           (rep type-rep filter-rep object-rep)
-           (private type-annotation)
-           (types abbrev numeric-tower tc-result))
-         (only-in typed-racket/typed-racket do-standard-inits)
-         (base-env prims base-types base-types-extra colon)
-         rackunit)
-
-(provide tests)
-(gen-test-main)
-
-(begin-for-syntax
-  (do-standard-inits))
-
-
-(define-syntax-rule (tat ann-stx ty)
-  (test-case (format "~a" (quote ann-stx))
-    (unless
-      (phase1-phase0-eval
-        (define stx (local-expand (quote-syntax ann-stx) 'expression empty))
-        (define ascrip (type-ascription stx))
-        #`#,(equal? ascrip ty))
-      (fail-check "Unequal types"))))
-
-(define tests
-  (test-suite
-   "Type Annotation tests"
-   ;; FIXME - ask Ryan
-   (tat (ann foo : Number) (ret -Number -no-filter -no-obj))
-   (tat foo #f)
-   (tat (ann foo : 3) (ret (-val 3) -no-filter -no-obj))))