From 7b4164e4cb208239736a40281020c44e774d0666 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 7 Jan 2010 21:20:45 +0000
Subject: [PATCH] Error on duplicate type annotations.

svn: r17549

original commit: 62653d3c41b97de732aacc932bd123a8fd9ecb21
---
 collects/typed-scheme/env/type-env.ss          | 13 +++++++++----
 collects/typed-scheme/typecheck/tc-toplevel.ss |  2 +-
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/collects/typed-scheme/env/type-env.ss b/collects/typed-scheme/env/type-env.ss
index 37418e41..5070a750 100644
--- a/collects/typed-scheme/env/type-env.ss
+++ b/collects/typed-scheme/env/type-env.ss
@@ -5,7 +5,7 @@
          (utils tc-utils)
          (types utils))
 
-(provide register-type
+(provide register-type register-type-if-undefined
          finish-register-type
          maybe-finish-register-type
          register-type/undefined
@@ -22,15 +22,20 @@
 ;; add a single type to the mapping
 ;; identifier type -> void
 (define (register-type id type)
-  #;(when (eq? (syntax-e id) 'vector-ref)
-      (printf "register-type ~a~n" id))
   (module-identifier-mapping-put! the-mapping id type))
 
+(define (register-type-if-undefined id type)
+  (if (module-identifier-mapping-get the-mapping id (lambda _ #f))
+      (tc-error/stx id "Duplicate type annotation for ~a" (syntax-e id))
+      (register-type id type)))
+
 ;; add a single type to the mapping
 ;; identifier type -> void
 (define (register-type/undefined id type)
   ;(printf "register-type/undef ~a~n" (syntax-e id))
-  (module-identifier-mapping-put! the-mapping id (box type)))
+  (if (module-identifier-mapping-get the-mapping id (lambda _ #f))
+      (tc-error/stx id "Duplicate type annotation for ~a" (syntax-e id))
+      (module-identifier-mapping-put! the-mapping id (box type))))
 
 ;; add a bunch of types to the mapping
 ;; listof[id] listof[type] -> void
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.ss b/collects/typed-scheme/typecheck/tc-toplevel.ss
index 1b2a000e..328123f6 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.ss
+++ b/collects/typed-scheme/typecheck/tc-toplevel.ss
@@ -103,7 +103,7 @@
            ;; if all the variables have types, we stick them into the environment
            [(andmap (lambda (s) (syntax-property s 'type-label)) vars)        
             (let ([ts (map get-type vars)])
-              (for-each register-type vars ts)
+              (for-each register-type-if-undefined vars ts)
               (map make-def-binding vars ts))]
            ;; if this already had an annotation, we just construct the binding reps
            [(andmap (lambda (s) (lookup-type s (lambda () #f))) vars)