From 73345654455b978aabcbeef351adb6d692dd17ec Mon Sep 17 00:00:00 2001 From: Eric Dobson 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. original commit: 9c71dafb630e66035a102636cdc5aa84c0ae7940 --- collects/typed/untyped-utils.rkt | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/collects/typed/untyped-utils.rkt b/collects/typed/untyped-utils.rkt index c663588f..df98ad1f 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] ...)