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

allow additional arguments to `raise-mismatch-error'

Browse Source 
because it's often useful to show more values, and a
 tail `raise-mismatch-error' instead of a nested `format'
 can avoid some safe-for-space work in the JIT output
This commit is contained in:
Matthew Flatt 2011-04-23 09:37:42 -06:00
parent f54d977de1
commit b1ac25023d
2 changed files with 57 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/scribblings/reference/exns.scrbl
View File

@ -142,7 +142,8 @@ message names the bad argument and also lists the other arguments. If
(feed-animals 'cow 'sheep 'dog 'cat)
]}
@defproc[(raise-mismatch-error [name symbol?] [message string?] [v any/c]) any]{
@defproc[(raise-mismatch-error [name symbol?] [message string?] [v any/c]
...+ ...+) any]{
Creates an @racket[exn:fail:contract] value and @racket[raise]s it as
an exception. The @racket[name] is used as the source procedure's
@ -150,7 +151,12 @@ name in the error message. The @racket[message] is the error
message. The @racket[v] argument is the improper argument received by
the procedure. The printed form of @racket[v] is appended to
@racket[message] (using the error value conversion handler; see
@racket[error-value->string-handler]).}
@racket[error-value->string-handler]).
Additional arguments are concatenated to the error message like
@racket[message] and @racket[v]. Every other additional argument
(starting with the argument after @racket[v]) must be a string, but a
string need not have a following value argument.}
@defproc[(raise-arity-error [name (or/c symbol? procedure?)]
[arity-v (or/c exact-nonnegative-integer?

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

@ -579,7 +579,7 @@ void scheme_init_error(Scheme_Env *env)
GLOBAL_NONCM_PRIM("raise-user-error", raise_user_error, 1, -1, env);
GLOBAL_NONCM_PRIM("raise-syntax-error", raise_syntax_error, 2, 5, env);
GLOBAL_NONCM_PRIM("raise-type-error", raise_type_error, 3, -1, env);
GLOBAL_NONCM_PRIM("raise-mismatch-error", raise_mismatch_error, 3, 3, env);
GLOBAL_NONCM_PRIM("raise-mismatch-error", raise_mismatch_error, 3, -1, env);
scheme_raise_arity_error_proc = scheme_make_noncm_prim(raise_arity_error, "raise-arity-error", 2, -1);
scheme_add_global_constant("raise-arity-error", scheme_raise_arity_error_proc, env);
@ -2174,17 +2174,61 @@ static Scheme_Object *raise_type_error(int argc, Scheme_Object *argv[])
static Scheme_Object *raise_mismatch_error(int argc, Scheme_Object *argv[])
{
Scheme_Object *s;
int i;
if (!SCHEME_SYMBOLP(argv[0]))
scheme_wrong_type("raise-mismatch-error", "symbol", 0, argc, argv);
if (!SCHEME_CHAR_STRINGP(argv[1]))
scheme_wrong_type("raise-mismatch-error", "string", 1, argc, argv);
/* additional arguments: odd ones must be strings */
for (i = 3; i < argc; i += 2) {
if (!SCHEME_CHAR_STRINGP(argv[i]))
scheme_wrong_type("raise-mismatch-error", "string", i, argc, argv);
}
if (argc == 3) {
/* Simple case: one string & value: */
s = scheme_char_string_to_byte_string(argv[1]);
scheme_arg_mismatch(scheme_symbol_val(argv[0]),
SCHEME_BYTE_STR_VAL(s),
argv[2]);
} else {
/* Multiple strings & values: */
char *st, **ss;
intptr_t slen, *slens, total = 0;
int scount = argc - 1;
ss = (char **)MALLOC_N(char*, scount);
slens = (intptr_t *)MALLOC_N_ATOMIC(intptr_t, scount);
for (i = 1; i < argc; i++) {
if (i & 1) {
s = scheme_char_string_to_byte_string(argv[i]);
st = SCHEME_BYTE_STR_VAL(s);
slen = SCHEME_BYTE_STRLEN_VAL(s);
} else {
st = scheme_make_provided_string(argv[i], scount / 2, &slen);
}
total += slen;
ss[i-1] = st;
slens[i-1] = slen;
}
st = (char *)scheme_malloc_atomic(total + 1);
total = 0;
for (i = 0; i < scount; i++) {
slen = slens[i];
memcpy(st + total, ss[i], slen);
total += slen;
}
st[total] = 0;
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: %t",
scheme_symbol_val(argv[0]), st, total);
}
return NULL;
}