allow additional arguments to `raise-mismatch-error'

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

collects/scribblings/reference/exns.scrbl

@@ -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?

src/racket/src/error.c

@@ -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);
 
-  s = scheme_char_string_to_byte_string(argv[1]);
+  /* 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);
+  }
 
-  scheme_arg_mismatch(scheme_symbol_val(argv[0]),
-		      SCHEME_BYTE_STR_VAL(s),
-		      argv[2]);
+  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;
 }