From 0d28f246de7822b470bcdbb8b147fe01b618cc72 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 9 Nov 2013 14:12:59 +0900
Subject: [PATCH] add pic_get_proc

---
 include/picrin.h |  1 +
 src/vm.c         | 11 +++++++++++
 2 files changed, 12 insertions(+)

diff --git a/include/picrin.h b/include/picrin.h
index 6683dd8e..f0f1d172 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -74,6 +74,7 @@ void pic_gc_arena_restore(pic_state *, int);
 pic_state *pic_open(int argc, char *argv[], char **envp);
 void pic_close(pic_state *);
 
+struct pic_proc *pic_get_proc(pic_state *);
 int pic_get_args(pic_state *, const char *, ...);
 void pic_defun(pic_state *, const char *, pic_func_t);
 
diff --git a/src/vm.c b/src/vm.c
index 482abf2f..f701cbe9 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -10,6 +10,17 @@
 
 #define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
 
+struct pic_proc *
+pic_get_proc(pic_state *pic)
+{
+  pic_value v = GET_OPERAND(pic,0);
+
+  if (! pic_proc_p(v)) {
+    pic_error(pic, "fatal error");
+  }
+  return pic_proc_ptr(v);
+}
+
 int
 pic_get_args(pic_state *pic, const char *format, ...)
 {