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

Lots of "~e" to "~.s" changes.

Browse Source
This commit is contained in:
Eli Barzilay 2010-08-25 16:10:55 -04:00
parent e179449d0e
commit 606b7f60dc
46 changed files with 128 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/compiler/cffi.rkt
View File

@ -298,7 +298,7 @@
(raise-syntax-error 'c-declare "declaration is not a string" stx decl)) (raise-syntax-error 'c-declare "declaration is not a string" stx decl))
(let ([stx-out (syntax (let ([stx-out (syntax
(error 'c-declare (error 'c-declare
"declaration not compiled by mzc: ~e" "declaration not compiled by mzc: ~.s"
str))]) str))])
(syntax-property stx-out 'mzc-cffi 'c-declare)))])) (syntax-property stx-out 'mzc-cffi 'c-declare)))]))

2
collects/compiler/src2src.rkt
View File

@ -1583,7 +1583,7 @@
(syntax-position stx))]) (syntax-position stx))])
(fprintf (current-output-port) " ")) (fprintf (current-output-port) " "))
(fprintf (current-output-port) (fprintf (current-output-port)
"~a: ~e~n" "~a: ~.s~n"
msg msg
(syntax->datum (send exp sexpr))))) (syntax->datum (send exp sexpr)))))

2
collects/compiler/zo-parse.rkt
View File

@ -530,7 +530,7 @@
(match v (match v
[`#((,datum . ,wraps) ,cert-marks) (values cert-marks datum wraps)] [`#((,datum . ,wraps) ,cert-marks) (values cert-marks datum wraps)]
[`(,datum . ,wraps) (values #f datum wraps)] [`(,datum . ,wraps) (values #f datum wraps)]
[else (error 'decode-wraps "bad datum+wrap: ~e" v)])]) [else (error 'decode-wraps "bad datum+wrap: ~.s" v)])])
(let* ([wraps (decode-wraps cp encoded-wraps)] (let* ([wraps (decode-wraps cp encoded-wraps)]
[marks (decode-marks cp cert-marks)] [marks (decode-marks cp cert-marks)]
[add-wrap (lambda (v) (make-wrapped v wraps marks))]) [add-wrap (lambda (v) (make-wrapped v wraps marks))])

2
collects/drracket/private/language-configuration.rkt
View File

@ -86,7 +86,7 @@
(for-each (for-each
(λ (i<%>) (λ (i<%>)
(unless (is-a? language i<%>) (unless (is-a? language i<%>)
(error 'drracket:language:add-language "expected language ~e to implement ~e, forgot to use drracket:language:get-default-mixin ?" language i<%>))) (error 'drracket:language:add-language "expected language ~e to implement ~e, forgot to use `drracket:language:get-default-mixin'?" language i<%>)))
(drracket:language:get-language-extensions)) (drracket:language:get-language-extensions))
(ensure-no-duplicate-numbers language languages) (ensure-no-duplicate-numbers language languages)

2
collects/drracket/private/syncheck/traversals.rkt
View File

@ -420,7 +420,7 @@
[_ [_
(begin (begin
#; #;
(printf "unknown stx: ~e datum: ~e source: ~e\n" (printf "unknown stx: ~.s datum: ~e source: ~e\n"
sexp sexp
(and (syntax? sexp) (and (syntax? sexp)
(syntax->datum sexp)) (syntax->datum sexp))

5
collects/errortrace/errortrace-lib.rkt
View File

@ -356,10 +356,9 @@
[line (syntax-line stx)] [line (syntax-line stx)]
[col (syntax-column stx)] [col (syntax-column stx)]
[pos (syntax-position stx)]) [pos (syntax-position stx)])
(fprintf p "~a~a: ~e~n" (fprintf p "~a~a: ~.s\n"
(or file "[unknown source]") (or file "[unknown source]")
(cond (cond [line (format ":~a:~a" line col)]
[line (format ":~a:~a" line col)]
[pos (format "::~a" pos)] [pos (format "::~a" pos)]
[else ""]) [else ""])
(syntax->datum stx)) (syntax->datum stx))

4
collects/errortrace/stacktrace.rkt
View File

@ -201,7 +201,7 @@
[_else [_else
(error 'errortrace (error 'errortrace
"unrecognized (non-top-level) expression form: ~e" "unrecognized (non-top-level) expression form: ~.s"
(syntax->datum sexpr))]))) (syntax->datum sexpr))])))
(define (profile-annotate-lambda name expr clause bodys-stx phase) (define (profile-annotate-lambda name expr clause bodys-stx phase)
@ -564,7 +564,7 @@
annotate phase)))])] annotate phase)))])]
[_else [_else
(error 'errortrace "unrecognized expression form~a: ~e" (error 'errortrace "unrecognized expression form~a: ~.s"
(if top? " at top-level" "") (if top? " at top-level" "")
(syntax->datum expr))]) (syntax->datum expr))])
expr expr

2
collects/ffi/unsafe.rkt
View File

