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

simplify

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-09-08 11:37:02 -04:00
parent fae02be9f0
commit cfc289d806
1 changed files with 8 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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