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

Change it so that it uses strings instead of symbols here.

Browse Source 
svn: r11697
This commit is contained in:
Stevie Strickland 2008-09-12 19:01:13 +00:00
parent 19cfe4e49e
commit 4e8064e8a5
2 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/scheme/private/contract-helpers.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(provide module-source-as-symbol build-src-loc-string
(provide module-source-as-string build-src-loc-string
mangle-id mangle-id-for-maker
build-struct-names
nums-up-to
@ -111,27 +111,27 @@
(define o (current-output-port))
;; module-source-as-symbol : syntax -> symbol
;; constructs a symbol for use in the blame error messages
;; module-source-as-string : syntax -> symbol
;; constructs a string for use in the blame error messages
;; when blaming the module where stx's occurs.
(define (module-source-as-symbol stx)
(define (module-source-as-string stx)
(let ([mpi (syntax-source-module stx)])
(cond
[(not mpi)
'top-level]
"tthe top level"]
[else
;; note: the directory passed to collapse-module-path-index should be irrelevant
(let ([collapsed
(with-handlers ((exn:fail? (λ (x) 'top-level))) ;; this with-handlers works around a bug elsewhere
(with-handlers ((exn:fail? (λ (x) "the top level"))) ;; this with-handlers works around a bug elsewhere
(collapse-module-path-index mpi (current-directory)))])
(cond
[(path? collapsed)
(let ([resolved (resolved-module-path-name (module-path-index-resolve mpi))])
(cond
[(symbol? resolved) resolved]
[else `(file ,(path->string resolved))]))]
[(symbol? resolved) (format "module ~a" resolved)]
[else (format "module ~a" `(file ,(path->string resolved)))]))]
[else
collapsed]))])))
(format "module ~a" collapsed)]))])))
(define build-struct-names
(lambda (name-stx fields omit-sel? omit-set? srcloc-stx)

6
collects/scheme/private/contract.ss
View File

@ -132,7 +132,7 @@ improve method arity mismatch contract violation error messages?
(make-set!-transformer
(lambda (stx)
(with-syntax ([neg-blame-id (or (syntax-parameter-value #'current-contract-region)
#`(quote #,(a:module-source-as-symbol id)))]
(a:module-source-as-string id))]
[pos-blame-id pos-blame-id]
[contract-id contract-id]
[id id])
@ -303,7 +303,7 @@ improve method arity mismatch contract violation error messages?
#`(-contract contract-id
id
pos-module-source
(module-source-as-symbol #'name)
(module-source-as-string #'name)
#,(id->contract-src-info #'id))))))])
(when key
(hash-set! saved-id-table key lifted-id))
@ -802,7 +802,7 @@ improve method arity mismatch contract violation error messages?
(with-syntax ([code
(quasisyntax/loc stx
(begin
(define pos-module-source (module-source-as-symbol #'pos-stx))
(define pos-module-source (module-source-as-string #'pos-stx))
#,@(if no-need-to-check-ctrct?
(list)