From 61f436be0f9e6e6783bae3473e994ac8d196d53f Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 20 Sep 2013 17:30:07 -0400
Subject: [PATCH] Make : error on unbound identifiers

Closes PR 13298

original commit: f6d62b2813616b6efa56acc0695403d7a32e9386
---
 .../typed-racket/base-env/colon.rkt           | 72 +++++++++++--------
 .../typed-racket/fail/bad-struct-top.rkt      |  1 +
 .../unit-tests/typecheck-tests.rkt            |  4 ++
 3 files changed, 49 insertions(+), 28 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/colon.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/colon.rkt
index fed3f6f8..87e69101 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/colon.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/colon.rkt
@@ -1,40 +1,56 @@
 #lang racket/base
 
 (require (for-syntax racket/base syntax/parse unstable/sequence unstable/syntax
-                     "internal.rkt" "../utils/disappeared-use.rkt")
+                     "../utils/disappeared-use.rkt")
          "../typecheck/internal-forms.rkt"
          (prefix-in t: "base-types-extra.rkt"))
 
 (provide :)
 
+(begin-for-syntax
+ (define (err stx str . sub)
+   (apply raise-syntax-error '|type declaration| str stx sub))
+
+ ;; Wrap the `:-expr` with a `define-values`. This is like
+ ;; what `internal` does, but the work is spread out among two
+ ;; macros to delay the unbound identifier check.
+ (define (wrap stx :-expr)
+   (quasisyntax/loc stx (define-values () #,:-expr))))
+
 (define-syntax (: stx)
-  (define stx*
-    ;; make it possible to add another colon after the id for clarity
-    ;; and in that case, a `->' on the RHS does not need to be
-    ;; explicitly parenthesized
-    (syntax-parse stx #:literals (: t:->)
-      [(: id (~and kw :) x ...)
-       #:fail-unless (for/first ([i (in-syntax #'(x ...))]
-                                 #:when (identifier? i)
-                                 #:when (free-identifier=? i #'t:->))
-                       i) 
-       #f
-       (add-disappeared-use #'kw)
-       (syntax/loc stx (: id (x ...)))]
-      [(: id : . more)
-       (syntax/loc stx (: id . more))]
-      [_ stx]))
-  (define (err str . sub)
-    (apply raise-syntax-error '|type declaration| str stx sub))
-  (syntax-parse stx*
+  (define ctx (syntax-local-context))
+  (define top-level? (eq? 'top-level ctx))
+  ;; make it possible to add another colon after the id for clarity
+  ;; and in that case, a `->' on the RHS does not need to be
+  ;; explicitly parenthesized
+  (syntax-parse stx #:literals (: t:->)
     [_
-     #:when (eq? 'expression (syntax-local-context))
-     (err "must be used in a definition context")]
-    [(_ i:id ty)
-     (syntax-property (internal (syntax/loc stx (:-internal i ty)))
+     #:when (eq? 'expression ctx)
+     (err stx "must be used in a definition context")]
+    [(: id (~and kw :) x ...)
+     #:fail-unless (for/first ([i (in-syntax #'(x ...))]
+                               #:when (identifier? i)
+                               #:when (free-identifier=? i #'t:->))
+                     i)
+     #f
+     (add-disappeared-use #'kw)
+     (wrap stx #`(:-helper #,top-level? id (x ...)))]
+    [(: id : . more)
+     (wrap stx #`(:-helper #,top-level? id . more))]
+    [(: e ...) (wrap stx #`(:-helper #,top-level? e ...))]))
+
+(define-syntax (:-helper stx)
+  (syntax-parse stx
+    [(_ top-level? i:id ty)
+     (unless (or (syntax-e #'top-level?)
+                 (identifier-binding #'i))
+       (raise-syntax-error #f "unbound identifier in module" #'i))
+     (syntax-property (syntax/loc stx (begin (quote-syntax (:-internal i ty))
+                                             (#%plain-app values)))
                       'disappeared-use #'i)]
-    [(_ i:id x ...)
+    [(_ _ i:id x ...)
      (case (syntax-length #'(x ...))
-       [(1)  (err "can only annotate identifiers with types" #'i)]
-       [(0)  (err "missing type")]
-       [else (err "bad syntax (multiple types after identifier)")])]))
+       [(1)  (err stx "can only annotate identifiers with types" #'i)]
+       [(0)  (err stx "missing type")]
+       [else (err stx "bad syntax (multiple types after identifier)")])]))
+
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/bad-struct-top.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/bad-struct-top.rkt
index 6fe3d4cc..ac7f0f3d 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/bad-struct-top.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/bad-struct-top.rkt
@@ -4,4 +4,5 @@
 
 ;; Make sure `Struct` constructor rejects bad arguments
 (: x (Struct Integer))
+(define x 3)
 
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
index 590b500f..8ccd3587 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
@@ -1796,6 +1796,10 @@
           (void))
         ;; type doesn't really matter, just make sure it typechecks
         -Void]
+
+       ;; Unit test for PR 13298. Should raise an unbound id error
+       ;; instead of just allowing `x` to be undefined
+       [tc-err (let () (: x Number) 3)]
         )
   (test-suite
    "tc-literal tests"