@ -502,7 +502,7 @@
(lambda (k) (lambda (k)
(cond [(assq k ks) => cdr] (cond [(assq k ks) => cdr]
[(assq k _fun-keywords) => cadr] [(assq k _fun-keywords) => cadr]
[else (error '_fun "internal error: unknown keyword: ~e" k)])) [else (error '_fun "internal error: unknown keyword: ~.s" k)]))
(lambda (k-stx v [sub k-stx]) (lambda (k-stx v [sub k-stx])
(let ([k (if (syntax? k-stx) (syntax-e k-stx) k-stx)]) (let ([k (if (syntax? k-stx) (syntax-e k-stx) k-stx)])
(cond [(assq k ks) (cond [(assq k ks)

2
collects/framework/preferences.rkt
View File

@ -141,7 +141,7 @@ the state transitions / contracts are:
(let ([default (hash-ref defaults p)]) (let ([default (hash-ref defaults p)])
(unless ((default-checker default) value) (unless ((default-checker default) value)
(error 'preferences:set (error 'preferences:set
"tried to set preference ~e to ~e but it does not meet test from preferences:set-default" "tried to set preference ~e to ~e but it does not meet test from `preferences:set-default'"
p value)) p value))
(check-callbacks p value) (check-callbacks p value)
(hash-set! preferences p value))] (hash-set! preferences p value))]

6
collects/framework/private/color.rkt
View File

@ -918,15 +918,15 @@ added get-regions
(let* ((x null) (let* ((x null)
(f (λ (a b c) (set! x (cons (list a b c) x))))) (f (λ (a b c) (set! x (cons (list a b c) x)))))
(send (lexer-state-tokens ls) for-each f) (send (lexer-state-tokens ls) for-each f)
(printf "tokens: ~e~n" (reverse x)) (printf "tokens: ~.s~n" (reverse x))
(set! x null) (set! x null)
(send (lexer-state-invalid-tokens ls) for-each f) (send (lexer-state-invalid-tokens ls) for-each f)
(printf "invalid-tokens: ~e~n" (reverse x)) (printf "invalid-tokens: ~.s~n" (reverse x))
(printf "start-pos: ~a current-pos: ~a invalid-tokens-start ~a~n" (printf "start-pos: ~a current-pos: ~a invalid-tokens-start ~a~n"
(lexer-state-start-pos ls) (lexer-state-start-pos ls)
(lexer-state-current-pos ls) (lexer-state-current-pos ls)
(lexer-state-invalid-tokens-start ls)) (lexer-state-invalid-tokens-start ls))
(printf "parens: ~e~n" (car (send (lexer-state-parens ls) test))))) (printf "parens: ~.s~n" (car (send (lexer-state-parens ls) test)))))
lexer-states)) lexer-states))
;; ------------------------- Callbacks to Override ---------------------- ;; ------------------------- Callbacks to Override ----------------------

8
collects/framework/test.rkt
View File

@ -267,7 +267,7 @@
(send panel get-children)))]) (send panel get-children)))])
(or found (or found
(error object-tag (error object-tag
"no object of class ~a named ~e in active frame" "no object of class ~a named ~.s in active frame"
obj-class obj-class
b-desc)))] b-desc)))]
[(is-a? b-desc obj-class) b-desc] [(is-a? b-desc obj-class) b-desc]
@ -289,11 +289,11 @@
[ctrl (find-ctrl)]) [ctrl (find-ctrl)])
(cond (cond
[(not (send ctrl is-shown?)) [(not (send ctrl is-shown?))
(error error-tag "control ~e is not shown (label ~e)" ctrl (send ctrl get-label))] (error error-tag "control ~.s is not shown (label ~e)" ctrl (send ctrl get-label))]
[(not (send ctrl is-enabled?)) [(not (send ctrl is-enabled?))
(error error-tag "control ~e is not enabled (label ~e)" ctrl (send ctrl get-label))] (error error-tag "control ~.s is not enabled (label ~e)" ctrl (send ctrl get-label))]
[(not (in-active-frame? ctrl)) [(not (in-active-frame? ctrl))
(error error-tag "control ~e is not in active frame (label ~e)" ctrl (send ctrl get-label))] (error error-tag "control ~.s is not in active frame (label ~e)" ctrl (send ctrl get-label))]
[else [else
(update-control ctrl) (update-control ctrl)
(send ctrl command event) (send ctrl command event)

2
collects/games/parcheesi/admin-gui.rkt
View File

@ -269,7 +269,7 @@ corresponds to the unplayed move! that's confusing.
(update-players-dice (past-color past) (past-roll past)) (update-players-dice (past-color past) (past-roll past))
(send board-pasteboard set-board (past-board past)) (send board-pasteboard set-board (past-board past))
(send board-pasteboard set-highlighted-squares '() '()))] (send board-pasteboard set-highlighted-squares '() '()))]
[else (error 'update-gui "unknown viewing index ~e\n" viewing-index)]) [else (error 'update-gui "unknown viewing index ~e" viewing-index)])
(reset-accept/move-buttons) (reset-accept/move-buttons)
(reset-forw-back-buttons)) (reset-forw-back-buttons))

3
collects/games/show-scribbling.rkt
View File

@ -19,5 +19,4 @@
(if path (if path
(let ([u (path->url path)]) (let ([u (path->url path)])
(send-url (url->string u))) (send-url (url->string u)))
(error 'show-scribbling "cannot find docs for: ~e ~e" mod-path tag)))))) (error 'show-scribbling "cannot find docs for: ~.s ~.s" mod-path tag))))))

10
collects/handin-client/client-gui.rkt
View File

