From e7f765d21859e9f7807619c6166aad25708c08b0 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 8 Jan 2014 20:53:28 +0900
Subject: [PATCH] pic_get_args supports pic_procs

---
 src/cont.c  | 25 +++----------------------
 src/error.c | 14 ++------------
 src/proc.c  | 10 ++++------
 src/vm.c    | 18 ++++++++++++++++++
 4 files changed, 27 insertions(+), 40 deletions(-)

diff --git a/src/cont.c b/src/cont.c
index 9d3edb63..44e0af26 100644
--- a/src/cont.c
+++ b/src/cont.c
@@ -150,15 +150,9 @@ static pic_value
 pic_cont_callcc(pic_state *pic)
 {
   struct pic_cont *cont;
-  pic_value v;
   struct pic_proc *cb;
 
-  pic_get_args(pic, "o", &v);
-
-  if (! pic_proc_p(v)) {
-    pic_error(pic, "expected procedure");
-  }
-  cb = pic_proc_ptr(v);
+  pic_get_args(pic, "l", &cb);
 
   save_cont(pic, &cont);
   if (setjmp(cont->jmp)) {
@@ -182,23 +176,10 @@ pic_cont_callcc(pic_state *pic)
 static pic_value
 pic_cont_dynamic_wind(pic_state *pic)
 {
-  pic_value a,b,c,v;
   struct pic_proc *in, *thunk, *out;
+  pic_value v;
 
-  pic_get_args(pic, "ooo", &a, &b, &c);
-
-  if (! pic_proc_p(a)) {
-    pic_error(pic, "procedure expected");
-  }
-  in = pic_proc_ptr(a);
-  if (! pic_proc_p(b)) {
-    pic_error(pic, "procedure expected");
-  }
-  thunk = pic_proc_ptr(b);
-  if (! pic_proc_p(c)) {
-    pic_error(pic, "procedure expected");
-  }
-  out = pic_proc_ptr(c);
+  pic_get_args(pic, "lll", &in, &thunk, &out);
 
   /* enter */
   pic_apply_argv(pic, in, 0);
diff --git a/src/error.c b/src/error.c
index c75b9e9c..3e486e80 100644
--- a/src/error.c
+++ b/src/error.c
@@ -59,20 +59,10 @@ pic_raise(pic_state *pic, pic_value obj)
 static pic_value
 pic_error_with_exception_handler(pic_state *pic)
 {
-  pic_value v, w;
   struct pic_proc *handler, *thunk;
+  pic_value v;
 
-  pic_get_args(pic, "oo", &v, &w);
-
-  if (! pic_proc_p(v)){
-    pic_error(pic, "expected procedure");
-  }
-  handler = pic_proc_ptr(v);
-
-  if (! pic_proc_p(v)) {
-    pic_error(pic, "expected procedure");
-  }
-  thunk = pic_proc_ptr(w);
+  pic_get_args(pic, "ll", &handler, &thunk);
 
   if (pic->ridx >= pic->rlen) {
 
diff --git a/src/proc.c b/src/proc.c
index 5b156417..c66ef8d6 100644
--- a/src/proc.c
+++ b/src/proc.c
@@ -40,15 +40,13 @@ pic_proc_proc_p(pic_state *pic)
 static pic_value
 pic_proc_apply(pic_state *pic)
 {
-  pic_value proc, *args, v;
+  struct pic_proc *proc;
+  pic_value *args, v;
   size_t argc;
   int i;
 
-  pic_get_args(pic, "o*", &proc, &argc, &args);
+  pic_get_args(pic, "l*", &proc, &argc, &args);
 
-  if (! pic_proc_p(proc)) {
-    pic_error(pic, "apply: expected procedure");
-  }
   if (argc == 0) {
     pic_error(pic, "apply: wrong number of arguments");
   }
@@ -57,7 +55,7 @@ pic_proc_apply(pic_state *pic)
     v = pic_cons(pic, args[i], v);
   }
 
-  return pic_apply(pic, pic_proc_ptr(proc), v);
+  return pic_apply(pic, proc, v);
 }
 
 void
diff --git a/src/vm.c b/src/vm.c
index 74a154df..d2953dfb 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -240,6 +240,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
 	}
       }
       break;
+    case 'l':
+      {
+        struct pic_proc **l;
+        pic_value v;
+
+        l = va_arg(ap, struct pic_proc **);
+        if (i < argc) {
+          v = GET_OPERAND(pic,i);
+          if (pic_proc_p(v)) {
+            *l = pic_proc_ptr(v);
+          }
+          else {
+            pic_error(pic, "pic_get_args, expected procedure");
+          }
+          i++;
+        }
+        break;
+      }
     default:
       {
 	pic_error(pic, "pic_get_args: invalid argument specifier given");