From 6d841adb9ac822e6decd80ea00056a5724edc2bb Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Mon, 27 May 2013 13:43:54 -0700
Subject: [PATCH] Make external check be on an #%expression.

---
 .../typed-racket/base-env/prims.rkt           |  6 ++++--
 .../typed-racket/typecheck/tc-expr-unit.rkt   | 21 +++++++------------
 2 files changed, 11 insertions(+), 16 deletions(-)

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 cc4b584762..82601a9e5e 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
@@ -309,7 +309,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
                type)))
 
          #`(ann
-             #,(external-check-property (ignore-some name) check-valid-type)
+             (#,(external-check-property #'#%expression check-valid-type)
+              #,(ignore-some name))
              (Any -> Boolean : ty)))
        (let ([typ (parse-type #'ty)])
          (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
                    "Type ~a could not be converted to a contract because it contains free variables."
                    type)))
-              (external-check-property (apply-contract ctc) check-valid-type))]
+              #`(#,(external-check-property #'#%expression check-valid-type)
+                 #,(apply-contract ctc)))]
            [else
             (let ([typ (parse-type #'ty)])
               (if (Error? typ)
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 78e21bf734..13624cb069 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
@@ -152,20 +152,9 @@
     (unless (syntax? form)
       (int-err "bad form input to tc-expr: ~a" form))
     ;; typecheck form
-    (let loop ([form* form] [expected expected] [checked? #f])
-      (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)
-             (check-below t expected)]))))
+    (define t (tc-expr/check/internal form expected))
+    (add-typeof-expr form t)
+    (check-below t expected)))
 
 (define (explicit-fail stx msg var)
   (cond [(and (identifier? var) (lookup-type/lexical var #:fail (λ _ #f)))
@@ -262,6 +251,10 @@
       [((~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)))]
+      [((~and exp #%expression) e)
+       #:when (external-check-property #'exp)
+       ((external-check-property #'exp) #'e)
+       (tc-expr/check #'e expected)]
       [(#%expression e)
        (tc-expr/check #'e expected)]
       ;; syntax