@ -273,10 +273,8 @@
(lambda () (lambda ()
(let* ([msg (if (exn? exn) (let* ([msg (if (exn? exn)
(let ([s (exn-message exn)]) (let ([s (exn-message exn)])
(if (string? s) (if (string? s) s (format "~.s" s)))
s (format "~.s" exn))]
(format "~e" s)))
(format "~e" exn))]
[retry? (regexp-match #rx"bad username or password for" msg)]) [retry? (regexp-match #rx"bad username or password for" msg)])
(custodian-shutdown-all comm-cust) (custodian-shutdown-all comm-cust)
(set! committing? #f) (set! committing? #f)
@ -541,8 +539,8 @@
(message-box (message-box
"Server Error" "Server Error"
(if (exn? exn) (if (exn? exn)
(let ([s (exn-message exn)]) (if (string? s) s (format "~e" s))) (let ([s (exn-message exn)]) (if (string? s) s (format "~.s" s)))
(format "~e" exn)) (format "~.s" exn))
this) this)
(set! comm-cust (make-custodian)))))) (set! comm-cust (make-custodian))))))

4
collects/handin-server/checker.rkt
View File

@ -674,7 +674,7 @@
(error* "missing binding: ~.s" (->disp 'id)))] (error* "missing binding: ~.s" (->disp 'id)))]
[exn:fail:syntax? [exn:fail:syntax?
(lambda (_) (lambda (_)
(error* "bound to a syntax, expecting a value: ~e" (error* "bound to a syntax, expecting a value: ~.s"
(->disp 'id)))]) (->disp 'id)))])
(parameterize ([current-namespace (get-namespace (submission-eval))]) (parameterize ([current-namespace (get-namespace (submission-eval))])
(namespace-variable-value `id))) (namespace-variable-value `id)))
@ -698,7 +698,7 @@
(syntax-rules () (syntax-rules ()
[(_ expr) [(_ expr)
(unless (procedure? ((submission-eval) `expr)) (unless (procedure? ((submission-eval) `expr))
(error* "~e is expected to be bound to a procedure" (->disp 'expr)))] (error* "~.s is expected to be bound to a procedure" (->disp 'expr)))]
[(_ expr arity) [(_ expr arity)
(let ([ar arity] (let ([ar arity]
[val ((submission-eval) `expr)]) [val ((submission-eval) `expr)])

2
collects/handin-server/main.rkt
View File

@ -650,7 +650,7 @@
(lambda (exn) (lambda (exn)
(let ([msg (if (exn? exn) (let ([msg (if (exn? exn)
(exn-message exn) (exn-message exn)
(format "~e" exn))]) (format "~.s" exn))])
(kill-watcher) (kill-watcher)
(log-line "ERROR: ~a" msg) (log-line "ERROR: ~a" msg)
(write+flush w msg) (write+flush w msg)

3
collects/handin-server/scribblings/checker.scrbl
View File

@ -173,7 +173,8 @@ Keywords for configuring @scheme[check:]:
report an error that occurred during evaluation of the submitted report an error that occurred during evaluation of the submitted
code (not during additional tests). It can be a plain string which code (not during additional tests). It can be a plain string which
will be used as the error message, or a string with single a will be used as the error message, or a string with single a
@scheme["~a"] (or @scheme["~e"], @scheme["~s"], @scheme["~v"]) that @scheme["~a"] (or @scheme["~s"], @scheme["~v"], @scheme["~e"],
or @scheme["~.a"] etc) that
will be used as a format string with the actual error message. The will be used as a format string with the actual error message. The
default is @scheme["Error in your code --\n~a"]. Useful examples of default is @scheme["Error in your code --\n~a"]. Useful examples of
these messages: these messages:

4
collects/handin-server/utils.rkt
View File

@ -81,7 +81,7 @@
(with-handlers ([void (lambda (exn) (with-handlers ([void (lambda (exn)
(error (if (exn? exn) (error (if (exn? exn)
(exn-message exn) (exn-message exn)
(format "exception: ~e" exn))))]) (format "exception: ~.s" exn))))])
(thunk))) (thunk)))
;; ---------------------------------------- ;; ----------------------------------------
@ -119,7 +119,7 @@
(with-handlers ([void (with-handlers ([void
(lambda (x) (lambda (x)
(error (error
(format "instructor-supplied test ~a failed with an error: ~e" (format "instructor-supplied test ~a failed with an error: ~.s"
(format-history test) (format-history test)
(exn-message x))))]) (exn-message x))))])
(let ([val (e `(,f ,@(map value-converter args)))]) (let ([val (e `(,f ,@(map value-converter args)))])

2
collects/help/help-utils.rkt
View File

@ -43,7 +43,7 @@
(if tag (if tag
(go-to-tag xref tag) (go-to-tag xref tag)
(error 'help (error 'help
"no documentation found for: ~e provided by: ~a" "no documentation found for: ~.s provided by: ~a"
(syntax-e id) (syntax-e id)
(module-path-index-resolve (caddr b))))) (module-path-index-resolve (caddr b)))))
(search-for-exports xref (syntax-e id) any-b)))) (search-for-exports xref (syntax-e id) any-b))))

4
collects/macro-debugger/model/reductions-config.rkt
View File

@ -286,11 +286,11 @@
;; Only bad effect should be missed subterms (usually at phase1). ;; Only bad effect should be missed subterms (usually at phase1).
(STRICT-CHECKS (STRICT-CHECKS
(fprintf (current-error-port) (fprintf (current-error-port)
"from:\n~e\n\nto:\n~e\n\n" "from:\n~.s\n\nto:\n~.s\n\n"
(stx->datum from) (stx->datum from)
(stx->datum to)) (stx->datum to))
(fprintf (current-error-port) (fprintf (current-error-port)
"original from:\n~e\n\noriginal to:\n~e\n\n" "original from:\n~.s\n\noriginal to:\n~.s\n\n"
(stx->datum from0) (stx->datum from0)
(stx->datum to0)) (stx->datum to0))
(error 'add-to-renames-table)) (error 'add-to-renames-table))

52
collects/macro-debugger/model/reductions-engine.rkt
View File

@ -289,9 +289,9 @@
[(R** f v p s ws [#:print-state msg] . more) [(R** f v p s ws [#:print-state msg] . more)
#'(begin (printf "** ~s\n" msg) #'(begin (printf "** ~s\n" msg)
(printf "f = ~e\n" (stx->datum f)) (printf "f = ~.s\n" (stx->datum f))
(printf "v = ~e\n" (stx->datum v)) (printf "v = ~.s\n" (stx->datum v))
(printf "s = ~e\n" (stx->datum s)) (printf "s = ~.s\n" (stx->datum s))
(R** f v p s ws . more))] (R** f v p s ws . more))]
;; ** Multi-pass reductions ** ;; ** Multi-pass reductions **
@ -365,10 +365,10 @@
[fills fills-e]) [fills fills-e])
(DEBUG (DEBUG
(printf "Run (multi, vis=~s)\n" (visibility)) (printf "Run (multi, vis=~s)\n" (visibility))
(printf " f: ~e\n" (stx->datum f)) (printf " f: ~.s\n" (stx->datum f))
(printf " v: ~e\n" (stx->datum v)) (printf " v: ~.s\n" (stx->datum v))
(printf " p: ~e\n" 'p) (printf " p: ~.s\n" 'p)
(printf " hole: ~e\n" '(hole :::)) (printf " hole: ~.s\n" '(hole :::))
(print-viable-subterms v)) (print-viable-subterms v))
(if (visibility) (if (visibility)
(let ([vctx (CC (hole :::) v p)] (let ([vctx (CC (hole :::) v p)]
@ -381,10 +381,10 @@
[fctx (CC hole f p)]) [fctx (CC hole f p)])
(DEBUG (DEBUG
(printf "Run (single, vis=~s)\n" (visibility)) (printf "Run (single, vis=~s)\n" (visibility))
(printf " f: ~e\n" (stx->datum f)) (printf " f: ~.s\n" (stx->datum f))
(printf " v: ~e\n" (stx->datum v)) (printf " v: ~.s\n" (stx->datum v))
(printf " p: ~e\n" 'p) (printf " p: ~.s\n" 'p)
(printf " hole: ~e\n" 'hole) (printf " hole: ~.s\n" 'hole)
(print-viable-subterms v)) (print-viable-subterms v))
(if (visibility) (if (visibility)
(let ([vctx (CC hole v p)] (let ([vctx (CC hole v p)]
@ -396,8 +396,8 @@
(define (run-one reducer init-e fctx vsub vctx fill s ws k) (define (run-one reducer init-e fctx vsub vctx fill s ws k)
(DEBUG (DEBUG
(printf "run-one\n") (printf "run-one\n")
(printf " fctx: ~e\n" (stx->datum (fctx #'HOLE))) (printf " fctx: ~.s\n" (stx->datum (fctx #'HOLE)))
(printf " vctx: ~e\n" (stx->datum (vctx #'HOLE)))) (printf " vctx: ~.s\n" (stx->datum (vctx #'HOLE))))
(RSbind (with-context vctx (RSbind (with-context vctx
((reducer fill) init-e vsub s ws)) ((reducer fill) init-e vsub s ws))
(lambda (f2 v2 s2 ws2) (k (fctx f2) (vctx v2) s2 ws2)))) (lambda (f2 v2 s2 ws2) (k (fctx f2) (vctx v2) s2 ws2))))
@ -406,12 +406,12 @@
(define (run-multiple/visible reducer init-e1s fctx vsubs vctx fills s ws k) (define (run-multiple/visible reducer init-e1s fctx vsubs vctx fills s ws k)
(DEBUG (DEBUG
(printf "run-multiple/visible\n") (printf "run-multiple/visible\n")
(printf " fctx: ~e\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE)))) (printf " fctx: ~.s\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE))))
(printf " vctx: ~e\n" (stx->datum (vctx (for/list ([dummy init-e1s]) #'HOLE)))) (printf " vctx: ~.s\n" (stx->datum (vctx (for/list ([dummy init-e1s]) #'HOLE))))
(unless (= (length fills) (length init-e1s)) (unless (= (length fills) (length init-e1s))
(printf " fills(~s): ~e\n" (length fills) fills) (printf " fills(~s): ~.s\n" (length fills) fills)
(printf " init-e1s: ~s\n" (stx->datum init-e1s)) (printf " init-e1s: ~.s\n" (stx->datum init-e1s))
(printf " vsubs: ~s\n" (stx->datum vsubs)))) (printf " vsubs: ~.s\n" (stx->datum vsubs))))
(let loop ([fills fills] [prefix null] [vprefix null] [suffix init-e1s] [vsuffix vsubs] [s s] [ws ws]) (let loop ([fills fills] [prefix null] [vprefix null] [suffix init-e1s] [vsuffix vsubs] [s s] [ws ws])
(cond (cond
[(pair? fills) [(pair? fills)
@ -432,10 +432,10 @@
(define (run-multiple/nonvisible reducer init-e1s fctx v fills s ws k) (define (run-multiple/nonvisible reducer init-e1s fctx v fills s ws k)
(DEBUG (DEBUG
(printf "run-multiple/nonvisible\n") (printf "run-multiple/nonvisible\n")
(printf " fctx: ~e\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE))))) (printf " fctx: ~.s\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE)))))
(let loop ([fills fills] [prefix null] [suffix init-e1s] [v v] [s s] [ws ws]) (let loop ([fills fills] [prefix null] [suffix init-e1s] [v v] [s s] [ws ws])
(DEBUG (DEBUG
(printf " v: ~e\n" (stx->datum (datum->syntax #f v)))) (printf " v: ~.s\n" (stx->datum (datum->syntax #f v))))
(cond (cond
[(pair? fills) [(pair? fills)
(RSbind ((reducer (car fills)) (car suffix) v s ws) (RSbind ((reducer (car fills)) (car suffix) v s ws)
@ -468,7 +468,7 @@
(cond [(and (not new-visible?) (or (visibility) reset-subterms?)) (cond [(and (not new-visible?) (or (visibility) reset-subterms?))
(begin (begin
(DEBUG (DEBUG
(printf "hide => seek: ~e\n" (stx->datum stx))) (printf "hide => seek: ~.s\n" (stx->datum stx)))
(current-pass-hides? #t) (current-pass-hides? #t)
(let* ([subterms (gather-proper-subterms stx)] (let* ([subterms (gather-proper-subterms stx)]
[marking (marking-table)] [marking (marking-table)]
@ -496,11 +496,11 @@
(k vstx) (k vstx)
(let ([paths (table-get (subterms-table) stx)]) (let ([paths (table-get (subterms-table) stx)])
(cond [(null? paths) (cond [(null? paths)
(DEBUG (printf "seek-point: failed on ~e\n" (stx->datum stx))) (DEBUG (printf "seek-point: failed on ~.s\n" (stx->datum stx)))
(k vstx)] (k vstx)]
[(null? (cdr paths)) [(null? (cdr paths))
(let ([path (car paths)]) (let ([path (car paths)])
(DEBUG (printf "seek => hide: ~e\n" (stx->datum stx))) (DEBUG (printf "seek => hide: ~.s\n" (stx->datum stx)))
(let ([ctx (lambda (x) (path-replace vstx path x))]) (let ([ctx (lambda (x) (path-replace vstx path x))])
(RScase (parameterize ((visibility #t) (RScase (parameterize ((visibility #t)
(subterms-table #f) (subterms-table #f)
@ -538,16 +538,16 @@
[same-form? (equal? actual-datum expected-datum)]) [same-form? (equal? actual-datum expected-datum)])
(if same-form? (if same-form?
(fprintf (current-error-port) (fprintf (current-error-port)
"same form but wrong wrappings:\n~e\nwrongness:\n~e\n" "same form but wrong wrappings:\n~.s\nwrongness:\n~.s\n"
actual-datum actual-datum
(wrongness actual expected)) (wrongness actual expected))
(fprintf (current-error-port) (fprintf (current-error-port)
"got:\n~s\n\nexpected:\n~e\n" "got:\n~.s\n\nexpected:\n~.s\n"
actual-datum actual-datum
expected-datum)) expected-datum))
(for ([d derivs]) (for ([d derivs])
(fprintf (current-error-port) (fprintf (current-error-port)
"\n~e\n" d)) "\n~.s\n" d))
(error function (error function
(if same-form? (if same-form?
"wrong starting point (wraps)!" "wrong starting point (wraps)!"

6
collects/meta/build/bundle
View File

@ -192,9 +192,9 @@
(reverse r) (reverse r)
(let* ([bin (car bins)] [src (get-tag bin)]) (let* ([bin (car bins)] [src (get-tag bin)])
(cond (cond
[(not src) (error 'binaries "no type assigned to `~e'" bin)] [(not src) (error 'binaries "no type assigned to `~.s'" bin)]
[(not (= 1 (length src))) [(not (= 1 (length src)))
(error 'binaries "bad type assignment for `~e': ~e" bin src)] (error 'binaries "bad type assignment for `~.s': ~.s" bin src)]
[else (loop (cdr bins) [else (loop (cdr bins)
(if (memq (car src) r) r (cons (car src) r)))]))))) (if (memq (car src) r) r (cons (car src) r)))])))))
(dprintf "Scanning full tgzs") (dprintf "Scanning full tgzs")
@ -374,7 +374,7 @@
(let ([rx (expand-spec spec)]) (let ([rx (expand-spec spec)])
(if (and (pair? rx) (null? (cdr rx)) (string? (car rx))) (if (and (pair? rx) (null? (cdr rx)) (string? (car rx)))
(car rx) (car rx)
(error 'filter-bintree "bad value for ~e: ~e" spec rx)))) (error 'filter-bintree "bad value for ~.s: ~e" spec rx))))
(define keep-pattern (get-pattern 'binary-keep)) (define keep-pattern (get-pattern 'binary-keep))
(define throw-pattern (get-pattern 'binary-throw)) (define throw-pattern (get-pattern 'binary-throw))
(define keep-rx (regexpify-spec (string-append "*" keep-pattern "*"))) (define keep-rx (regexpify-spec (string-append "*" keep-pattern "*")))

4
collects/meta/checker.rkt
View File

@ -423,7 +423,7 @@
;; first. ;; first.
=> (lambda (p) => (lambda (p)
(make-cached (apply p (map primitive-spec->filter (cdr spec)))))] (make-cached (apply p (map primitive-spec->filter (cdr spec)))))]
[else (error 'primitive-spec->filter "bad spec: ~e" spec)]))) [else (error 'primitive-spec->filter "bad spec: ~.s" spec)])))
;; Toplevel entry point for converting a spec into a tree predicate function. ;; Toplevel entry point for converting a spec into a tree predicate function.
(define (spec->filter spec) (define (spec->filter spec)
@ -431,7 +431,7 @@
(if (= 1 (length specs)) (if (= 1 (length specs))
(primitive-spec->filter (car specs)) (primitive-spec->filter (car specs))
(error 'spec->filter (error 'spec->filter
"spec `~e' did not expand to a single expression: ~e" "spec `~.s' did not expand to a single expression: ~.s"
spec specs)))) spec specs))))
;;; =========================================================================== ;;; ===========================================================================

7
collects/meta/props
View File

@ -120,7 +120,7 @@ path/s is either such a string or a list of them.
;; script? ;; script?
(fprintf (current-error-port) "warning: ~a\n" (apply format fmt args))) (fprintf (current-error-port) "warning: ~a\n" (apply format fmt args)))
(define (find-prop who pname [error-message "unknown property: ~e"]) (define (find-prop who pname [error-message "unknown property: ~.s"])
(if (prop? pname) (if (prop? pname)
pname ; might happen when `set-prop!' calls `get-prop' pname ; might happen when `set-prop!' calls `get-prop'
(or (for/or ([p (in-list known-props)]) (or (for/or ([p (in-list known-props)])
@ -272,7 +272,7 @@ path/s is either such a string or a list of them.
[(string? x) [(string? x)
;; new path, find the node or create if none ;; new path, find the node or create if none
(loop (tree-find x #t) #f)] (loop (tree-find x #t) #f)]
[(find-prop #f x "bad datum `~e'") [(find-prop #f x "bad datum `~.s'")
;; new prop ;; new prop
(loop (or tree (malformed "initial property has no path")) x)] (loop (or tree (malformed "initial property has no path")) x)]
[else (malformed (format x))]))) [else (malformed (format x))])))
@ -498,7 +498,8 @@ path/s is either such a string or a list of them.
(error "can't use more than a single `~s'")) (error "can't use more than a single `~s'"))
xs))))) xs)))))
(lambda (cmd) (lambda (cmd)
(define (bad) (error 'drdr:command-line "bad command-line value: ~e" cmd)) (define (bad)
(error 'drdr:command-line "bad command-line value: ~.s" cmd))
(cond [(not cmd) ""] (cond [(not cmd) ""]
[(not (list? cmd)) (bad)] [(not (list? cmd)) (bad)]
[else (string-join (map (lambda (x) [else (string-join (map (lambda (x)

10
collects/meta/specs.rkt
View File

@ -151,7 +151,7 @@
;; spec -> spec-list, the input is always a cond spec ;; spec -> spec-list, the input is always a cond spec
(define (expand-cond-spec spec) (define (expand-cond-spec spec)
(define (eval-cond c) (define (eval-cond c)
(define (bad-cond) (error 'expand-cond-spec "got a bad condition: ~e" c)) (define (bad-cond) (error 'expand-cond-spec "got a bad condition: ~.s" c))
(cond [(eq? c 'else) #t] (cond [(eq? c 'else) #t]
[(pair? c) [(pair? c)
(case (car c) (case (car c)
@ -180,12 +180,12 @@
[(eq? 'tag (car spec)) [(eq? 'tag (car spec))
(if (pair? (cdr spec)) (if (pair? (cdr spec))
(tag (cadr spec) (expand-specs (cddr spec))) (tag (cadr spec) (expand-specs (cddr spec)))
(error 'expand-spec "bad `tag' form: ~e" spec))] (error 'expand-spec "bad `tag' form: ~.s" spec))]
[(eq? 'lambda (car spec)) [(eq? 'lambda (car spec))
(if (pair? (cdr spec)) (if (pair? (cdr spec))
(list (eval `(lambda ,(cadr spec) (list (eval `(lambda ,(cadr spec)
(splice (list ,@(cddr spec)))))) (splice (list ,@(cddr spec))))))
(error 'expand-spec "bad `lambda' form: ~e" spec))] (error 'expand-spec "bad `lambda' form: ~.s" spec))]
[(procedure? (car spec)) [(procedure? (car spec))
(let ([newspec (apply (car spec) (expand-specs (cdr spec)))]) (let ([newspec (apply (car spec) (expand-specs (cdr spec)))])
(cond [(spliced? newspec) (expand-specs (cdr newspec))] (cond [(spliced? newspec) (expand-specs (cdr newspec))]
@ -212,7 +212,7 @@
(let ([r (expand-spec spec)]) (let ([r (expand-spec spec)])
(if (= 1 (length r)) (if (= 1 (length r))
(car r) (car r)
(error 'expand-spec-1 "expected a single result for ~s, but got ~e" (error 'expand-spec-1 "expected a single result for ~.s, but got ~e"
spec r)))) spec r))))
;; Expand tags ;; Expand tags
@ -234,5 +234,5 @@
(let ([r (expand-specs conds)]) (let ([r (expand-specs conds)])
(if (= 1 (length r)) (if (= 1 (length r))
(car r) (car r)
(error 'expand-conds "expected a single result for ~s, but got ~e" (error 'expand-conds "expected a single result for ~.s, but got ~e"
conds r)))))) conds r))))))

12
collects/mzlib/kw.rkt
View File

@ -331,7 +331,7 @@
#`((if (and in-seen? in-keys?) #`((if (and in-seen? in-keys?)
#,(if allow-duplicate-keys? #,(if allow-duplicate-keys?
#`seen-keys #`seen-keys
#`(error* 'name "duplicate keyword: ~e" #`(error* 'name "duplicate keyword: ~.s"
(car body*))) (car body*)))
(cons (car body*) seen-keys))) (cons (car body*) seen-keys)))
'()))]) '()))])
@ -343,12 +343,12 @@
nl nl
#`(if in-keys? #`(if in-keys?
#,nl #,nl
(error* 'name "unknown keyword: ~e" (error* 'name "unknown keyword: ~.s"
(car body*)))))] (car body*)))))]
[(not allow-other-keys?) [(not allow-other-keys?)
#`(if (memq (car body*) 'keywords) #`(if (memq (car body*) 'keywords)
#,nl #,nl
(error* 'name "unknown keyword: ~e" (error* 'name "unknown keyword: ~.s"
(car body*)))] (car body*)))]
[else nl]))] [else nl]))]
[expr [expr
@ -381,7 +381,7 @@
#'next-loop #'next-loop
#'(if (pair? (cdr body*)) #'(if (pair? (cdr body*))
next-loop next-loop
(error* 'name "keyword list not balanced: ~e" rest*))) (error* 'name "keyword list not balanced: ~.s" rest*)))
#,(if allow-body? #,(if allow-body?
(if (and body (not (identifier? body))) (if (and body (not (identifier? body)))
(with-syntax ([name (string->symbol (with-syntax ([name (string->symbol
@ -395,7 +395,7 @@
#'expr) #'expr)
#'(if (null? body*) #'(if (null? body*)
expr expr
(error* 'name "expecting a ~s keyword got: ~e" (error* 'name "expecting a ~s keyword got: ~.s"
'keywords (car body*)))))))))) 'keywords (car body*))))))))))
;; ------------------------------------------------------------------------ ;; ------------------------------------------------------------------------
;; generates the loop that turns flags to #t's ;; generates the loop that turns flags to #t's
@ -456,7 +456,7 @@
(syntax/loc stx (syntax/loc stx
(lambda vars (lambda vars
(if (and (pair? body) (keyword? (car body))) (if (and (pair? body) (keyword? (car body)))
(error* 'name "unknown keyword: ~e" (car body)) (error* 'name "unknown keyword: ~.s" (car body))
expr)))))] expr)))))]
;; no keys => make a case-lambda for optionals ;; no keys => make a case-lambda for optionals
[(and (null? keys) (not (or body allow-other-keys?))) [(and (null? keys) (not (or body allow-other-keys?)))

2
collects/mzlib/runtime-path.rkt
View File

@ -85,7 +85,7 @@
(null? (cdr strs))) (null? (cdr strs)))
(list "mzlib") (list "mzlib")
(append (cddr p) (drop-right strs 1)))))] (append (cddr p) (drop-right strs 1)))))]
[else (error 'runtime-path "unknown form: ~e" p)]))) [else (error 'runtime-path "unknown form: ~.s" p)])))
paths))) paths)))
(define-for-syntax (register-ext-files tag-stx paths) (define-for-syntax (register-ext-files tag-stx paths)

4
collects/mzlib/unit.rkt
View File

@ -843,7 +843,7 @@
(names (apply append nameses)) (names (apply append nameses))
(dup (check-duplicate-identifier names))) (dup (check-duplicate-identifier names)))
(when dup (when dup
(raise-stx-err (format "duplicate binding for ~e" (syntax-e dup)))) (raise-stx-err (format "duplicate binding for ~.s" (syntax-e dup))))
(quasisyntax/loc stx (quasisyntax/loc stx
(provide #,@names)))))) (provide #,@names))))))
@ -1652,7 +1652,7 @@
(tmp-bindings (map (λ (s) (map tmarker (map car (car s)))) out-sigs)) (tmp-bindings (map (λ (s) (map tmarker (map car (car s)))) out-sigs))
(def-table (make-bound-identifier-mapping))) (def-table (make-bound-identifier-mapping)))
(when dup (when dup
(raise-stx-err (format "duplicate binding for ~e" (syntax-e dup)))) (raise-stx-err (format "duplicate binding for ~.s" (syntax-e dup))))
(for-each (for-each
(λ (sig new-xs) (λ (sig new-xs)
(for-each (for-each

2
collects/planet/parsereq.rkt
View File

@ -76,7 +76,7 @@
tail tail
(string-append tail ".ss")))]) (string-append tail ".ss")))])
(make-request fullspec final-path '())))] (make-request fullspec final-path '())))]
[_ (raise-syntax-error 'require (format "Illegal PLaneT invocation: ~e" (cdr spec)) stx)])) [_ (raise-syntax-error 'require (format "Illegal PLaneT invocation: ~.s" (cdr spec)) stx)]))
;; short-pkg-string->spec : string (string -> string -> 'a) -> (list pkg-spec string) ;; short-pkg-string->spec : string (string -> string -> 'a) -> (list pkg-spec string)
;; extracts the named package from the given short-style string, returning ;; extracts the named package from the given short-style string, returning

2
collects/racket/contract/private/opt.rkt
View File

@ -50,7 +50,7 @@
(λ (opt/i opt/info stx) (λ (opt/i opt/info stx)
expr ...))) expr ...)))
(void)) (void))
(error 'define/opter "expected opter name to be an identifier, got ~e" (syntax-e #'for)))])) (error 'define/opter "expected opter name to be an identifier, got ~.s" (syntax-e #'for)))]))
;; ;;
;; opt/recursive-call ;; opt/recursive-call

