[bugfix] fix closure issue

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 {

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]);

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;

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))