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

improve internal error messages

Browse Source 
svn: r17819

original commit: e493ba5c6ad1a53b01a50b2a80592baa694ece91
This commit is contained in:
Sam Tobin-Hochstadt 2010-01-25 17:23:19 +00:00
parent 5cb93424d5
commit 3dc58b3a44
1 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/typed-scheme/utils/tc-utils.ss
View File

@ -6,7 +6,9 @@ don't depend on any other portion of the system
|#
(provide (all-defined-out))
(require "syntax-traversal.ss" syntax/parse (for-syntax scheme/base syntax/parse) scheme/match
(require "syntax-traversal.ss"
"utils.ss"
syntax/parse (for-syntax scheme/base syntax/parse) scheme/match
(for-syntax unstable/syntax))
;; a parameter representing the original location of the syntax being currently checked
@ -127,11 +129,14 @@ don't depend on any other portion of the system
(define-struct (exn:fail:tc exn:fail) ())
;; raise an internal error - typechecker bug!
(define (int-err msg . args)
(raise (make-exn:fail:tc (string-append "Internal Typechecker Error: "
(apply format msg args)
(format "\nwhile typechecking\n~a" (syntax->datum (current-orig-stx))))
(current-continuation-marks))))
(define (int-err msg . args)
(parameterize ([custom-printer #t])
(raise (make-exn:fail:tc (string-append "Internal Typechecker Error: "
(apply format msg args)
(format "\nwhile typechecking\n~aoriginally\n~a"
(syntax->datum (current-orig-stx))
(syntax->datum (locate-stx (current-orig-stx)))))
(current-continuation-marks)))))
(define-syntax (nyi stx)
(syntax-case stx ()