2
collects/racket/private/promise.rkt
View File

@ -245,7 +245,7 @@
#:property prop:procedure (lambda (this) #:property prop:procedure (lambda (this)
(let ([name (running-name this)]) (let ([name (running-name this)])
(if name (if name
(error 'force "reentrant promise ~e" name) (error 'force "reentrant promise ~.s" name)
(error 'force "reentrant promise"))))) (error 'force "reentrant promise")))))
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------

2
collects/scribble/racket.rkt
View File

@ -441,7 +441,7 @@
(let ([l (syntax->list c)] (let ([l (syntax->list c)]
[h? highlight?]) [h? highlight?])
(unless (and l (= 2 (length l))) (unless (and l (= 2 (length l)))
(error "bad code:redex: ~e" (syntax->datum c))) (error "bad code:redex: ~.s" (syntax->datum c)))
(advance c init-line!) (advance c init-line!)
(set! src-col (syntax-column (cadr l))) (set! src-col (syntax-column (cadr l)))
(hash-set! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)

10
collects/stepper/private/macro-unwind.rkt
View File

@ -159,14 +159,14 @@
"unknown value for syntax property 'stepper-define-type: ~e" "unknown value for syntax property 'stepper-define-type: ~e"
define-type)])] define-type)])]
[else (error 'unwind-define [else (error 'unwind-define
"expr with stepper-define-type is not a lambda: ~e" "expr with stepper-define-type is not a lambda: ~.s"
(syntax->datum unwound-body))]) (syntax->datum unwound-body))])
#`(define #,printed-name #,unwound-body))) #`(define #,printed-name #,unwound-body)))
;; this is there just to see the unsupported stuff go by... ;; this is there just to see the unsupported stuff go by...
#`(define-values (name . others) #,(unwind #'body settings)) #`(define-values (name . others) #,(unwind #'body settings))
)] )]
[else (error 'unwind-define [else (error 'unwind-define
"expression is not a define-values: ~e" "expression is not a define-values: ~.s"
(syntax->datum stx))])) (syntax->datum stx))]))
(define (unwind-mz-let stx settings) (define (unwind-mz-let stx settings)
@ -216,7 +216,7 @@
#`((define-values vars exp) ...)))]) #`((define-values vars exp) ...)))])
#`(local defns #,(unwind #'body settings)))] #`(local defns #,(unwind #'body settings)))]
[else (error 'unwind-local [else (error 'unwind-local
"expected a letrec-values, given: ~e" "expected a letrec-values, given: ~.s"
(syntax->datum stx))])) (syntax->datum stx))]))
;(define (unwind-quasiquote-the-cons-application stx settings) ;(define (unwind-quasiquote-the-cons-application stx settings)
@ -257,10 +257,10 @@
[(begin . rest) null] [(begin . rest) null]
[else-stx [else-stx
(error 'unwind-cond (error 'unwind-cond
"expected an if, got: ~e" "expected an if, got: ~.s"
(syntax->datum (syntax else-stx)))]) (syntax->datum (syntax else-stx)))])
(error 'unwind-cond (error 'unwind-cond
"expected a cond clause expansion, got: ~e" "expected a cond clause expansion, got: ~.s"
(syntax->datum stx))))]) (syntax->datum stx))))])
(syntax (cond . clauses))))) (syntax (cond . clauses)))))

