From 337b54dc40f821405ce5505652b7afa2ef080c47 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 24 Oct 2013 02:51:02 +0900
Subject: [PATCH] initial closure support

---
 src/codegen.c | 41 +++++++++++++++++++++++------------------
 src/vm.c      |  7 +++++++
 2 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/src/codegen.c b/src/codegen.c
index df335f10..7601f317 100644
--- a/src/codegen.c
+++ b/src/codegen.c
@@ -6,6 +6,8 @@
 #include "picrin/proc.h"
 #include "xhash/xhash.h"
 
+#define FALLTHROUGH ((void)0)
+
 typedef struct codegen_scope {
   struct codegen_scope *up;
 
@@ -167,22 +169,23 @@ codegen(codegen_state *state, pic_value obj)
       pic_error(pic, "unbound variable");
     }
 
-    if (depth == -1) {		/* global */
+    switch (depth) {
+    case -1:			/* global */
       irep->code[irep->clen].insn = OP_GREF;
       irep->code[irep->clen].u.i = idx;
       irep->clen++;
-    }
-    else if (depth == 0) {	/* local */
-      irep->code[irep->clen].insn = OP_LREF;
-      irep->code[irep->clen].u.i = idx;
-      irep->clen++;
-    }
-    else {			/* nonlocal */
+      break;
+    default:			/* nonlocal */
       /* dirty flag */
       s->cv_tbl[idx] = 1;
-      /* dummy code */
-      irep->code[irep->clen].insn = OP_PUSHNIL;
+      /* at this stage, lref and cref are not distinguished */
+      FALLTHROUGH;
+    case 0:			/* local */
+      irep->code[irep->clen].insn = OP_CREF;
+      irep->code[irep->clen].u.c.depth = depth;
+      irep->code[irep->clen].u.c.idx = idx;
       irep->clen++;
+      break;
     }
     break;
   }
@@ -207,11 +210,12 @@ codegen(codegen_state *state, pic_value obj)
       break;
     }
     else if (pic_eq_p(pic, proc, pic->sLAMBDA)) {
+      int k = pic->ilen++;
       irep->code[irep->clen].insn = OP_LAMBDA;
-      irep->code[irep->clen].u.i = pic->ilen;
+      irep->code[irep->clen].u.i = k;
       irep->clen++;
 
-      pic->irep[pic->ilen++] = codegen_lambda(state, obj);
+      pic->irep[k] = codegen_lambda(state, obj);
       break;
     }
     else if (pic_eq_p(pic, proc, pic->sIF)) {
@@ -401,12 +405,14 @@ codegen_lambda(codegen_state *state, pic_value obj)
     irep->code[irep->clen].insn = OP_RET;
     irep->clen++;
 
-    printf("** dirty **\n");
-    for (i = 1; i < state->scope->argc; ++i) {
-      if (state->scope->cv_tbl[i])
-	printf("%d ", i);
+    /* fixup */
+    for (i = 0; i < irep->clen; ++i) {
+      struct pic_code c = irep->code[i];
+      if (c.insn == OP_CREF && c.u.c.depth == 0 && ! state->scope->cv_tbl[c.u.c.idx]) {
+	irep->code[i].insn = OP_LREF;
+	irep->code[i].u.i = irep->code[i].u.c.idx;
+      }
     }
-    puts("");
   }
   destroy_scope(pic, state->scope);
 
@@ -414,7 +420,6 @@ codegen_lambda(codegen_state *state, pic_value obj)
   state->scope = prev_scope;
 
 #if VM_DEBUG
-  printf("LAMBDA_%zd:\n", pic->ilen);
   print_irep(pic, irep);
   puts("");
 #endif
diff --git a/src/vm.c b/src/vm.c
index 0847794f..1b1b7009 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -224,10 +224,15 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
 	NEXT;
       }
       else {
+	int i;
+
 	if (ci->argc != proc->u.irep->argc) {
 	  pic->errmsg = "wrong number of arguments";
 	  goto L_RAISE;
 	}
+	for (i = 0; i < proc->u.irep->argc; ++i) {
+	  proc->env->values[i] = ci->fp[i];
+	}
 	pc = proc->u.irep->code;
 	pic_gc_arena_restore(pic, ai);
 	JUMP;
@@ -256,6 +261,8 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
       struct pic_env *env;
 
       env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
+      env->numcv = pic->irep[pc->u.i]->argc;
+      env->values = (pic_value *)pic_alloc(pic, sizeof(pic_value) * env->numcv);
       env->up = pic_proc_ptr(*pic->ci->fp)->env;
 
       proc = pic_proc_new(pic, pic->irep[pc->u.i], env);