report locations in default error handler

This commit is contained in:
Andrew Kent 2016-08-24 21:31:21 -04:00 committed by Vincent St-Amour
parent 19bfe3e44d
commit 2070db9c01
2 changed files with 49 additions and 22 deletions

View File

@ -23,9 +23,8 @@
(define (match:error val srclocs form-name)
(raise (make-exn:misc:match
(format "~a: no matching clause for ~e\n location: ~a"
form-name val
(srcloc->string (car srclocs)))
(format "~a: no matching clause for ~e"
form-name val)
(current-continuation-marks)
val
srclocs)))

View File

@ -3181,6 +3181,33 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
print_width = SCHEME_INT_VAL(w);
else
print_width = 0x7FFFFFFF;
/* Print srcloc(s) if present */
l = scheme_struct_type_property_ref(scheme_source_property, argv[1]);
if (l)
l = _scheme_apply(l, 1, &(argv[1]));
if (l && !SCHEME_NULLP(l)) {
/* Some exns include srcloc in the msg, so skip the first srcloc of those when needed */
if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))
&& (scheme_is_struct_instance(exn_table[MZEXN_FAIL_READ].type, argv[1])
|| scheme_is_struct_instance(exn_table[MZEXN_FAIL_SYNTAX].type, argv[1])
|| scheme_is_struct_instance(exn_table[MZEXN_FAIL_CONTRACT_VARIABLE].type, argv[1])))
l = SCHEME_CDR(l);
if (!SCHEME_NULLP(l))
scheme_write_byte_string("\n location...:", 15, port);
while (!SCHEME_NULLP(l)) {
scheme_write_byte_string("\n ", 4, port);
w = SCHEME_CAR(l);
w = srcloc_to_string(1, &w);
scheme_display_w_max(w, port, print_width);
l = SCHEME_CDR(l);
}
}
l = scheme_get_stack_trace(scheme_struct_ref(argv[1], 1));
while (!SCHEME_NULLP(l)) {
if (!max_cnt) {
@ -3192,8 +3219,9 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
if (max_cnt == orig_max_cnt) {
/* Starting label: */
scheme_write_byte_string("\n context...:\n", 15, port);
} else
} else {
scheme_write_byte_string("\n", 1, port);
}
name = SCHEME_CAR(l);
loc = SCHEME_CDR(name);