4
collects/stepper/private/reconstruct.rkt
View File

@ -180,7 +180,7 @@
([non-lexical] ([non-lexical]
varref) varref)
(else (else
(error 'varref-skip-step? "unexpected value for stepper-binding-type: ~e for variable: ~e\n" (error 'varref-skip-step? "unexpected value for stepper-binding-type: ~e for variable: ~.s\n"
(stepper-syntax-property varref 'stepper-binding-type) (stepper-syntax-property varref 'stepper-binding-type)
varref)))))))) varref))))))))
@ -931,7 +931,7 @@
(apply append (map syntax->list (syntax->list #`(vars ...))))] (apply append (map syntax->list (syntax->list #`(vars ...))))]
[(let-values ([vars . rest] ...) . bodies) [(let-values ([vars . rest] ...) . bodies)
(apply append (map syntax->list (syntax->list #`(vars ...))))] (apply append (map syntax->list (syntax->list #`(vars ...))))]
[else (error 'reconstruct "expected a let-values as source for a double-break, got: ~e" [else (error 'reconstruct "expected a let-values as source for a double-break, got: ~.s"
(syntax->datum source-expr))])] (syntax->datum source-expr))])]
[innermost-after (mark-as-highlight (recon-source-expr (mark-source (car mark-list)) mark-list null newly-lifted-bindings render-settings))]) [innermost-after (mark-as-highlight (recon-source-expr (mark-source (car mark-list)) mark-list null newly-lifted-bindings render-settings))])
(list (recon innermost-before (cdr mark-list) #f) (list (recon innermost-before (cdr mark-list) #f)

7
collects/stepper/private/xml-box.rkt
View File

@ -15,7 +15,7 @@
(rewrite-xml-box stx rewrite-other)) (rewrite-xml-box stx rewrite-other))
(define (rewrite-xml-error) (define (rewrite-xml-error)
(error 'rewrite-xml-box "unexpected syntax in expansion of xml box: ~e" stx)) (error 'rewrite-xml-box "unexpected syntax in expansion of xml box: ~.s" stx))
(case (stepper-syntax-property stx 'stepper-hint) (case (stepper-syntax-property stx 'stepper-hint)
[(from-scheme-box from-splice-box) (rewrite-other stx)] [(from-scheme-box from-splice-box) (rewrite-other stx)]
@ -56,9 +56,6 @@
'from-xml-box)] 'from-xml-box)]
[else [else
(error 'rewrite-xml-box "unexpected stepper-hint \"~v\" on syntax from xml box: ~e" (error 'rewrite-xml-box "unexpected stepper-hint ~e on syntax from xml box: ~.s"
(stepper-syntax-property stx 'stepper-hint) (stepper-syntax-property stx 'stepper-hint)
stx)]))) stx)])))

