From 12fc114993b4c5962791984e2ff47340d7a89a88 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Wed, 14 Jan 2009 03:14:26 +0000
Subject: [PATCH] Let's just make some differently painted identifiers so that
 some error messages won't reveal the non-similarly-named ids behind the
 curtain.

(I have my hammer, and damn if I won't use it.)

svn: r13107
---
 collects/mzlib/unit.ss | 67 +++++++++++++++++++++---------------------
 1 file changed, 34 insertions(+), 33 deletions(-)

diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss
index 7caf79872d..ddbd135470 100644
--- a/collects/mzlib/unit.ss
+++ b/collects/mzlib/unit.ss
@@ -707,39 +707,40 @@
                    (var-info-id defid)))))
             (syntax->list (localify #'ivars def-ctx)))
            
-           (with-syntax ([(defn-or-expr ...)
-                          (apply append
-                                 (map (λ (defn-or-expr)
-                                        (syntax-case defn-or-expr (define-values)
-                                          [(define-values (id ...) body)
-                                           (let* ([ids (syntax->list #'(id ...))]
-                                                  [tmps (generate-temporaries ids)]
-                                                  [do-one
-                                                   (λ (id tmp)
-                                                     (let ([var-info (bound-identifier-mapping-get
-                                                                      defined-names-table
-                                                                      id)])
-                                                       (cond
-                                                         [(var-info-exported? var-info)
-                                                          =>
-                                                          (λ (export-loc)
-                                                            (let ([add-ctc (var-info-add-ctc var-info)])
-                                                              (list (quasisyntax/loc defn-or-expr
-                                                                      (set-box! #,export-loc 
-                                                                                (let ([#,id #,(if add-ctc (add-ctc tmp) tmp)])
-                                                                                  #,id)))
-                                                                    (quasisyntax/loc defn-or-expr
-                                                                      (define-syntax #,id 
-                                                                        (make-id-mapper (quote-syntax #,tmp)))))))]
-                                                         [else (list (quasisyntax/loc defn-or-expr
-                                                                       (define-syntax #,id
-                                                                         (make-rename-transformer (quote-syntax #,tmp)))))])))])
-                                             (cons (quasisyntax/loc defn-or-expr
-                                                     (define-values #,tmps body))
-                                                   (apply append (map do-one ids tmps))))]
-                                          [else (list defn-or-expr)]))
-                                      expanded-body))])
-             #'(begin-with-definitions defn-or-expr ...)))))))
+           (let ([marker (make-syntax-introducer)])
+             (with-syntax ([(defn-or-expr ...)
+                            (apply append
+                                   (map (λ (defn-or-expr)
+                                          (syntax-case defn-or-expr (define-values)
+                                            [(define-values (id ...) body)
+                                             (let* ([ids (syntax->list #'(id ...))]
+                                                    [tmps (map marker ids)]
+                                                    [do-one
+                                                     (λ (id tmp)
+                                                       (let ([var-info (bound-identifier-mapping-get
+                                                                        defined-names-table
+                                                                        id)])
+                                                         (cond
+                                                           [(var-info-exported? var-info)
+                                                            =>
+                                                            (λ (export-loc)
+                                                              (let ([add-ctc (var-info-add-ctc var-info)])
+                                                                (list (quasisyntax/loc defn-or-expr
+                                                                        (set-box! #,export-loc 
+                                                                                  (let ([#,id #,(if add-ctc (add-ctc tmp) tmp)])
+                                                                                    #,id)))
+                                                                      (quasisyntax/loc defn-or-expr
+                                                                        (define-syntax #,id 
+                                                                          (make-id-mapper (quote-syntax #,tmp)))))))]
+                                                           [else (list (quasisyntax/loc defn-or-expr
+                                                                         (define-syntax #,id
+                                                                           (make-rename-transformer (quote-syntax #,tmp)))))])))])
+                                               (cons (quasisyntax/loc defn-or-expr
+                                                       (define-values #,tmps body))
+                                                     (apply append (map do-one ids tmps))))]
+                                            [else (list defn-or-expr)]))
+                                        expanded-body))])
+               #'(begin-with-definitions defn-or-expr ...))))))))
 
   (define-for-syntax (redirect-imports/exports import?)
     (lambda (table-stx