From 023c51aec2801af28e442f70f9a6b690e8436b9a Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 1 Jul 2010 08:01:54 -0400 Subject: [PATCH] Support syntax errors blaming multiple syntaxes. original commit: efbdfd3e6e8e561858df08385f4da3acd37a599f --- collects/typed-scheme/utils/tc-utils.rkt | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt index d6a1c317..90a96e0f 100644 --- a/collects/typed-scheme/utils/tc-utils.rkt +++ b/collects/typed-scheme/utils/tc-utils.rkt @@ -109,15 +109,16 @@ don't depend on any other portion of the system ;; produce a type error, using the current syntax (define (tc-error msg . rest) - (let ([stx (locate-stx (current-orig-stx))]) + (let* ([ostx (current-orig-stx)] + [ostxs (if (list? ostx) ostx (list ostx))] + [stxs (map locate-stx ostxs)]) ;; If this isn't original syntax, then we can get some pretty bogus error messages. Note ;; that this is from a macro expansion, so that introduced vars and such don't confuse the user. (cond - [(not (orig-module-stx)) - (raise-typecheck-error (apply format msg rest) (list stx))] - [(eq? (syntax-source (current-orig-stx)) (syntax-source (orig-module-stx))) - (raise-typecheck-error (apply format msg rest) (list stx))] - [else (raise-typecheck-error (apply format (string-append "Error in macro expansion -- " msg) rest) (list stx))]))) + [(or (not (orig-module-stx)) + (for/and ([s ostxs]) (eq? (syntax-source s) (syntax-source (orig-module-stx))))) + (raise-typecheck-error (apply format msg rest) stxs)] + [else (raise-typecheck-error (apply format (string-append "Error in macro expansion -- " msg) rest) stxs)]))) ;; produce a type error, given a particular syntax (define (tc-error/stx stx msg . rest)