14
collects/swindle/misc.rkt
View File

@ -1651,10 +1651,10 @@
(arity-at-least-value arity))] (arity-at-least-value arity))]
[required (or at-least arity)]) [required (or at-least arity)])
(unless (integer? required) (unless (integer? required)
(error 'echo "handler function for `~e' has bad arity" keyword)) (error 'echo "handler function for `~.s' has bad arity" keyword))
(lambda (args) (lambda (args)
(if (< (length args) required) (if (< (length args) required)
(error 'echo "user-keyword `~e' didn't get enough arguments" keyword) (error 'echo "user-keyword `~.s' didn't get enough arguments" keyword)
(let*-values ([(proc-args rest-args) (let*-values ([(proc-args rest-args)
(if at-least (if at-least
(values args '()) (values args '())
@ -1724,7 +1724,7 @@
(when (and (pair? l-args) (eq? echo: (car l-args))) (when (and (pair? l-args) (eq? echo: (car l-args)))
(set! l-args (cdr l-args)) (pop-key-tags))) (set! l-args (cdr l-args)) (pop-key-tags)))
(when (null? args) (when (null? args)
(error 'echo "found a `~e' with no matching `~e'" :\{ :\})) (error 'echo "found a `~.s' with no matching `~.s'" :\{ :\}))
(let ([arg (getarg)]) (let ([arg (getarg)])
(define (next) (loop (cons arg l-args))) (define (next) (loop (cons arg l-args)))
(cond (cond
@ -1777,18 +1777,18 @@
[(:push) (push-state!)] [(:push) (push-state!)]
[(:pop) (pop-state!)] [(:pop) (pop-state!)]
[(:\{) (process-list)] [(:\{) (process-list)]
[(:\} :^) (error 'echo "unexpected list keyword `~e'" arg)] [(:\} :^) (error 'echo "unexpected list keyword `~.s'" arg)]
[(:k-) (set! keys? #f)] [(:k-) (set! keys? #f)]
[(:k+) (set! keys? #t)] [(:k+) (set! keys? #t)]
[(:set-user :unset-user) [(:set-user :unset-user)
(let loop ([keyword echo:]) (let loop ([keyword echo:])
(if (null? args) (if (null? args)
(error 'echo "expecting a keyword+handler after `~e'" arg) (error 'echo "expecting a keyword+handler after `~.s'" arg)
(let ([x (getarg)]) (let ([x (getarg)])
(cond (cond
[(eq? keyword echo:) (loop x)] [(eq? keyword echo:) (loop x)]
[(not (keyword? keyword)) [(not (keyword? keyword))
(error 'echo "got a `~e' with a non-keyword `~e'" (error 'echo "got a `~.s' with a non-keyword `~.s'"
arg keyword)] arg keyword)]
[(eq? arg :unset-user) [(eq? arg :unset-user)
(hash-table-put! echo-user-table keyword #f)] (hash-table-put! echo-user-table keyword #f)]
@ -1806,7 +1806,7 @@
(cond [(procedure? user) (user args)] (cond [(procedure? user) (user args)]
[(keyword? user) (list* echo: user args)] [(keyword? user) (list* echo: user args)]
[else (cons user args)])) [else (cons user args)]))
(error 'echo "unknown keyword: `~e'" arg)))])] (error 'echo "unknown keyword: `~.s'" arg)))])]
[first? (printer arg out) (set! first? #f)] [first? (printer arg out) (set! first? #f)]
[spaces? (display " " out) (printer arg out) [spaces? (display " " out) (printer arg out)
(unless (eq? spaces? #t) (set! spaces? #f))] (unless (eq? spaces? #t) (set! spaces? #f))]

21
collects/swindle/tiny-clos.rkt
View File

@ -438,7 +438,8 @@
;; (%class-getters-n-setters class)) ;; (%class-getters-n-setters class))
(%class-getters-n-setters class)) (%class-getters-n-setters class))
(raise* make-exn:fail:contract (raise* make-exn:fail:contract
"slot-ref: no slot `~e' in ~e" slot-name class))))) "slot-ref: no slot `~.s' in ~.s"
slot-name class)))))
;;; These are for optimizations - works only for single inheritance! ;;; These are for optimizations - works only for single inheritance!
(define (%slot-getter class slot-name) (define (%slot-getter class slot-name)
@ -560,7 +561,7 @@
(cond [(integer? a) (sub1 a)] (cond [(integer? a) (sub1 a)]
[(arity-at-least? a) [(arity-at-least? a)
(make-arity-at-least (sub1 (arity-at-least-value a)))] (make-arity-at-least (sub1 (arity-at-least-value a)))]
[else (error 'method-arity "the procedure in ~e has bad arity ~e" [else (error 'method-arity "the procedure in ~.s has bad arity ~e"
m a)]))) m a)])))
;;; These versions will be optimized later. ;;; These versions will be optimized later.
@ -784,7 +785,7 @@
(make-setter-locked! (lookup-slot-info <method> slot values) #t (make-setter-locked! (lookup-slot-info <method> slot values) #t
(lambda () (lambda ()
(raise* make-exn:fail:contract (raise* make-exn:fail:contract
"slot-set!: slot `~e' in <method> is locked" slot)))) "slot-set!: slot `~.s' in <method> is locked" slot))))
;;>>... ;;>>...
;;> *** Convenience functions ;;> *** Convenience functions
@ -1591,14 +1592,14 @@
(%instance-set! o f n) (%instance-set! o f n)
(raise* make-exn:fail:contract (raise* make-exn:fail:contract
"slot-set!: wrong type for slot ~ "slot-set!: wrong type for slot ~
~e in ~e (~e not in ~e)" `~.s' in ~e (~e not in ~e)"
(car slot) class n type))) (car slot) class n type)))
(lambda (o n) (%instance-set! o f n))))]) (lambda (o n) (%instance-set! o f n))))])
(when lock (when lock
(make-setter-locked! g+s lock (make-setter-locked! g+s lock
(lambda () (lambda ()
(raise* make-exn:fail:contract (raise* make-exn:fail:contract
"slot-set!: slot `~e' in ~e is locked" "slot-set!: slot `~.s' in ~.s is locked"
(car slot) (%class-name class))))) (car slot) (%class-name class)))))
g+s)] g+s)]
[(:class) [(:class)
@ -1629,14 +1630,14 @@
(raise* (raise*
make-exn:fail:contract make-exn:fail:contract
"slot-set!: wrong type for shared slot ~ "slot-set!: wrong type for shared slot ~
~e in ~e (~e not in ~e)" `~.s' in ~e (~e not in ~e)"
(car slot) class n type) (car slot) class n type)
(set! cell n))))]) (set! cell n))))])
(when lock (when lock
(make-setter-locked! (car slot) g+s lock (make-setter-locked! (car slot) g+s lock
(lambda () (lambda ()
(raise* make-exn:fail:contract (raise* make-exn:fail:contract
"slot-set!: slot `~e' in ~e is locked" "slot-set!: slot `~.s' in ~.s is locked"
(car slot) (%class-name class))))) (car slot) (%class-name class)))))
g+s) g+s)
;; the slot was inherited as :class - fetch its getters/setters ;; the slot was inherited as :class - fetch its getters/setters
@ -1646,7 +1647,7 @@
[else (loop (cdr cpl))])))] [else (loop (cdr cpl))])))]
[else [else
(error 'class (error 'class
"allocation for ~e must be :class or :instance, got ~e" "allocation for `~.s' must be :class or :instance, got ~e"
(car slot) allocation)])))))) (car slot) allocation)]))))))
;;; Use the previous function when populating this generic. ;;; Use the previous function when populating this generic.
@ -1783,7 +1784,7 @@
;;; class-names (in case of unnamed-methods in clos.ss). ;;; class-names (in case of unnamed-methods in clos.ss).
(define (compute-method-name specs generic-name) (define (compute-method-name specs generic-name)
(define (spec-string spec) (define (spec-string spec)
(cond [(%singleton? spec) (format "{~e}" (singleton-value spec))] (cond [(%singleton? spec) (format "{~.s}" (singleton-value spec))]
[(%class? spec) (symbol->string [(%class? spec) (symbol->string
(%class-name (%struct->class spec)))] (%class-name (%struct->class spec)))]
[else "???"])) [else "???"]))
@ -1809,7 +1810,7 @@
;; note: equal? works on arity-at-least structs ;; note: equal? works on arity-at-least structs
[(not (equal? generic-arity method-arity)) [(not (equal? generic-arity method-arity))
(error 'add-method (error 'add-method
"wrong arity for `~e', expects ~a; given a method with ~a" "wrong arity for `~.s', expects ~a; given a method with ~a"
(%generic-name generic) (%generic-name generic)
(if (integer? generic-arity) (if (integer? generic-arity)
generic-arity generic-arity

2
collects/syntax/zodiac-unit.rkt
View File

@ -499,7 +499,7 @@
[_else [_else
(error 'syntax->zodiac (error 'syntax->zodiac
"unrecognized expression form: ~e" "unrecognized expression form: ~.s"
(syntax->datum stx))])))) (syntax->datum stx))]))))

