From a9868eece19811fafb278081524d406183d7a64b Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sat, 27 Apr 2013 18:53:36 -0700
Subject: [PATCH] Fix require/untyped-contract to generate better names in
 contracts.

Related to PR 13716.
(cherry picked from commit 9c71dafb630e66035a102636cdc5aa84c0ae7940)
---
 collects/math/matrix.rkt                       |  2 +-
 collects/math/private/array/array-indexing.rkt |  4 +---
 collects/math/private/array/array-struct.rkt   |  2 +-
 collects/math/private/array/mutable-array.rkt  |  2 +-
 collects/typed/untyped-utils.rkt               | 16 +++++++++++-----
 5 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/collects/math/matrix.rkt b/collects/math/matrix.rkt
index f042208d78..3cd7b7c73c 100644
--- a/collects/math/matrix.rkt
+++ b/collects/math/matrix.rkt
@@ -50,7 +50,7 @@
 
 (require/untyped-contract
  (begin (require "private/matrix/matrix-types.rkt"
-                 "private/matrix/matrix-gauss-elim.rkt"))
+                 (only-in "private/matrix/matrix-gauss-elim.rkt" Pivoting)))
  "private/matrix/matrix-gauss-elim.rkt"
  [matrix-gauss-elim
   (case-> ((Matrix Number) -> (Values (Matrix Number) (Listof Index)))
diff --git a/collects/math/private/array/array-indexing.rkt b/collects/math/private/array/array-indexing.rkt
index cb33b189f9..1aec9a00c0 100644
--- a/collects/math/private/array/array-indexing.rkt
+++ b/collects/math/private/array/array-indexing.rkt
@@ -8,9 +8,7 @@
                     array-indexes-set!))
 
 (require/untyped-contract
- (begin (require "array-struct.rkt"
-                 "utils.rkt"
-                 "typed-array-indexing.rkt"))
+ (begin (require (only-in "array-struct.rkt" Array Settable-Array)))
  "typed-array-indexing.rkt"
  [array-ref   (All (A) ((Array A) (Vectorof Integer) -> A))]
  [array-set!  (All (A) ((Settable-Array A) (Vectorof Integer) A -> Void))]
diff --git a/collects/math/private/array/array-struct.rkt b/collects/math/private/array/array-struct.rkt
index 0ac53c6be0..cba78232d8 100644
--- a/collects/math/private/array/array-struct.rkt
+++ b/collects/math/private/array/array-struct.rkt
@@ -10,7 +10,7 @@
                     list->array))
 
 (require/untyped-contract
- (begin (require "typed-array-struct.rkt"))
+ (begin (require (only-in "typed-array-struct.rkt" Array)))
  "typed-array-struct.rkt"
  [build-array  (All (A) ((Vectorof Integer) ((Vectorof Index) -> A) -> (Array A)))]
  [build-simple-array  (All (A) ((Vectorof Integer) ((Vectorof Index) -> A) -> (Array A)))]
diff --git a/collects/math/private/array/mutable-array.rkt b/collects/math/private/array/mutable-array.rkt
index aa6715745a..a8a4a5b2bc 100644
--- a/collects/math/private/array/mutable-array.rkt
+++ b/collects/math/private/array/mutable-array.rkt
@@ -8,7 +8,7 @@
                     vector->array))
 
 (require/untyped-contract
- (begin (require "typed-mutable-array.rkt"))
+ (begin (require (only-in "typed-mutable-array.rkt" Mutable-Array)))
  "typed-mutable-array.rkt"
  [vector->array  (All (A) (case-> ((Vectorof A) -> (Mutable-Array A))
                                   ((Vectorof Integer) (Vectorof A) -> (Mutable-Array A))))])
diff --git a/collects/typed/untyped-utils.rkt b/collects/typed/untyped-utils.rkt
index c663588f95..df98ad1fec 100644
--- a/collects/typed/untyped-utils.rkt
+++ b/collects/typed/untyped-utils.rkt
@@ -3,6 +3,7 @@
 (require (for-syntax racket/base
                      syntax/parse
                      racket/syntax
+                     unstable/syntax
                      typed-racket/utils/tc-utils)
          typed-racket/utils/tc-utils)
 
@@ -30,12 +31,16 @@
        (define-syntax name
          (typed/untyped-renamer #'typed-name #'untyped-name)))]))
 
+(define-for-syntax (freshen ids)
+  (syntax-map (lambda (id) ((make-syntax-introducer) id)) ids))
+
 (define-syntax (require/untyped-contract stx)
   (syntax-parse stx #:literals (begin)
     [(_ (begin form ...) from-module-spec:expr [name:id T:expr] ...)
      (with-syntax* ([(typed-name ...)  (generate-temporaries #'(name ...))]
-                    [(untyped-name ...)  (generate-temporaries #'(name ...))]
+                    [(untyped-name ...)  (freshen #'(name ...))]
                     [(untyped2-name ...)  (generate-temporaries #'(name ...))]
+                    [(untyped3-name ...)  (generate-temporaries #'(name ...))]
                     [(macro-name ...)  (generate-temporaries #'(name ...))]
                     [typed-module  (generate-temporary #'typed-module)]
                     [untyped-module  (generate-temporary #'untyped-module)])
@@ -43,19 +48,20 @@
          (begin
            (module typed-module typed/racket/base
              (begin form ...)
-             (require (only-in from-module-spec name ...))
+             (require (rename-in (only-in from-module-spec name ...)
+                                 [name untyped2-name] ...))
              (provide untyped-name ...)
              (: untyped-name T) ...
-             (define untyped-name name) ...)
+             (define untyped-name untyped2-name) ...)
            
            (module untyped-module racket/base
              (require typed/untyped-utils
                       (rename-in (only-in from-module-spec name ...)
                                  [name typed-name] ...)
                       (rename-in (only-in (submod ".." typed-module) untyped-name ...)
-                                 [untyped-name untyped2-name] ...))
+                                 [untyped-name untyped3-name] ...))
              (provide macro-name ...)
-             (define-typed/untyped-identifier macro-name typed-name untyped2-name) ...)
+             (define-typed/untyped-identifier macro-name typed-name untyped3-name) ...)
            
            (require (rename-in (submod "." untyped-module) [macro-name name] ...)))))]
     [(_ from-module-spec:expr [name:id T:expr] ...)