From c555ae3a9bd6c3307e19f4e0cae82b968bd6ccda Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 12 Aug 2009 20:28:08 +0000 Subject: [PATCH] Improve error messages from require/contract svn: r15716 original commit: 35336e77b86d137b21f36f1f216bd50ae98d0050 --- .../typed-scheme/utils/require-contract.ss | 41 ++++++++++--------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/collects/typed-scheme/utils/require-contract.ss b/collects/typed-scheme/utils/require-contract.ss index eb9bbff4..b7f89075 100644 --- a/collects/typed-scheme/utils/require-contract.ss +++ b/collects/typed-scheme/utils/require-contract.ss @@ -1,6 +1,7 @@ #lang scheme/base (require scheme/contract (for-syntax scheme/base syntax/kerncase + syntax/parse "../utils/tc-utils.ss" (prefix-in tr: "../private/typed-renaming.ss"))) @@ -30,23 +31,23 @@ (tr:get-alternate #'id)])) (define-syntax (require/contract stx) - (syntax-case stx () - [(require/contract nm cnt lib) - (identifier? #'nm) - (begin - #`(begin (require (only-in lib [nm tmp])) - (define-ignored nm - (contract cnt - (get-alternate tmp) - '(interface for #,(syntax->datum #'nm)) - 'never-happen - (quote-syntax nm)))))] - [(require/contract (orig-nm nm) cnt lib) - (begin - #`(begin (require (only-in lib [orig-nm tmp])) - (define-ignored nm - (contract cnt - (get-alternate tmp) - '#,(syntax->datum #'nm) - 'never-happen - (quote-syntax nm)))))])) + (define-syntax-class renameable + (pattern nm:id + #:with r ((make-syntax-introducer) #'nm))) + (syntax-parse stx + [(require/contract nm:renameable cnt lib) + #`(begin (require (only-in lib [nm nm.r])) + (define-ignored nm + (contract cnt + (get-alternate nm.r) + '(interface for #,(syntax->datum #'nm)) + 'never-happen + (quote-syntax nm))))] + [(require/contract (orig-nm:renameable nm:id) cnt lib) + #`(begin (require (only-in lib [orig-nm orig-nm.r])) + (define-ignored nm + (contract cnt + (get-alternate orig-nm.r) + '#,(syntax->datum #'nm) + 'never-happen + (quote-syntax nm))))]))