diff --git a/collects/compiler/cffi.rkt b/collects/compiler/cffi.rkt index d18cc1cf21..e79280e2f4 100644 --- a/collects/compiler/cffi.rkt +++ b/collects/compiler/cffi.rkt @@ -298,7 +298,7 @@ (raise-syntax-error 'c-declare "declaration is not a string" stx decl)) (let ([stx-out (syntax (error 'c-declare - "declaration not compiled by mzc: ~e" + "declaration not compiled by mzc: ~.s" str))]) (syntax-property stx-out 'mzc-cffi 'c-declare)))])) diff --git a/collects/compiler/src2src.rkt b/collects/compiler/src2src.rkt index c8d0a8af1f..4cf3d606d2 100644 --- a/collects/compiler/src2src.rkt +++ b/collects/compiler/src2src.rkt @@ -1583,7 +1583,7 @@ (syntax-position stx))]) (fprintf (current-output-port) " ")) (fprintf (current-output-port) - "~a: ~e~n" + "~a: ~.s~n" msg (syntax->datum (send exp sexpr))))) diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index ed2541fdaf..51b844e775 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -530,7 +530,7 @@ (match v [`#((,datum . ,wraps) ,cert-marks) (values cert-marks 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)] [marks (decode-marks cp cert-marks)] [add-wrap (lambda (v) (make-wrapped v wraps marks))]) diff --git a/collects/drracket/private/language-configuration.rkt b/collects/drracket/private/language-configuration.rkt index 17fc2c1131..e676ea650a 100644 --- a/collects/drracket/private/language-configuration.rkt +++ b/collects/drracket/private/language-configuration.rkt @@ -86,7 +86,7 @@ (for-each (λ (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)) (ensure-no-duplicate-numbers language languages) @@ -558,7 +558,7 @@ (= (length positions) (length numbers)) ((length numbers) . >= . 1)) (error 'drracket:language - "languages position and numbers must be lists of strings and numbers, respectively, must have the same length, and must each contain at least one element, got: ~e ~e" + "languages position and numbers must be lists of strings and numbers, respectively, must have the same length, and must each contain at least one element, got: ~e ~e" positions numbers)) (when (null? (cdr positions)) diff --git a/collects/drracket/private/syncheck/traversals.rkt b/collects/drracket/private/syncheck/traversals.rkt index 992f5d745d..d1643a9b0d 100644 --- a/collects/drracket/private/syncheck/traversals.rkt +++ b/collects/drracket/private/syncheck/traversals.rkt @@ -420,7 +420,7 @@ [_ (begin #; - (printf "unknown stx: ~e datum: ~e source: ~e\n" + (printf "unknown stx: ~.s datum: ~e source: ~e\n" sexp (and (syntax? sexp) (syntax->datum sexp)) diff --git a/collects/errortrace/errortrace-lib.rkt b/collects/errortrace/errortrace-lib.rkt index 98a13d30f9..87152badda 100644 --- a/collects/errortrace/errortrace-lib.rkt +++ b/collects/errortrace/errortrace-lib.rkt @@ -356,12 +356,11 @@ [line (syntax-line stx)] [col (syntax-column stx)] [pos (syntax-position stx)]) - (fprintf p "~a~a: ~e~n" + (fprintf p "~a~a: ~.s\n" (or file "[unknown source]") - (cond - [line (format ":~a:~a" line col)] - [pos (format "::~a" pos)] - [else ""]) + (cond [line (format ":~a:~a" line col)] + [pos (format "::~a" pos)] + [else ""]) (syntax->datum stx)) (loop (- n 1) (cdr l)))]))) diff --git a/collects/errortrace/stacktrace.rkt b/collects/errortrace/stacktrace.rkt index 42c1faecc6..2807ba70c4 100644 --- a/collects/errortrace/stacktrace.rkt +++ b/collects/errortrace/stacktrace.rkt @@ -201,7 +201,7 @@ [_else (error 'errortrace - "unrecognized (non-top-level) expression form: ~e" + "unrecognized (non-top-level) expression form: ~.s" (syntax->datum sexpr))]))) (define (profile-annotate-lambda name expr clause bodys-stx phase) @@ -564,7 +564,7 @@ annotate phase)))])] [_else - (error 'errortrace "unrecognized expression form~a: ~e" + (error 'errortrace "unrecognized expression form~a: ~.s" (if top? " at top-level" "") (syntax->datum expr))]) expr diff --git a/collects/ffi/unsafe.rkt b/collects/ffi/unsafe.rkt index a49857dc89..3f939313a7 100644 --- a/collects/ffi/unsafe.rkt +++ b/collects/ffi/unsafe.rkt @@ -502,7 +502,7 @@ (lambda (k) (cond [(assq k ks) => cdr] [(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]) (let ([k (if (syntax? k-stx) (syntax-e k-stx) k-stx)]) (cond [(assq k ks) diff --git a/collects/framework/preferences.rkt b/collects/framework/preferences.rkt index dbec958481..25bd438b40 100644 --- a/collects/framework/preferences.rkt +++ b/collects/framework/preferences.rkt @@ -141,7 +141,7 @@ the state transitions / contracts are: (let ([default (hash-ref defaults p)]) (unless ((default-checker default) value) (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)) (check-callbacks p value) (hash-set! preferences p value))] diff --git a/collects/framework/private/color.rkt b/collects/framework/private/color.rkt index f6a5dd6d8d..281844f39f 100644 --- a/collects/framework/private/color.rkt +++ b/collects/framework/private/color.rkt @@ -918,15 +918,15 @@ added get-regions (let* ((x null) (f (λ (a b c) (set! x (cons (list a b c) x))))) (send (lexer-state-tokens ls) for-each f) - (printf "tokens: ~e~n" (reverse x)) + (printf "tokens: ~.s~n" (reverse x)) (set! x null) (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" (lexer-state-start-pos ls) (lexer-state-current-pos 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)) ;; ------------------------- Callbacks to Override ---------------------- diff --git a/collects/framework/test.rkt b/collects/framework/test.rkt index ac0c21c7f5..2fc91530a5 100644 --- a/collects/framework/test.rkt +++ b/collects/framework/test.rkt @@ -267,7 +267,7 @@ (send panel get-children)))]) (or found (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 b-desc)))] [(is-a? b-desc obj-class) b-desc] @@ -289,11 +289,11 @@ [ctrl (find-ctrl)]) (cond [(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?)) - (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)) - (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 (update-control ctrl) (send ctrl command event) diff --git a/collects/games/parcheesi/admin-gui.rkt b/collects/games/parcheesi/admin-gui.rkt index ab8c480284..c6db9d1259 100644 --- a/collects/games/parcheesi/admin-gui.rkt +++ b/collects/games/parcheesi/admin-gui.rkt @@ -269,7 +269,7 @@ corresponds to the unplayed move! that's confusing. (update-players-dice (past-color past) (past-roll past)) (send board-pasteboard set-board (past-board past)) (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-forw-back-buttons)) diff --git a/collects/games/show-scribbling.rkt b/collects/games/show-scribbling.rkt index 8d8d2efcf8..5ad4fbe5ea 100644 --- a/collects/games/show-scribbling.rkt +++ b/collects/games/show-scribbling.rkt @@ -19,5 +19,4 @@ (if path (let ([u (path->url path)]) (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)))))) diff --git a/collects/handin-client/client-gui.rkt b/collects/handin-client/client-gui.rkt index b7e31c5da4..6166858781 100644 --- a/collects/handin-client/client-gui.rkt +++ b/collects/handin-client/client-gui.rkt @@ -273,10 +273,8 @@ (lambda () (let* ([msg (if (exn? exn) (let ([s (exn-message exn)]) - (if (string? s) - s - (format "~e" s))) - (format "~e" exn))] + (if (string? s) s (format "~.s" s))) + (format "~.s" exn))] [retry? (regexp-match #rx"bad username or password for" msg)]) (custodian-shutdown-all comm-cust) (set! committing? #f) @@ -541,8 +539,8 @@ (message-box "Server Error" (if (exn? exn) - (let ([s (exn-message exn)]) (if (string? s) s (format "~e" s))) - (format "~e" exn)) + (let ([s (exn-message exn)]) (if (string? s) s (format "~.s" s))) + (format "~.s" exn)) this) (set! comm-cust (make-custodian)))))) diff --git a/collects/handin-server/checker.rkt b/collects/handin-server/checker.rkt index 7b41398e59..328c25339f 100644 --- a/collects/handin-server/checker.rkt +++ b/collects/handin-server/checker.rkt @@ -674,7 +674,7 @@ (error* "missing binding: ~.s" (->disp 'id)))] [exn:fail:syntax? (lambda (_) - (error* "bound to a syntax, expecting a value: ~e" + (error* "bound to a syntax, expecting a value: ~.s" (->disp 'id)))]) (parameterize ([current-namespace (get-namespace (submission-eval))]) (namespace-variable-value `id))) @@ -698,7 +698,7 @@ (syntax-rules () [(_ 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) (let ([ar arity] [val ((submission-eval) `expr)]) diff --git a/collects/handin-server/main.rkt b/collects/handin-server/main.rkt index 6eac919199..6d31392f5b 100644 --- a/collects/handin-server/main.rkt +++ b/collects/handin-server/main.rkt @@ -650,7 +650,7 @@ (lambda (exn) (let ([msg (if (exn? exn) (exn-message exn) - (format "~e" exn))]) + (format "~.s" exn))]) (kill-watcher) (log-line "ERROR: ~a" msg) (write+flush w msg) diff --git a/collects/handin-server/scribblings/checker.scrbl b/collects/handin-server/scribblings/checker.scrbl index 5615bff470..a0c9578514 100644 --- a/collects/handin-server/scribblings/checker.scrbl +++ b/collects/handin-server/scribblings/checker.scrbl @@ -173,7 +173,8 @@ Keywords for configuring @scheme[check:]: report an error that occurred during evaluation of the submitted 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 - @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 default is @scheme["Error in your code --\n~a"]. Useful examples of these messages: diff --git a/collects/handin-server/utils.rkt b/collects/handin-server/utils.rkt index ce52d24aee..c69a5db5ab 100644 --- a/collects/handin-server/utils.rkt +++ b/collects/handin-server/utils.rkt @@ -81,7 +81,7 @@ (with-handlers ([void (lambda (exn) (error (if (exn? exn) (exn-message exn) - (format "exception: ~e" exn))))]) + (format "exception: ~.s" exn))))]) (thunk))) ;; ---------------------------------------- @@ -119,7 +119,7 @@ (with-handlers ([void (lambda (x) (error - (format "instructor-supplied test ~a failed with an error: ~e" + (format "instructor-supplied test ~a failed with an error: ~.s" (format-history test) (exn-message x))))]) (let ([val (e `(,f ,@(map value-converter args)))]) diff --git a/collects/help/help-utils.rkt b/collects/help/help-utils.rkt index 32b5c19655..67e7ec58bd 100644 --- a/collects/help/help-utils.rkt +++ b/collects/help/help-utils.rkt @@ -43,7 +43,7 @@ (if tag (go-to-tag xref tag) (error 'help - "no documentation found for: ~e provided by: ~a" + "no documentation found for: ~.s provided by: ~a" (syntax-e id) (module-path-index-resolve (caddr b))))) (search-for-exports xref (syntax-e id) any-b)))) diff --git a/collects/macro-debugger/model/reductions-config.rkt b/collects/macro-debugger/model/reductions-config.rkt index cb3cfcbce8..283167af7a 100644 --- a/collects/macro-debugger/model/reductions-config.rkt +++ b/collects/macro-debugger/model/reductions-config.rkt @@ -286,11 +286,11 @@ ;; Only bad effect should be missed subterms (usually at phase1). (STRICT-CHECKS (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 to)) (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 to0)) (error 'add-to-renames-table)) diff --git a/collects/macro-debugger/model/reductions-engine.rkt b/collects/macro-debugger/model/reductions-engine.rkt index f02f0888c4..c51b318323 100644 --- a/collects/macro-debugger/model/reductions-engine.rkt +++ b/collects/macro-debugger/model/reductions-engine.rkt @@ -289,9 +289,9 @@ [(R** f v p s ws [#:print-state msg] . more) #'(begin (printf "** ~s\n" msg) - (printf "f = ~e\n" (stx->datum f)) - (printf "v = ~e\n" (stx->datum v)) - (printf "s = ~e\n" (stx->datum s)) + (printf "f = ~.s\n" (stx->datum f)) + (printf "v = ~.s\n" (stx->datum v)) + (printf "s = ~.s\n" (stx->datum s)) (R** f v p s ws . more))] ;; ** Multi-pass reductions ** @@ -365,10 +365,10 @@ [fills fills-e]) (DEBUG (printf "Run (multi, vis=~s)\n" (visibility)) - (printf " f: ~e\n" (stx->datum f)) - (printf " v: ~e\n" (stx->datum v)) - (printf " p: ~e\n" 'p) - (printf " hole: ~e\n" '(hole :::)) + (printf " f: ~.s\n" (stx->datum f)) + (printf " v: ~.s\n" (stx->datum v)) + (printf " p: ~.s\n" 'p) + (printf " hole: ~.s\n" '(hole :::)) (print-viable-subterms v)) (if (visibility) (let ([vctx (CC (hole :::) v p)] @@ -381,10 +381,10 @@ [fctx (CC hole f p)]) (DEBUG (printf "Run (single, vis=~s)\n" (visibility)) - (printf " f: ~e\n" (stx->datum f)) - (printf " v: ~e\n" (stx->datum v)) - (printf " p: ~e\n" 'p) - (printf " hole: ~e\n" 'hole) + (printf " f: ~.s\n" (stx->datum f)) + (printf " v: ~.s\n" (stx->datum v)) + (printf " p: ~.s\n" 'p) + (printf " hole: ~.s\n" 'hole) (print-viable-subterms v)) (if (visibility) (let ([vctx (CC hole v p)] @@ -396,8 +396,8 @@ (define (run-one reducer init-e fctx vsub vctx fill s ws k) (DEBUG (printf "run-one\n") - (printf " fctx: ~e\n" (stx->datum (fctx #'HOLE))) - (printf " vctx: ~e\n" (stx->datum (vctx #'HOLE)))) + (printf " fctx: ~.s\n" (stx->datum (fctx #'HOLE))) + (printf " vctx: ~.s\n" (stx->datum (vctx #'HOLE)))) (RSbind (with-context vctx ((reducer fill) init-e vsub s ws)) (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) (DEBUG (printf "run-multiple/visible\n") - (printf " fctx: ~e\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE)))) - (printf " vctx: ~e\n" (stx->datum (vctx (for/list ([dummy init-e1s]) #'HOLE)))) + (printf " fctx: ~.s\n" (stx->datum (fctx (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)) - (printf " fills(~s): ~e\n" (length fills) fills) - (printf " init-e1s: ~s\n" (stx->datum init-e1s)) - (printf " vsubs: ~s\n" (stx->datum vsubs)))) + (printf " fills(~s): ~.s\n" (length fills) fills) + (printf " init-e1s: ~.s\n" (stx->datum init-e1s)) + (printf " vsubs: ~.s\n" (stx->datum vsubs)))) (let loop ([fills fills] [prefix null] [vprefix null] [suffix init-e1s] [vsuffix vsubs] [s s] [ws ws]) (cond [(pair? fills) @@ -432,10 +432,10 @@ (define (run-multiple/nonvisible reducer init-e1s fctx v fills s ws k) (DEBUG (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]) (DEBUG - (printf " v: ~e\n" (stx->datum (datum->syntax #f v)))) + (printf " v: ~.s\n" (stx->datum (datum->syntax #f v)))) (cond [(pair? fills) (RSbind ((reducer (car fills)) (car suffix) v s ws) @@ -468,7 +468,7 @@ (cond [(and (not new-visible?) (or (visibility) reset-subterms?)) (begin (DEBUG - (printf "hide => seek: ~e\n" (stx->datum stx))) + (printf "hide => seek: ~.s\n" (stx->datum stx))) (current-pass-hides? #t) (let* ([subterms (gather-proper-subterms stx)] [marking (marking-table)] @@ -496,11 +496,11 @@ (k vstx) (let ([paths (table-get (subterms-table) stx)]) (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)] [(null? (cdr 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))]) (RScase (parameterize ((visibility #t) (subterms-table #f) @@ -538,16 +538,16 @@ [same-form? (equal? actual-datum expected-datum)]) (if same-form? (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 (wrongness actual expected)) (fprintf (current-error-port) - "got:\n~s\n\nexpected:\n~e\n" + "got:\n~.s\n\nexpected:\n~.s\n" actual-datum expected-datum)) (for ([d derivs]) (fprintf (current-error-port) - "\n~e\n" d)) + "\n~.s\n" d)) (error function (if same-form? "wrong starting point (wraps)!" diff --git a/collects/meta/build/bundle b/collects/meta/build/bundle index 48c27820c6..b119d376c4 100755 --- a/collects/meta/build/bundle +++ b/collects/meta/build/bundle @@ -192,9 +192,9 @@ (reverse r) (let* ([bin (car bins)] [src (get-tag bin)]) (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))) - (error 'binaries "bad type assignment for `~e': ~e" bin src)] + (error 'binaries "bad type assignment for `~.s': ~.s" bin src)] [else (loop (cdr bins) (if (memq (car src) r) r (cons (car src) r)))]))))) (dprintf "Scanning full tgzs") @@ -374,7 +374,7 @@ (let ([rx (expand-spec spec)]) (if (and (pair? rx) (null? (cdr rx)) (string? (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 throw-pattern (get-pattern 'binary-throw)) (define keep-rx (regexpify-spec (string-append "*" keep-pattern "*"))) diff --git a/collects/meta/checker.rkt b/collects/meta/checker.rkt index 0601bc512d..8a5acc53d5 100644 --- a/collects/meta/checker.rkt +++ b/collects/meta/checker.rkt @@ -423,7 +423,7 @@ ;; first. => (lambda (p) (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. (define (spec->filter spec) @@ -431,7 +431,7 @@ (if (= 1 (length specs)) (primitive-spec->filter (car specs)) (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)))) ;;; =========================================================================== diff --git a/collects/meta/props b/collects/meta/props index 1f4a07a300..f334b3cf68 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -120,7 +120,7 @@ path/s is either such a string or a list of them. ;; script? (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) pname ; might happen when `set-prop!' calls `get-prop' (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) ;; new path, find the node or create if none (loop (tree-find x #t) #f)] - [(find-prop #f x "bad datum `~e'") + [(find-prop #f x "bad datum `~.s'") ;; new prop (loop (or tree (malformed "initial property has no path")) 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'")) xs))))) (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) ""] [(not (list? cmd)) (bad)] [else (string-join (map (lambda (x) diff --git a/collects/meta/specs.rkt b/collects/meta/specs.rkt index 8dfc9c4f99..87eebd9764 100644 --- a/collects/meta/specs.rkt +++ b/collects/meta/specs.rkt @@ -151,7 +151,7 @@ ;; spec -> spec-list, the input is always a cond spec (define (expand-cond-spec spec) (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] [(pair? c) (case (car c) @@ -180,12 +180,12 @@ [(eq? 'tag (car spec)) (if (pair? (cdr 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)) (if (pair? (cdr spec)) (list (eval `(lambda ,(cadr spec) (splice (list ,@(cddr spec)))))) - (error 'expand-spec "bad `lambda' form: ~e" spec))] + (error 'expand-spec "bad `lambda' form: ~.s" spec))] [(procedure? (car spec)) (let ([newspec (apply (car spec) (expand-specs (cdr spec)))]) (cond [(spliced? newspec) (expand-specs (cdr newspec))] @@ -212,7 +212,7 @@ (let ([r (expand-spec spec)]) (if (= 1 (length 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)))) ;; Expand tags @@ -234,5 +234,5 @@ (let ([r (expand-specs conds)]) (if (= 1 (length 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)))))) diff --git a/collects/mzlib/kw.rkt b/collects/mzlib/kw.rkt index 105cc807c3..66456276c1 100644 --- a/collects/mzlib/kw.rkt +++ b/collects/mzlib/kw.rkt @@ -331,7 +331,7 @@ #`((if (and in-seen? in-keys?) #,(if allow-duplicate-keys? #`seen-keys - #`(error* 'name "duplicate keyword: ~e" + #`(error* 'name "duplicate keyword: ~.s" (car body*))) (cons (car body*) seen-keys))) '()))]) @@ -343,12 +343,12 @@ nl #`(if in-keys? #,nl - (error* 'name "unknown keyword: ~e" + (error* 'name "unknown keyword: ~.s" (car body*)))))] [(not allow-other-keys?) #`(if (memq (car body*) 'keywords) #,nl - (error* 'name "unknown keyword: ~e" + (error* 'name "unknown keyword: ~.s" (car body*)))] [else nl]))] [expr @@ -381,7 +381,7 @@ #'next-loop #'(if (pair? (cdr body*)) next-loop - (error* 'name "keyword list not balanced: ~e" rest*))) + (error* 'name "keyword list not balanced: ~.s" rest*))) #,(if allow-body? (if (and body (not (identifier? body))) (with-syntax ([name (string->symbol @@ -395,7 +395,7 @@ #'expr) #'(if (null? body*) expr - (error* 'name "expecting a ~s keyword got: ~e" + (error* 'name "expecting a ~s keyword got: ~.s" 'keywords (car body*)))))))))) ;; ------------------------------------------------------------------------ ;; generates the loop that turns flags to #t's @@ -456,7 +456,7 @@ (syntax/loc stx (lambda vars (if (and (pair? body) (keyword? (car body))) - (error* 'name "unknown keyword: ~e" (car body)) + (error* 'name "unknown keyword: ~.s" (car body)) expr)))))] ;; no keys => make a case-lambda for optionals [(and (null? keys) (not (or body allow-other-keys?))) diff --git a/collects/mzlib/runtime-path.rkt b/collects/mzlib/runtime-path.rkt index e1ec2f8a38..a8c2891272 100644 --- a/collects/mzlib/runtime-path.rkt +++ b/collects/mzlib/runtime-path.rkt @@ -85,7 +85,7 @@ (null? (cdr strs))) (list "mzlib") (append (cddr p) (drop-right strs 1)))))] - [else (error 'runtime-path "unknown form: ~e" p)]))) + [else (error 'runtime-path "unknown form: ~.s" p)]))) paths))) (define-for-syntax (register-ext-files tag-stx paths) diff --git a/collects/mzlib/unit.rkt b/collects/mzlib/unit.rkt index b4438f157d..22b3c67d4a 100644 --- a/collects/mzlib/unit.rkt +++ b/collects/mzlib/unit.rkt @@ -843,7 +843,7 @@ (names (apply append nameses)) (dup (check-duplicate-identifier names))) (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 (provide #,@names)))))) @@ -1652,7 +1652,7 @@ (tmp-bindings (map (λ (s) (map tmarker (map car (car s)))) out-sigs)) (def-table (make-bound-identifier-mapping))) (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 (λ (sig new-xs) (for-each diff --git a/collects/planet/parsereq.rkt b/collects/planet/parsereq.rkt index 85bbeb5186..55890e65be 100644 --- a/collects/planet/parsereq.rkt +++ b/collects/planet/parsereq.rkt @@ -76,7 +76,7 @@ tail (string-append tail ".ss")))]) (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) ;; extracts the named package from the given short-style string, returning diff --git a/collects/racket/contract/private/opt.rkt b/collects/racket/contract/private/opt.rkt index 20cf5174a8..2e4767eaa1 100644 --- a/collects/racket/contract/private/opt.rkt +++ b/collects/racket/contract/private/opt.rkt @@ -50,7 +50,7 @@ (λ (opt/i opt/info stx) expr ...))) (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 diff --git a/collects/racket/private/promise.rkt b/collects/racket/private/promise.rkt index 973328be39..800b2a66a3 100644 --- a/collects/racket/private/promise.rkt +++ b/collects/racket/private/promise.rkt @@ -245,7 +245,7 @@ #:property prop:procedure (lambda (this) (let ([name (running-name this)]) (if name - (error 'force "reentrant promise ~e" name) + (error 'force "reentrant promise ~.s" name) (error 'force "reentrant promise"))))) ;; ---------------------------------------------------------------------------- diff --git a/collects/scribble/racket.rkt b/collects/scribble/racket.rkt index 8029f4eb5c..62ef079876 100644 --- a/collects/scribble/racket.rkt +++ b/collects/scribble/racket.rkt @@ -441,7 +441,7 @@ (let ([l (syntax->list c)] [h? highlight?]) (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!) (set! src-col (syntax-column (cadr l))) (hash-set! next-col-map src-col dest-col) diff --git a/collects/stepper/private/macro-unwind.rkt b/collects/stepper/private/macro-unwind.rkt index ff32fbff3c..abc58e0144 100644 --- a/collects/stepper/private/macro-unwind.rkt +++ b/collects/stepper/private/macro-unwind.rkt @@ -159,14 +159,14 @@ "unknown value for syntax property 'stepper-define-type: ~e" define-type)])] [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))]) #`(define #,printed-name #,unwound-body))) ;; this is there just to see the unsupported stuff go by... #`(define-values (name . others) #,(unwind #'body settings)) )] [else (error 'unwind-define - "expression is not a define-values: ~e" + "expression is not a define-values: ~.s" (syntax->datum stx))])) (define (unwind-mz-let stx settings) @@ -216,7 +216,7 @@ #`((define-values vars exp) ...)))]) #`(local defns #,(unwind #'body settings)))] [else (error 'unwind-local - "expected a letrec-values, given: ~e" + "expected a letrec-values, given: ~.s" (syntax->datum stx))])) ;(define (unwind-quasiquote-the-cons-application stx settings) @@ -257,10 +257,10 @@ [(begin . rest) null] [else-stx (error 'unwind-cond - "expected an if, got: ~e" + "expected an if, got: ~.s" (syntax->datum (syntax else-stx)))]) (error 'unwind-cond - "expected a cond clause expansion, got: ~e" + "expected a cond clause expansion, got: ~.s" (syntax->datum stx))))]) (syntax (cond . clauses))))) diff --git a/collects/stepper/private/reconstruct.rkt b/collects/stepper/private/reconstruct.rkt index e62a71084d..927f6d9e5c 100644 --- a/collects/stepper/private/reconstruct.rkt +++ b/collects/stepper/private/reconstruct.rkt @@ -180,7 +180,7 @@ ([non-lexical] varref) (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) varref)))))))) @@ -931,7 +931,7 @@ (apply append (map syntax->list (syntax->list #`(vars ...))))] [(let-values ([vars . rest] ...) . bodies) (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))])] [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) diff --git a/collects/stepper/private/xml-box.rkt b/collects/stepper/private/xml-box.rkt index d58d493f04..69a4d200f6 100644 --- a/collects/stepper/private/xml-box.rkt +++ b/collects/stepper/private/xml-box.rkt @@ -15,7 +15,7 @@ (rewrite-xml-box stx rewrite-other)) (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) [(from-scheme-box from-splice-box) (rewrite-other stx)] @@ -56,9 +56,6 @@ 'from-xml-box)] [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) stx)]))) - - - diff --git a/collects/swindle/misc.rkt b/collects/swindle/misc.rkt index d11fd14a9f..c35e99ffcf 100644 --- a/collects/swindle/misc.rkt +++ b/collects/swindle/misc.rkt @@ -1651,10 +1651,10 @@ (arity-at-least-value arity))] [required (or at-least arity)]) (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) (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) (if at-least (values args '()) @@ -1724,7 +1724,7 @@ (when (and (pair? l-args) (eq? echo: (car l-args))) (set! l-args (cdr l-args)) (pop-key-tags))) (when (null? args) - (error 'echo "found a `~e' with no matching `~e'" :\{ :\})) + (error 'echo "found a `~.s' with no matching `~.s'" :\{ :\})) (let ([arg (getarg)]) (define (next) (loop (cons arg l-args))) (cond @@ -1777,18 +1777,18 @@ [(:push) (push-state!)] [(:pop) (pop-state!)] [(:\{) (process-list)] - [(:\} :^) (error 'echo "unexpected list keyword `~e'" arg)] + [(:\} :^) (error 'echo "unexpected list keyword `~.s'" arg)] [(:k-) (set! keys? #f)] [(:k+) (set! keys? #t)] [(:set-user :unset-user) (let loop ([keyword echo:]) (if (null? args) - (error 'echo "expecting a keyword+handler after `~e'" arg) + (error 'echo "expecting a keyword+handler after `~.s'" arg) (let ([x (getarg)]) (cond [(eq? keyword echo:) (loop x)] [(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)] [(eq? arg :unset-user) (hash-table-put! echo-user-table keyword #f)] @@ -1806,7 +1806,7 @@ (cond [(procedure? user) (user args)] [(keyword? user) (list* echo: 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)] [spaces? (display " " out) (printer arg out) (unless (eq? spaces? #t) (set! spaces? #f))] diff --git a/collects/swindle/tiny-clos.rkt b/collects/swindle/tiny-clos.rkt index a0490e49b0..2ce99980b9 100644 --- a/collects/swindle/tiny-clos.rkt +++ b/collects/swindle/tiny-clos.rkt @@ -438,7 +438,8 @@ ;; (%class-getters-n-setters class)) (%class-getters-n-setters class)) (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! (define (%slot-getter class slot-name) @@ -560,7 +561,7 @@ (cond [(integer? a) (sub1 a)] [(arity-at-least? 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)]))) ;;; These versions will be optimized later. @@ -784,7 +785,7 @@ (make-setter-locked! (lookup-slot-info slot values) #t (lambda () (raise* make-exn:fail:contract - "slot-set!: slot `~e' in is locked" slot)))) + "slot-set!: slot `~.s' in is locked" slot)))) ;;>>... ;;> *** Convenience functions @@ -1591,14 +1592,14 @@ (%instance-set! o f n) (raise* make-exn:fail:contract "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))) (lambda (o n) (%instance-set! o f n))))]) (when lock (make-setter-locked! g+s lock (lambda () (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))))) g+s)] [(:class) @@ -1629,14 +1630,14 @@ (raise* make-exn:fail:contract "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) (set! cell n))))]) (when lock (make-setter-locked! (car slot) g+s lock (lambda () (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))))) g+s) ;; the slot was inherited as :class - fetch its getters/setters @@ -1646,7 +1647,7 @@ [else (loop (cdr cpl))])))] [else (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)])))))) ;;; Use the previous function when populating this generic. @@ -1783,7 +1784,7 @@ ;;; class-names (in case of unnamed-methods in clos.ss). (define (compute-method-name specs generic-name) (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-name (%struct->class spec)))] [else "???"])) @@ -1809,7 +1810,7 @@ ;; note: equal? works on arity-at-least structs [(not (equal? generic-arity method-arity)) (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) (if (integer? generic-arity) generic-arity diff --git a/collects/syntax/zodiac-unit.rkt b/collects/syntax/zodiac-unit.rkt index 46e970f9c3..cddec1f527 100644 --- a/collects/syntax/zodiac-unit.rkt +++ b/collects/syntax/zodiac-unit.rkt @@ -499,7 +499,7 @@ [_else (error 'syntax->zodiac - "unrecognized expression form: ~e" + "unrecognized expression form: ~.s" (syntax->datum stx))])))) diff --git a/collects/tests/scribble/reader.rkt b/collects/tests/scribble/reader.rkt index 53ea81e3b4..2eefa2d52e 100644 --- a/collects/tests/scribble/reader.rkt +++ b/collects/tests/scribble/reader.rkt @@ -871,7 +871,7 @@ END-OF-TESTS [(column=) syntax-column] [(position=) syntax-position] [(span=) syntax-span] - [else (error 'syntax-test "unknown test form: ~e" (car y))]) + [else (error 'syntax-test "unknown test form: ~.s" (car y))]) x) (cadr y)) (check-stx x (cddr y))] diff --git a/collects/tests/stepper/test-engine.rkt b/collects/tests/stepper/test-engine.rkt index 01ba1540ad..7ae23940f2 100644 --- a/collects/tests/stepper/test-engine.rkt +++ b/collects/tests/stepper/test-engine.rkt @@ -259,7 +259,7 @@ (if (equal? actual expected) #t (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))) diff --git a/collects/tests/stepper/through-tests.rkt b/collects/tests/stepper/through-tests.rkt index 68a8f97dce..7a580618b1 100755 --- a/collects/tests/stepper/through-tests.rkt +++ b/collects/tests/stepper/through-tests.rkt @@ -55,7 +55,7 @@ (let ([maybe-test (assq name list-of-tests)]) (if 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) (ormap/no-shortcut run-test names)) diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt index 90a96e0f41..cc9ca93b43 100644 --- a/collects/typed-scheme/utils/tc-utils.rkt +++ b/collects/typed-scheme/utils/tc-utils.rkt @@ -54,7 +54,7 @@ don't depend on any other portion of the system (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)))) #;(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)))) (define (locate-stx stx) diff --git a/collects/unstable/generics.rkt b/collects/unstable/generics.rkt index b166e3b371..83f03d4056 100644 --- a/collects/unstable/generics.rkt +++ b/collects/unstable/generics.rkt @@ -173,7 +173,7 @@ ... [(_ new-name method-name) (raise-syntax-error 'define/generic - (format "~e not a method of ~e" + (format "~.s not a method of ~.s" (syntax->datum #'method-name) 'generics) stx diff --git a/collects/web-server/lang/closure.rkt b/collects/web-server/lang/closure.rkt index 8b27b9d024..0f407bc5fd 100644 --- a/collects/web-server/lang/closure.rkt +++ b/collects/web-server/lang/closure.rkt @@ -9,15 +9,15 @@ (define make-CLOSURE-box (syntax-local-lift-expression (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 (syntax-local-lift-expression (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 (syntax-local-lift-expression (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 CLOSURE:deserialize-info-id (syntax-local-lift-expression diff --git a/collects/web-server/lang/web-cells.rkt b/collects/web-server/lang/web-cells.rkt index 2f71f24b26..9315634c17 100644 --- a/collects/web-server/lang/web-cells.rkt +++ b/collects/web-server/lang/web-cells.rkt @@ -49,7 +49,7 @@ (hash-ref (frame-env (current-frame)) i (lambda () - (error 'web-cell "Undefined web-cell: ~e" i)))) + (error 'web-cell "Undefined web-cell: ~.s" i)))) (define (web-cell-shadow wc nv) (update-frame! diff --git a/collects/web-server/servlet/web-cells.rkt b/collects/web-server/servlet/web-cells.rkt index e0e56f689b..44a595c4c2 100644 --- a/collects/web-server/servlet/web-cells.rkt +++ b/collects/web-server/servlet/web-cells.rkt @@ -35,7 +35,7 @@ (hash-ref (frame-env (current-frame)) i (lambda () - (error 'web-cell "Undefined web-cell: ~e" i)))) + (error 'web-cell "Undefined web-cell: ~.s" i)))) (define (web-cell-shadow wc nv) (update-frame!