introduce PTR_CASE macro

extlib/benz/vm.c

@@ -26,12 +26,12 @@ pic_get_proc(pic_state *pic)
  *  I   int *, bool *           int with exactness
  *  f   double *                float
  *  F   double *, bool *        float with exactness
- *  s   pic_str **              string object
+ *  c   char *                  char
  *  z   char **                 c string
+ *  s   pic_str **              string object
  *  m   pic_sym **              symbol
  *  v   pic_vec **              vector object
  *  b   pic_blob **             bytevector object
- *  c   char *                  char
  *  l   struct pic_proc **      lambda object
  *  p   struct pic_port **      port object
  *  d   struct pic_dict **      dictionary object
@@ -186,17 +186,17 @@ pic_get_args(pic_state *pic, const char *format, ...)
       }
       break;
     }
-    case 's': {
+    case 'c': {
-      pic_str **str;
+      char *k;
       pic_value v;
 
-      str = va_arg(ap, pic_str **);
+      k = va_arg(ap, char *);
       v = GET_OPERAND(pic,i);
-      if (pic_str_p(v)) {
+      if (pic_char_p(v)) {
-        *str = pic_str_ptr(v);
+        *k = pic_char(v);
       }
       else {
-        pic_errorf(pic, "pic_get_args: expected string, but got ~s", v);
+        pic_errorf(pic, "pic_get_args: expected char, but got ~s", v);
       }
       break;
     }
@@ -214,132 +214,33 @@ pic_get_args(pic_state *pic, const char *format, ...)
       }
       break;
     }
-    case 'm': {
-      pic_sym **m;
-      pic_value v;
 
-      m = va_arg(ap, pic_sym **);
+#define PTR_CASE(c, type, ctype)                                        \
-      v = GET_OPERAND(pic,i);
+      case c: {                                                         \
-      if (pic_sym_p(v)) {
+        ctype *ptr;                                                     \
-        *m = pic_sym_ptr(v);
+        pic_value v;                                                    \
+                                                                        \
+        ptr = va_arg(ap, ctype *);                                      \
+        v = GET_OPERAND(pic, i);                                        \
+        if (pic_## type ##_p(v)) {                                      \
+          *ptr = pic_## type ##_ptr(v);                                 \
+        }                                                               \
+        else {                                                          \
+          pic_errorf(pic, "pic_get_args: expected " #type ", but got ~s", v); \
+        }                                                               \
+        break;                                                          \
       }
-      else {
-        pic_errorf(pic, "pic_get_args: expected symbol, but got ~s", v);
-      }
-      break;
-    }
-    case 'v': {
-      struct pic_vector **vec;
-      pic_value v;
 
-      vec = va_arg(ap, struct pic_vector **);
+    PTR_CASE('s', str, pic_str *)
-      v = GET_OPERAND(pic,i);
+    PTR_CASE('m', sym, pic_sym *)
-      if (pic_vec_p(v)) {
+    PTR_CASE('v', vec, pic_vec *)
-        *vec = pic_vec_ptr(v);
+    PTR_CASE('b', blob, pic_blob *)
-      }
+    PTR_CASE('l', proc, struct pic_proc *)
-      else {
+    PTR_CASE('p', port, struct pic_port *)
-        pic_errorf(pic, "pic_get_args: expected vector, but got ~s", v);
+    PTR_CASE('d', dict, struct pic_dict *)
-      }
+    PTR_CASE('r', record, struct pic_record *)
-      break;
+    PTR_CASE('e', error, struct pic_error *)
-    }
-    case 'b': {
-      struct pic_blob **b;
-      pic_value v;
 
-      b = va_arg(ap, struct pic_blob **);
-      v = GET_OPERAND(pic,i);
-      if (pic_blob_p(v)) {
-        *b = pic_blob_ptr(v);
-      }
-      else {
-        pic_errorf(pic, "pic_get_args: expected bytevector, but got ~s", v);
-      }
-      break;
-    }
-    case 'c': {
-      char *k;
-      pic_value v;
-
-      k = va_arg(ap, char *);
-      v = GET_OPERAND(pic,i);
-      if (pic_char_p(v)) {
-        *k = pic_char(v);
-      }
-      else {
-        pic_errorf(pic, "pic_get_args: expected char, but got ~s", v);
-      }
-      break;
-    }
-    case 'l': {
-      struct pic_proc **l;
-      pic_value v;
-
-      l = va_arg(ap, struct pic_proc **);
-      v = GET_OPERAND(pic,i);
-      if (pic_proc_p(v)) {
-        *l = pic_proc_ptr(v);
-      }
-      else {
-        pic_errorf(pic, "pic_get_args, expected procedure, but got ~s", v);
-      }
-      break;
-    }
-    case 'p': {
-      struct pic_port **p;
-      pic_value v;
-
-      p = va_arg(ap, struct pic_port **);
-      v = GET_OPERAND(pic,i);
-      if (pic_port_p(v)) {
-        *p = pic_port_ptr(v);
-      }
-      else {
-        pic_errorf(pic, "pic_get_args, expected port, but got ~s", v);
-      }
-      break;
-    }
-    case 'd': {
-      struct pic_dict **d;
-      pic_value v;
-
-      d = va_arg(ap, struct pic_dict **);
-      v = GET_OPERAND(pic,i);
-      if (pic_dict_p(v)) {
-        *d = pic_dict_ptr(v);
-      }
-      else {
-        pic_errorf(pic, "pic_get_args, expected dictionary, but got ~s", v);
-      }
-      break;
-    }
-    case 'r': {
-      struct pic_record **r;
-      pic_value v;
-
-      r = va_arg(ap, struct pic_record **);
-      v = GET_OPERAND(pic,i);
-      if (pic_record_p(v)) {
-        *r = pic_record_ptr(v);
-      }
-      else {
-        pic_errorf(pic, "pic_get_args: expected record, but got ~s", v);
-      }
-      break;
-    }
-    case 'e': {
-      struct pic_error **e;
-      pic_value v;
-
-      e = va_arg(ap, struct pic_error **);
-      v = GET_OPERAND(pic,i);
-      if (pic_error_p(v)) {
-        *e = pic_error_ptr(v);
-      }
-      else {
-        pic_errorf(pic, "pic_get_args, expected error");
-      }
-      break;
-    }
     default:
       pic_errorf(pic, "pic_get_args: invalid argument specifier '%c' given", c);
     }