From 06a7b0f5f633c847dcd1a602ea505a5158cb5b27 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 26 Feb 2014 00:39:16 +0900
Subject: [PATCH] add pic_func struct to hold native function name

---
 include/picrin/proc.h | 18 ++++++++++++++----
 src/gc.c              |  2 +-
 src/proc.c            |  9 +++++----
 src/var.c             |  5 ++++-
 src/vm.c              |  8 ++++----
 5 files changed, 28 insertions(+), 14 deletions(-)

diff --git a/include/picrin/proc.h b/include/picrin/proc.h
index 7bf15927..0b937537 100644
--- a/include/picrin/proc.h
+++ b/include/picrin/proc.h
@@ -9,6 +9,12 @@
 extern "C" {
 #endif
 
+/* native C function */
+struct pic_func {
+  pic_func_t f;
+  pic_sym name;
+};
+
 struct pic_env {
   PIC_OBJECT_HEADER
   pic_value *values;
@@ -18,22 +24,26 @@ struct pic_env {
 
 struct pic_proc {
   PIC_OBJECT_HEADER
-  bool cfunc_p;
+  char kind;
   union {
-    pic_func_t cfunc;
+    struct pic_func func;
     struct pic_irep *irep;
   } u;
   struct pic_env *env;
 };
 
+#define PIC_PROC_KIND_FUNC 1
+#define PIC_PROC_KIND_IREP 2
+
+#define pic_proc_func_p(proc) ((proc)->kind == PIC_PROC_KIND_FUNC)
+#define pic_proc_irep_p(proc) ((proc)->kind == PIC_PROC_KIND_IREP)
+
 #define pic_proc_p(o) (pic_type(o) == PIC_TT_PROC)
 #define pic_env_p(o) (pic_type(o) == PIC_TT_ENV)
 
 #define pic_proc_ptr(o) ((struct pic_proc *)pic_ptr(o))
 #define pic_env_ptr(o) ((struct pic_env *)pic_ptr(o))
 
-#define pic_proc_cfunc_p(o) (pic_proc_ptr(o)->cfunc_p)
-
 struct pic_proc *pic_proc_new(pic_state *, pic_func_t);
 struct pic_proc *pic_proc_new_irep(pic_state *, struct pic_irep *, struct pic_env *);
 
diff --git a/src/gc.c b/src/gc.c
index a44abbea..f5c5e777 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -356,7 +356,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     if (proc->env) {
       gc_mark_object(pic, (struct pic_object *)proc->env);
     }
-    if (! proc->cfunc_p) {
+    if (pic_proc_irep_p(proc)) {
       gc_mark_object(pic, (struct pic_object *)proc->u.irep);
     }
     break;
diff --git a/src/proc.c b/src/proc.c
index bb085031..8d9be2ed 100644
--- a/src/proc.c
+++ b/src/proc.c
@@ -8,13 +8,14 @@
 #include "picrin/irep.h"
 
 struct pic_proc *
-pic_proc_new(pic_state *pic, pic_func_t cfunc)
+pic_proc_new(pic_state *pic, pic_func_t func)
 {
   struct pic_proc *proc;
 
   proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
-  proc->cfunc_p = true;
-  proc->u.cfunc = cfunc;
+  proc->kind = PIC_PROC_KIND_FUNC;
+  proc->u.func.f = func;
+  proc->u.func.name = pic_intern_cstr(pic, "(no name)");
   proc->env = NULL;
   return proc;
 }
@@ -25,7 +26,7 @@ pic_proc_new_irep(pic_state *pic, struct pic_irep *irep, struct pic_env *env)
   struct pic_proc *proc;
 
   proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
-  proc->cfunc_p = false;
+  proc->kind = PIC_PROC_KIND_IREP;
   proc->u.irep = irep;
   proc->env = env;
   return proc;
diff --git a/src/var.c b/src/var.c
index 9219ddb4..184e4666 100644
--- a/src/var.c
+++ b/src/var.c
@@ -50,7 +50,10 @@ get_var_from_proc(pic_state *pic, struct pic_proc *proc)
 {
   pic_value v;
 
-  if (! proc->cfunc_p) {
+  if (! pic_proc_p(v)) {
+    goto typeerror;
+  }
+  if (! pic_proc_func_p(pic_proc_ptr(v))) {
     goto typeerror;
   }
   if (pic_proc_cv_size(pic, proc) != 1) {
diff --git a/src/vm.c b/src/vm.c
index 02675ba3..970f48a6 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -480,7 +480,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
         pic_error(pic, "logic flaw");
       }
       irep = pic_proc_ptr(self)->u.irep;
-      if (pic_proc_cfunc_p(self)) {
+      if (! pic_proc_irep_p(pic_proc_ptr(self))) {
         pic_error(pic, "logic flaw");
       }
       PUSH(irep->pool[c.u.i]);
@@ -590,10 +590,10 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       ci->ip = pic->ip;
       ci->fp = pic->sp - c.u.i;
       ci->env = NULL;
-      if (pic_proc_cfunc_p(x)) {
+      if (pic_proc_func_p(pic_proc_ptr(x))) {
 
         /* invoke! */
-	pic->sp[0] = proc->u.cfunc(pic);
+	pic->sp[0] = proc->u.func.f(pic);
         pic->sp += ci->retc;
 
         pic_gc_arena_restore(pic, ai);
@@ -702,7 +702,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
         pic_error(pic, "logic flaw");
       }
       irep = pic_proc_ptr(self)->u.irep;
-      if (pic_proc_cfunc_p(self)) {
+      if (! pic_proc_irep_p(pic_proc_ptr(self))) {
         pic_error(pic, "logic flaw");
       }
       proc = pic_proc_new_irep(pic, irep->irep[c.u.i], pic->ci->env);