From bd851318d1a2a5cb7f26f22a3fa4994381f28b7a Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 24 Oct 2013 02:02:07 +0900
Subject: [PATCH] add pic_env struct

---
 include/picrin/proc.h  | 14 +++++++++++---
 include/picrin/value.h |  3 ++-
 src/codegen.c          |  3 ++-
 src/gc.c               | 20 +++++++++++++++++++-
 src/port.c             |  2 ++
 src/proc.c             |  4 +++-
 src/vm.c               |  6 +++++-
 7 files changed, 44 insertions(+), 8 deletions(-)

diff --git a/include/picrin/proc.h b/include/picrin/proc.h
index e598b949..7d6dcd92 100644
--- a/include/picrin/proc.h
+++ b/include/picrin/proc.h
@@ -1,6 +1,13 @@
 #ifndef PROC_H__
 #define PROC_H__
 
+struct pic_env {
+  PIC_OBJECT_HEADER
+  pic_value *values;
+  int numcv;
+  struct pic_env *up;
+};
+
 struct pic_proc {
   PIC_OBJECT_HEADER
   bool cfunc_p;
@@ -8,14 +15,15 @@ struct pic_proc {
     pic_func_t cfunc;
     struct pic_irep *irep;
   } u;
+  struct pic_env *env;
   pic_value aux;
 };
 
-#define pic_proc_ptr(o) ((struct pic_proc *)o.u.data)
+#define pic_proc_ptr(o) ((struct pic_proc *)(o).u.data)
 
 #define pic_proc_cfunc_p(o) (pic_proc_ptr(o)->cfunc_p)
 
-struct pic_proc *pic_proc_new(pic_state *, struct pic_irep *irep);
-struct pic_proc *pic_proc_new_cfunc(pic_state *, pic_func_t cfunc, pic_value aux);
+struct pic_proc *pic_proc_new(pic_state *, struct pic_irep *, struct pic_env *);
+struct pic_proc *pic_proc_new_cfunc(pic_state *, pic_func_t, pic_value);
 
 #endif
diff --git a/include/picrin/value.h b/include/picrin/value.h
index f9f7bfda..456f2284 100644
--- a/include/picrin/value.h
+++ b/include/picrin/value.h
@@ -31,7 +31,8 @@ enum pic_tt {
   PIC_TT_SYMBOL,
   PIC_TT_PROC,
   PIC_TT_PORT,
-  PIC_TT_STRING
+  PIC_TT_STRING,
+  PIC_TT_ENV
 };
 
 #define PIC_OBJECT_HEADER			\
diff --git a/src/codegen.c b/src/codegen.c
index 4dade0f4..e7a7bdf1 100644
--- a/src/codegen.c
+++ b/src/codegen.c
@@ -343,6 +343,7 @@ codegen(codegen_state *state, pic_value obj)
     irep->clen++;
     break;
   }
+  case PIC_TT_ENV:
   case PIC_TT_PROC:
   case PIC_TT_UNDEF:
   case PIC_TT_EOF:
@@ -445,7 +446,7 @@ pic_codegen(pic_state *pic, pic_value obj)
   codegen(state, obj);
   state->irep->code[state->irep->clen].insn = OP_STOP;
   state->irep->clen++;
-  proc = pic_proc_new(pic, state->irep);
+  proc = pic_proc_new(pic, state->irep, NULL);
 
   destroy_codegen_state(pic, state);
 
diff --git a/src/gc.c b/src/gc.c
index caca103a..b06af423 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -159,8 +159,22 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_SYMBOL: {
     break;
   }
+  case PIC_TT_ENV: {
+    struct pic_env *env = (struct pic_env *)obj;
+    int i;
+
+    for (i = 0; i < env->numcv; ++i) {
+      gc_mark(pic, env->values[i]);
+    }
+    gc_mark_object(pic, (struct pic_object *)env->up);
+    break;
+  }
   case PIC_TT_PROC: {
-    gc_mark(pic, ((struct pic_proc *)obj)->aux);
+    struct pic_proc *proc = (struct pic_proc *)obj;
+    if (proc->env) {
+      gc_mark_object(pic, (struct pic_object *)proc->env);
+    }
+    gc_mark(pic, proc->aux);
     break;
   }
   case PIC_TT_PORT: {
@@ -268,6 +282,10 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_PAIR: {
     break;
   }
+  case PIC_TT_ENV: {
+    pic_free(pic, ((struct pic_env *)obj)->values);
+    break;
+  }
   case PIC_TT_PROC: {
     break;
   }
diff --git a/src/port.c b/src/port.c
index be7884c9..ece8ced6 100644
--- a/src/port.c
+++ b/src/port.c
@@ -49,6 +49,8 @@ write(pic_state *pic, pic_value obj)
     write_str(pic, pic_str_ptr(obj));
     printf("\"");
     break;
+  case PIC_TT_ENV:
+    pic_abort(pic, "logic flaw");
   }
 }
 
diff --git a/src/proc.c b/src/proc.c
index 292c4f51..7020f3a2 100644
--- a/src/proc.c
+++ b/src/proc.c
@@ -3,13 +3,14 @@
 #include "picrin/irep.h"
 
 struct pic_proc *
-pic_proc_new(pic_state *pic, struct pic_irep *irep)
+pic_proc_new(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->u.irep = irep;
+  proc->env = env;
   proc->aux = pic_undef_value();
   return proc;
 }
@@ -22,6 +23,7 @@ pic_proc_new_cfunc(pic_state *pic, pic_func_t cfunc, pic_value aux)
   proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc *), PIC_TT_PROC);
   proc->cfunc_p = true;
   proc->u.cfunc = cfunc;
+  proc->env = NULL;
   proc->aux = aux;
   return proc;
 }
diff --git a/src/vm.c b/src/vm.c
index d6e810c7..946eaf04 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -241,8 +241,12 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
     }
     CASE(OP_LAMBDA) {
       struct pic_proc *proc;
+      struct pic_env *env;
 
-      proc = pic_proc_new(pic, pic->irep[pc->u.i]);
+      env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
+      env->up = pic_proc_ptr(*pic->ci->fp)->env;
+
+      proc = pic_proc_new(pic, pic->irep[pc->u.i], env);
       PUSH(pic_obj_value(proc));
       pic_gc_arena_restore(pic, ai);
       NEXT;