2
collects/tests/scribble/reader.rkt
View File

@ -871,7 +871,7 @@ END-OF-TESTS
[(column=) syntax-column] [(column=) syntax-column]
[(position=) syntax-position] [(position=) syntax-position]
[(span=) syntax-span] [(span=) syntax-span]
[else (error 'syntax-test "unknown test form: ~e" (car y))]) [else (error 'syntax-test "unknown test form: ~.s" (car y))])
x) x)
(cadr y)) (cadr y))
(check-stx x (cddr y))] (check-stx x (cddr y))]

2
collects/tests/stepper/test-engine.rkt
View File

@ -259,7 +259,7 @@
(if (equal? actual expected) (if (equal? actual expected)
#t #t
(begin (warn error-box 'not-equal? (begin (warn error-box 'not-equal?
"~e:\nactual: ~e =/= \nexpected: ~e\n here's the diff: ~e" name actual expected (sexp-diff actual expected)) "~.s:\nactual: ~e =/= \nexpected: ~e\n here's the diff: ~e" name actual expected (sexp-diff actual expected))
#f))) #f)))

2
collects/tests/stepper/through-tests.rkt
View File

@ -55,7 +55,7 @@
(let ([maybe-test (assq name list-of-tests)]) (let ([maybe-test (assq name list-of-tests)])
(if maybe-test (if maybe-test
(run-one-test/helper maybe-test) (run-one-test/helper maybe-test)
(error 'run-test "test not found: ~e" name)))) (error 'run-test "test not found: ~.s" name))))
(define (run-tests names) (define (run-tests names)
(ormap/no-shortcut run-test names)) (ormap/no-shortcut run-test names))

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

@ -54,7 +54,7 @@ don't depend on any other portion of the system
(and (syntax-transforming?) (syntax-original? (syntax-local-introduce e))) (and (syntax-transforming?) (syntax-original? (syntax-local-introduce e)))
#;(and (orig-module-stx) (eq? (debugf syntax-source-module e) (debugf syntax-source-module (orig-module-stx)))) #;(and (orig-module-stx) (eq? (debugf syntax-source-module e) (debugf syntax-source-module (orig-module-stx))))
#;(syntax-source-module stx)) #;(syntax-source-module stx))
(log-message l 'warning (format "Typed Scheme has detected unreachable code: ~e" (syntax->datum (locate-stx e))) (log-message l 'warning (format "Typed Scheme has detected unreachable code: ~.s" (syntax->datum (locate-stx e)))
e)))) e))))
(define (locate-stx stx) (define (locate-stx stx)

2
collects/unstable/generics.rkt
View File

@ -173,7 +173,7 @@
... ...
[(_ new-name method-name) [(_ new-name method-name)
(raise-syntax-error 'define/generic (raise-syntax-error 'define/generic
(format "~e not a method of ~e" (format "~.s not a method of ~.s"
(syntax->datum #'method-name) (syntax->datum #'method-name)
'generics) 'generics)
stx stx

6
collects/web-server/lang/closure.rkt
View File

@ -9,15 +9,15 @@
(define make-CLOSURE-box (define make-CLOSURE-box
(syntax-local-lift-expression (syntax-local-lift-expression
(quasisyntax/loc stx (quasisyntax/loc stx
(box (lambda (env) (error 'make-CLOSURE "Closure<~e> not initialized" '#,label)))))) (box (lambda (env) (error 'make-CLOSURE "Closure<~.s> not initialized" '#,label))))))
(define CLOSURE-set-env!-box (define CLOSURE-set-env!-box
(syntax-local-lift-expression (syntax-local-lift-expression
(quasisyntax/loc stx (quasisyntax/loc stx
(box (lambda (clsr new-env) (error 'CLOSURE-set-env! "Closure<~e> not initialized" '#,label)))))) (box (lambda (clsr new-env) (error 'CLOSURE-set-env! "Closure<~.s> not initialized" '#,label))))))
(define CLOSURE-env-box (define CLOSURE-env-box
(syntax-local-lift-expression (syntax-local-lift-expression
(quasisyntax/loc stx (quasisyntax/loc stx
(box (lambda (clsr) (error 'CLOSURE-env "Closure<~e> not initialized" '#,label)))))) (box (lambda (clsr) (error 'CLOSURE-env "Closure<~.s> not initialized" '#,label))))))
; Define the deserializer (req closure struct values under lambdas) ; Define the deserializer (req closure struct values under lambdas)
(define CLOSURE:deserialize-info-id (define CLOSURE:deserialize-info-id
(syntax-local-lift-expression (syntax-local-lift-expression

2
collects/web-server/lang/web-cells.rkt
View File

@ -49,7 +49,7 @@
(hash-ref (hash-ref
(frame-env (current-frame)) i (frame-env (current-frame)) i
(lambda () (lambda ()
(error 'web-cell "Undefined web-cell: ~e" i)))) (error 'web-cell "Undefined web-cell: ~.s" i))))
(define (web-cell-shadow wc nv) (define (web-cell-shadow wc nv)
(update-frame! (update-frame!

2
collects/web-server/servlet/web-cells.rkt
View File

@ -35,7 +35,7 @@
(hash-ref (hash-ref
(frame-env (current-frame)) i (frame-env (current-frame)) i
(lambda () (lambda ()
(error 'web-cell "Undefined web-cell: ~e" i)))) (error 'web-cell "Undefined web-cell: ~.s" i))))
(define (web-cell-shadow wc nv) (define (web-cell-shadow wc nv)
(update-frame! (update-frame!