add pic_env struct

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

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			\

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

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;
   }

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");
   }
 }
 

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;
 }

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;