suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Support syntax errors blaming multiple syntaxes.

Browse Source 
original commit: efbdfd3e6e8e561858df08385f4da3acd37a599f
This commit is contained in:
Sam Tobin-Hochstadt 2010-07-01 08:01:54 -04:00
parent 2229399d2c
commit 023c51aec2
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/typed-scheme/utils/tc-utils.rkt
View File

@ -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)