From 49072bf5e48a510215916f8e00fbd758e76718bf Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 29 Oct 2013 10:16:56 +0900
Subject: [PATCH] [bugfix] fix closure issue

---
 include/picrin.h |  1 +
 src/gc.c         |  6 ++++++
 src/vm.c         | 27 ++++++++++++---------------
 t/closure.scm    | 20 ++++++++++++++++++++
 4 files changed, 39 insertions(+), 15 deletions(-)
 create mode 100644 t/closure.scm

diff --git a/include/picrin.h b/include/picrin.h
index ebc60ee1..f16adcea 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -15,6 +15,7 @@ typedef struct pic_callinfo {
   int argc;
   struct pic_code *pc;
   pic_value *fp;
+  struct pic_env *env;
 } pic_callinfo;
 
 typedef struct {
diff --git a/src/gc.c b/src/gc.c
index c5342746..af76fd14 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -204,6 +204,7 @@ static void
 gc_mark_phase(pic_state *pic)
 {
   pic_value *stack;
+  pic_callinfo *ci;
   int i;
 
   /* stack */
@@ -211,6 +212,11 @@ gc_mark_phase(pic_state *pic)
     gc_mark(pic, *stack);
   }
 
+  /* callinfo */
+  for (ci = pic->ci; ci != pic->cibase; --ci) {
+    gc_mark_object(pic, (struct pic_object *)ci->env);
+  }
+
   /* arena */
   for (i = 0; i < pic->arena_idx; ++i) {
     gc_mark_object(pic, pic->arena[i]);
diff --git a/src/vm.c b/src/vm.c
index 16b04bea..4c4c2674 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -268,7 +268,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       int depth = pc->u.c.depth;
       struct pic_env *env;
 
-      env = pic_proc_ptr(*pic->ci->fp)->env;
+      env = pic->ci->env;
       while (depth--) {
 	env = env->up;
       }
@@ -279,7 +279,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       int depth = pc->u.c.depth;
       struct pic_env *env;
 
-      env = pic_proc_ptr(*pic->ci->fp)->env;
+      env = pic->ci->env;
       while (depth--) {
 	env = env->up;
       }
@@ -342,9 +342,16 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 	  }
 	  PUSH(rest);
 	}
-	for (i = 0; i < proc->u.irep->argc; ++i) {
-	  proc->env->values[i] = ci->fp[i];
+
+	/* prepare env */
+	ci->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
+	ci->env->up = proc->env;
+	ci->env->num_val = proc->u.irep->argc;
+	ci->env->values = (pic_value *)pic_alloc(pic, sizeof(pic_value) * ci->env->num_val);
+	for (i = 0; i < ci->env->num_val; ++i) {
+	  ci->env->values[i] = ci->fp[i];
 	}
+
 	pc = proc->u.irep->code;
 	pic_gc_arena_restore(pic, ai);
 	JUMP;
@@ -370,18 +377,8 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
     }
     CASE(OP_LAMBDA) {
       struct pic_proc *proc;
-      struct pic_env *env;
-      int i;
 
-      env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
-      env->num_val = pic->irep[pc->u.i]->argc;
-      env->values = (pic_value *)pic_alloc(pic, sizeof(pic_value) * env->num_val);
-      for (i = 0; i < env->num_val; ++i) {
-	env->values[i] = pic_undef_value();
-      }
-      env->up = pic_proc_ptr(*pic->ci->fp)->env;
-
-      proc = pic_proc_new(pic, pic->irep[pc->u.i], env);
+      proc = pic_proc_new(pic, pic->irep[pc->u.i], pic->ci->env);
       PUSH(pic_obj_value(proc));
       pic_gc_arena_restore(pic, ai);
       NEXT;
diff --git a/t/closure.scm b/t/closure.scm
new file mode 100644
index 00000000..b74568e2
--- /dev/null
+++ b/t/closure.scm
@@ -0,0 +1,20 @@
+(begin
+
+ (define foo (lambda (a)
+		(lambda ()
+		  a)))
+ (define bar (foo 1))
+
+ ; must be 1
+ (write (bar))
+ (newline)
+
+ (define baz (foo 2))
+
+ ; must be 2
+ (write (baz))
+ (newline)
+
+ ; must be 1
+ (write (bar))
+ (newline))