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

add unquted-printing strings

Browse Source 
And unquoted-printing string contains a string to `display` in all
print modes. Although it could be implemented with a structure type
that has a printing function, `raise-arguments-error` further treats
unquoted-printing strings specially by not using the error value
conversion handler, so it reliably produces literal text in the error
message; that way, `raise-arguments-error` can be used to construct
more error messages.
This commit is contained in:
Matthew Flatt 2017-08-03 17:12:53 -06:00
parent 1ca8b6d533
commit cbfcc904ab
9 changed files with 1739 additions and 1633 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "6.10.0.1") (define version "6.10.0.2")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

28
pkgs/racket-doc/scribblings/reference/exns.scrbl
View File

@ -219,9 +219,11 @@ message; if @racket[message] contains newline characters, each extra line should
suitably indented (with one extra space at the start of each line), but it should not end with a newline character. suitably indented (with one extra space at the start of each line), but it should not end with a newline character.
Each @racket[field] must have a corresponding @racket[v], Each @racket[field] must have a corresponding @racket[v],
and the two are rendered on their own and the two are rendered on their own
line in the error message, with each @racket[v] formatted line in the error message; each @racket[v] is formatted
using the error value conversion handler (see using the error value conversion handler (see
@racket[error-value->string-handler]). @racket[error-value->string-handler]), unless @racket[v] is a
@tech{unquoted-printing string}, in which case the string content is
@racket[display]ed without using the error value conversion handler.
@examples[ @examples[
(eval:error (eval:error
@ -366,6 +368,28 @@ through a combination of the @racket[name], @racket[expr], and
]} ]}
@deftogether[(
@defproc[(unquoted-printing-string? [v any/c]) boolean?]
@defproc[(unquoted-printing-string [s string?]) unquoted-printing-string?]
@defproc[(unquoted-printing-string-value [ups unquoted-printing-string?]) string?]
)]{
An @deftech{unquoted-printing string} wraps a string and
@racket[print]s, @racket[write]s, and @racket[display]s the same way
that the string @racket[display]s. An @tech{unquoted-printing string}
is especially useful with @racket[raise-arguments-error] to serve as a
field ``value'' that causes literal text to be printed as the field
content.
The @racket[unquoted-printing-string?] procedure returns @racket[#t]
if @racket[v] is a @tech{unquoted-printing string}, @racket[#f]
otherwise. The @racket[unquoted-printing-string] creates a
@tech{unquoted-printing string} value that encapsulates the string
@racket[s], and @racket[unquoted-printing-string-value] returns the
string within a @tech{unquoted-printing string}.
@history[#:added "6.10.0.2"]}
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------
@section{Handling Exceptions} @section{Handling Exceptions}

26
pkgs/racket-test-core/tests/racket/print.rktl
View File

@ -224,6 +224,32 @@
;; ---------------------------------------- ;; ----------------------------------------
(test #t unquoted-printing-string? (unquoted-printing-string "a b"))
(test #f unquoted-printing-string? "a b")
(test #f unquoted-printing-string? 7)
(test "a b" unquoted-printing-string-value (unquoted-printing-string "a b"))
(test "a b" format "~s" (unquoted-printing-string "a b"))
(test "a b" format "~a" (unquoted-printing-string "a b"))
(test "a b" format "~v" (unquoted-printing-string "a b"))
(parameterize ([error-print-width 10])
(test "a b1234..." format "~.s" (unquoted-printing-string "a b12345678"))
(test "a b1234..." format "~.a" (unquoted-printing-string "a b12345678"))
(test "a b1234..." format "~.v" (unquoted-printing-string "a b12345678"))
(test "who: oops\n field: a b12345678\n"
'raise-arguments-error
(parameterize ([current-error-port (open-output-bytes)]
[error-print-context-length 0])
(call-with-continuation-prompt
(lambda ()
(raise-arguments-error 'who "oops" "field" (unquoted-printing-string "a b12345678")))
(default-continuation-prompt-tag)
void)
(get-output-string (current-error-port)))))
;; ----------------------------------------
(let ([p (build-path (current-directory) "something")]) (let ([p (build-path (current-directory) "something")])
;; path value in compiled code => path appears in .zo format: ;; path value in compiled code => path appears in .zo format:
(let ([o (open-output-string)]) (let ([o (open-output-string)])

3106
racket/src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

47
racket/src/racket/src/error.c
View File

@ -126,6 +126,9 @@ static Scheme_Object *def_error_value_string_proc(int, Scheme_Object *[]);
static Scheme_Object *def_exit_handler_proc(int, Scheme_Object *[]); static Scheme_Object *def_exit_handler_proc(int, Scheme_Object *[]);
static Scheme_Object *default_yield_handler(int, Scheme_Object *[]); static Scheme_Object *default_yield_handler(int, Scheme_Object *[]);
static Scheme_Object *srcloc_to_string(int argc, Scheme_Object **argv); static Scheme_Object *srcloc_to_string(int argc, Scheme_Object **argv);
static Scheme_Object *unquoted_printing_string(int argc, Scheme_Object **argv);
static Scheme_Object *unquoted_printing_string_p(int argc, Scheme_Object **argv);
static Scheme_Object *unquoted_printing_string_value(int argc, Scheme_Object **argv);
static Scheme_Object *log_message(int argc, Scheme_Object *argv[]); static Scheme_Object *log_message(int argc, Scheme_Object *argv[]);
static Scheme_Object *log_level_p(int argc, Scheme_Object *argv[]); static Scheme_Object *log_level_p(int argc, Scheme_Object *argv[]);
@ -828,6 +831,10 @@ void scheme_init_error(Scheme_Env *env)
GLOBAL_NONCM_PRIM("srcloc->string", srcloc_to_string, 1, 1, env); GLOBAL_NONCM_PRIM("srcloc->string", srcloc_to_string, 1, 1, env);
GLOBAL_NONCM_PRIM("unquoted-printing-string", unquoted_printing_string, 1, 1, env);
GLOBAL_FOLDING_PRIM("unquoted-printing-string?", unquoted_printing_string_p, 1, 1, 1, env);
GLOBAL_IMMED_PRIM("unquoted-printing-string-value", unquoted_printing_string_value, 1, 1, env);
REGISTER_SO(scheme_def_exit_proc); REGISTER_SO(scheme_def_exit_proc);
REGISTER_SO(default_display_handler); REGISTER_SO(default_display_handler);
REGISTER_SO(emergency_display_handler); REGISTER_SO(emergency_display_handler);
@ -2214,6 +2221,36 @@ Scheme_Object *srcloc_to_string(int argc, Scheme_Object **argv)
return scheme_false; return scheme_false;
} }
static Scheme_Object *unquoted_printing_string(int argc, Scheme_Object **argv)
{
Scheme_Object *o;
if (!SCHEME_CHAR_STRINGP(argv[0]))
scheme_wrong_contract("unquoted-printing-string", "string", 0, argc, argv);
o = scheme_alloc_small_object();
o->type = scheme_unquoted_printing_string_type;
SCHEME_PTR_VAL(o) = argv[0];
return o;
}
static Scheme_Object *unquoted_printing_string_p(int argc, Scheme_Object **argv)
{
return (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_unquoted_printing_string_type)
? scheme_true
: scheme_false);
}
static Scheme_Object *unquoted_printing_string_value(int argc, Scheme_Object **argv)
{
if (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_unquoted_printing_string_type))
return SCHEME_PTR_VAL(argv[0]);
scheme_wrong_contract("unquoted-printing-string-value", "unquoted-printing-string?", 0, argc, argv);
return NULL;
}
void scheme_read_err(Scheme_Object *port, void scheme_read_err(Scheme_Object *port,
Scheme_Object *stxsrc, Scheme_Object *stxsrc,
intptr_t line, intptr_t col, intptr_t pos, intptr_t span, intptr_t line, intptr_t col, intptr_t pos, intptr_t span,
@ -3045,7 +3082,15 @@ static Scheme_Object *do_raise_mismatch_error(const char *who, int mismatch, int
if (!mismatch) if (!mismatch)
total += 5; total += 5;
} else { } else {
st = scheme_make_provided_string(argv[i+offset], scount / 2, &slen); s = argv[i+offset];
if (SAME_TYPE(SCHEME_TYPE(s), scheme_unquoted_printing_string_type)) {
s = SCHEME_PTR_VAL(s);
s = scheme_char_string_to_byte_string(s);
st = SCHEME_BYTE_STR_VAL(s);
slen = SCHEME_BYTE_STRLEN_VAL(s);
} else {
st = scheme_make_provided_string(s, scount / 2, &slen);
}
} }
total += slen; total += slen;
ss[i-1] = st; ss[i-1] = st;

10
racket/src/racket/src/print.c
View File

@ -2250,6 +2250,16 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
} }
closed = 1; closed = 1;
} }
else if (SAME_TYPE(SCHEME_TYPE(obj), scheme_unquoted_printing_string_type))
{
if (compact || !pp->print_unreadable) {
cannot_print(pp, notdisplay, obj, ht, compact);
} else {
obj = SCHEME_PTR_VAL(obj);
do_print_string(compact, 0, pp,
SCHEME_CHAR_STR_VAL(obj), 0, SCHEME_CHAR_STRTAG_VAL(obj));
}
}
else if (SCHEME_CHARP(obj)) else if (SCHEME_CHARP(obj))
{ {
if (compact) { if (compact) {

4
racket/src/racket/src/schminc.h
View File

@ -12,9 +12,9 @@
finally, set EXPECTED_PRIM_COUNT to the right value and finally, set EXPECTED_PRIM_COUNT to the right value and
USE_COMPILED_STARTUP to 1 and `make' again. */ USE_COMPILED_STARTUP to 1 and `make' again. */
#define USE_COMPILED_STARTUP 1 #define USE_COMPILED_STARTUP 0
#define EXPECTED_PRIM_COUNT 1156 #define EXPECTED_PRIM_COUNT 1159
#define EXPECTED_UNSAFE_COUNT 141 #define EXPECTED_UNSAFE_COUNT 141
#define EXPECTED_FLFXNUM_COUNT 69 #define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_EXTFL_COUNT 45 #define EXPECTED_EXTFL_COUNT 45

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "6.10.0.1" #define MZSCHEME_VERSION "6.10.0.2"
#define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 10 #define MZSCHEME_VERSION_Y 10
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 1 #define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

145
racket/src/racket/src/stypes.h
View File

@ -234,85 +234,86 @@ enum {
scheme_deferred_expr_type, /* 203 */ scheme_deferred_expr_type, /* 203 */
scheme_will_be_lambda_type, /* 204 */ scheme_will_be_lambda_type, /* 204 */
scheme_syntax_property_preserve_type, /* 205 */ scheme_syntax_property_preserve_type, /* 205 */
scheme_unquoted_printing_string_type, /* 206 */
#ifdef MZTAG_REQUIRED #ifdef MZTAG_REQUIRED
_scheme_last_normal_type_, /* 206 */ _scheme_last_normal_type_, /* 207 */
/* The remaining tags exist for GC tracing (in non-conservative /* The remaining tags exist for GC tracing (in non-conservative
mode), but they are not needed for run-time tag tests */ mode), but they are not needed for run-time tag tests */
scheme_rt_weak_array, /* 207 */ scheme_rt_weak_array, /* 208 */
scheme_rt_comp_env, /* 208 */ scheme_rt_comp_env, /* 209 */
scheme_rt_constant_binding, /* 209 */ scheme_rt_constant_binding, /* 210 */
scheme_rt_resolve_info, /* 210 */ scheme_rt_resolve_info, /* 211 */
scheme_rt_unresolve_info, /* 211 */ scheme_rt_unresolve_info, /* 212 */
scheme_rt_optimize_info, /* 212 */ scheme_rt_optimize_info, /* 213 */
scheme_rt_cont_mark, /* 213 */ scheme_rt_cont_mark, /* 214 */
scheme_rt_saved_stack, /* 214 */ scheme_rt_saved_stack, /* 215 */
scheme_rt_reply_item, /* 215 */ scheme_rt_reply_item, /* 216 */
scheme_rt_ir_lambda_info, /* 216 */ scheme_rt_ir_lambda_info, /* 217 */
scheme_rt_overflow, /* 217 */ scheme_rt_overflow, /* 218 */
scheme_rt_overflow_jmp, /* 218 */ scheme_rt_overflow_jmp, /* 219 */
scheme_rt_meta_cont, /* 219 */ scheme_rt_meta_cont, /* 220 */
scheme_rt_dyn_wind_cell, /* 220 */ scheme_rt_dyn_wind_cell, /* 221 */
scheme_rt_dyn_wind_info, /* 221 */ scheme_rt_dyn_wind_info, /* 222 */
scheme_rt_dyn_wind, /* 222 */ scheme_rt_dyn_wind, /* 223 */
scheme_rt_dup_check, /* 223 */ scheme_rt_dup_check, /* 224 */
scheme_rt_thread_memory, /* 224 */ scheme_rt_thread_memory, /* 225 */
scheme_rt_input_file, /* 225 */ scheme_rt_input_file, /* 226 */
scheme_rt_input_fd, /* 226 */ scheme_rt_input_fd, /* 227 */
scheme_rt_oskit_console_input, /* 227 */ scheme_rt_oskit_console_input, /* 228 */
scheme_rt_tested_input_file, /* 228 */ scheme_rt_tested_input_file, /* 229 */
scheme_rt_tested_output_file, /* 229 */ scheme_rt_tested_output_file, /* 230 */
scheme_rt_indexed_string, /* 230 */ scheme_rt_indexed_string, /* 231 */
scheme_rt_output_file, /* 231 */ scheme_rt_output_file, /* 232 */
scheme_rt_load_handler_data, /* 232 */ scheme_rt_load_handler_data, /* 233 */
scheme_rt_pipe, /* 233 */ scheme_rt_pipe, /* 234 */
scheme_rt_beos_process, /* 234 */ scheme_rt_beos_process, /* 235 */
scheme_rt_system_child, /* 235 */ scheme_rt_system_child, /* 236 */
scheme_rt_tcp, /* 236 */ scheme_rt_tcp, /* 237 */
scheme_rt_write_data, /* 237 */ scheme_rt_write_data, /* 238 */
scheme_rt_tcp_select_info, /* 238 */ scheme_rt_tcp_select_info, /* 239 */
scheme_rt_param_data, /* 239 */ scheme_rt_param_data, /* 240 */
scheme_rt_will, /* 240 */ scheme_rt_will, /* 241 */
scheme_rt_linker_name, /* 241 */ scheme_rt_linker_name, /* 242 */
scheme_rt_param_map, /* 242 */ scheme_rt_param_map, /* 243 */
scheme_rt_finalization, /* 243 */ scheme_rt_finalization, /* 244 */
scheme_rt_finalizations, /* 244 */ scheme_rt_finalizations, /* 245 */
scheme_rt_cpp_object, /* 245 */ scheme_rt_cpp_object, /* 246 */
scheme_rt_cpp_array_object, /* 246 */ scheme_rt_cpp_array_object, /* 247 */
scheme_rt_stack_object, /* 247 */ scheme_rt_stack_object, /* 248 */
scheme_rt_preallocated_object, /* 248 */ scheme_rt_preallocated_object, /* 249 */
scheme_thread_hop_type, /* 249 */ scheme_thread_hop_type, /* 250 */
scheme_rt_srcloc, /* 250 */ scheme_rt_srcloc, /* 251 */
scheme_rt_evt, /* 251 */ scheme_rt_evt, /* 252 */
scheme_rt_syncing, /* 252 */ scheme_rt_syncing, /* 253 */
scheme_rt_comp_prefix, /* 253 */ scheme_rt_comp_prefix, /* 254 */
scheme_rt_user_input, /* 254 */ scheme_rt_user_input, /* 255 */
scheme_rt_user_output, /* 255 */ scheme_rt_user_output, /* 256 */
scheme_rt_compact_port, /* 256 */ scheme_rt_compact_port, /* 257 */
scheme_rt_read_special_dw, /* 257 */ scheme_rt_read_special_dw, /* 258 */
scheme_rt_regwork, /* 258 */ scheme_rt_regwork, /* 259 */
scheme_rt_rx_lazy_string, /* 259 */ scheme_rt_rx_lazy_string, /* 260 */
scheme_rt_buf_holder, /* 260 */ scheme_rt_buf_holder, /* 261 */
scheme_rt_parameterization, /* 261 */ scheme_rt_parameterization, /* 262 */
scheme_rt_print_params, /* 262 */ scheme_rt_print_params, /* 263 */
scheme_rt_read_params, /* 263 */ scheme_rt_read_params, /* 264 */
scheme_rt_native_code, /* 264 */ scheme_rt_native_code, /* 265 */
scheme_rt_native_code_plus_case, /* 265 */ scheme_rt_native_code_plus_case, /* 266 */
scheme_rt_jitter_data, /* 266 */ scheme_rt_jitter_data, /* 267 */
scheme_rt_module_exports, /* 267 */ scheme_rt_module_exports, /* 268 */
scheme_rt_delay_load_info, /* 268 */ scheme_rt_delay_load_info, /* 269 */
scheme_rt_marshal_info, /* 269 */ scheme_rt_marshal_info, /* 270 */
scheme_rt_unmarshal_info, /* 270 */ scheme_rt_unmarshal_info, /* 271 */
scheme_rt_runstack, /* 271 */ scheme_rt_runstack, /* 272 */
scheme_rt_sfs_info, /* 272 */ scheme_rt_sfs_info, /* 273 */
scheme_rt_validate_clearing, /* 273 */ scheme_rt_validate_clearing, /* 274 */
scheme_rt_lightweight_cont, /* 274 */ scheme_rt_lightweight_cont, /* 275 */
scheme_rt_export_info, /* 275 */ scheme_rt_export_info, /* 276 */
scheme_rt_cont_jmp, /* 276 */ scheme_rt_cont_jmp, /* 277 */
scheme_rt_letrec_check_frame, /* 277 */ scheme_rt_letrec_check_frame, /* 278 */
#endif #endif
_scheme_last_type_ _scheme_last_type_