refactor parameter. var data structure is no longer used

gc.c

@@ -15,7 +15,6 @@
 #include "picrin/error.h"
 #include "picrin/macro.h"
 #include "picrin/lib.h"
-#include "picrin/var.h"
 #include "picrin/data.h"
 #include "picrin/dict.h"
 #include "picrin/record.h"
@@ -462,14 +461,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     gc_mark_object(pic, (struct pic_object *)lib->env);
     break;
   }
-  case PIC_TT_VAR: {
-    struct pic_var *var = (struct pic_var *)obj;
-    gc_mark(pic, var->stack);
-    if (var->conv) {
-      gc_mark_object(pic, (struct pic_object *)var->conv);
-    }
-    break;
-  }
   case PIC_TT_IREP: {
     struct pic_irep *irep = (struct pic_irep *)obj;
     size_t i;
@@ -699,9 +690,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     xh_destroy(&lib->exports);
     break;
   }
-  case PIC_TT_VAR: {
-    break;
-  }
   case PIC_TT_IREP: {
     struct pic_irep *irep = (struct pic_irep *)obj;
     pic_free(pic, irep->code);

include/picrin.h

@@ -217,6 +217,8 @@ static inline void pic_warn(pic_state *pic, const char *msg)
 
 const char *pic_errmsg(pic_state *);
 
+struct pic_proc *pic_make_var(pic_state *, pic_value, struct pic_proc *);
+
 struct pic_port *pic_stdin(pic_state *);
 struct pic_port *pic_stdout(pic_state *);
 struct pic_port *pic_stderr(pic_state *);

include/picrin/value.h

@@ -121,7 +121,6 @@ enum pic_tt {
   PIC_TT_SENV,
   PIC_TT_MACRO,
   PIC_TT_LIB,
-  PIC_TT_VAR,
   PIC_TT_IREP,
   PIC_TT_DATA,
   PIC_TT_DICT,
@@ -266,8 +265,6 @@ pic_type_repr(enum pic_tt tt)
     return "macro";
   case PIC_TT_LIB:
     return "lib";
-  case PIC_TT_VAR:
-    return "var";
   case PIC_TT_IREP:
     return "irep";
   case PIC_TT_DATA:

include/picrin/var.h

@@ -1,30 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#ifndef PICRIN_VAR_H
-#define PICRIN_VAR_H
-
-#if defined(__cplusplus)
-extern "C" {
-#endif
-
-struct pic_var {
-  PIC_OBJECT_HEADER
-  pic_value stack;
-  struct pic_proc *conv;
-};
-
-#define pic_var_p(o) (pic_type(o) == PIC_TT_VAR)
-#define pic_var_ptr(o) ((struct pic_var *)pic_ptr(o))
-
-struct pic_var *pic_make_var(pic_state *, pic_value, struct pic_proc * /* = NULL */);
-
-pic_value pic_var_ref(pic_state *, struct pic_var *);
-void pic_var_set(pic_state *, struct pic_var *, pic_value);
-
-#if defined(__cplusplus)
-}
-#endif
-
-#endif

port.c

@@ -11,7 +11,6 @@
 #include "picrin/port.h"
 #include "picrin/string.h"
 #include "picrin/blob.h"
-#include "picrin/var.h"
 
 pic_value
 pic_eof_object()

var.c

@@ -3,53 +3,91 @@
  */
 
 #include "picrin.h"
-#include "picrin/var.h"
 #include "picrin/pair.h"
+#include "picrin/proc.h"
+#include "picrin/dict.h"
 
-struct pic_var *
+static pic_value
+var_lookup(pic_state *pic, pic_value var)
+{
+  pic_value val, env;
+  struct pic_dict *binding;
+
+  val = pic_ref(pic, pic->PICRIN_BASE, "current-dynamic-environment");
+  if (pic_eq_p(val, var)) {
+    return pic_false_value();
+  }
+
+  env = pic_funcall(pic, "current-dynamic-environment", pic_nil_value());
+  while (! pic_nil_p(env)) {
+    pic_assert_type(pic, pic_car(pic, env), dict);
+
+    binding = pic_dict_ptr(pic_car(pic, env));
+    if (pic_dict_has(pic, binding, var)) {
+      return pic_dict_ref(pic, binding, var);
+    }
+    env = pic_cdr(pic, env);
+  }
+
+  return pic_false_value();
+}
+
+static pic_value
+var_call(pic_state *pic)
+{
+  struct pic_proc *self = pic_get_proc(pic);
+  pic_value val, tmp, box, conv;
+  size_t n;
+
+  n = pic_get_args(pic, "|oo", &val, &tmp);
+
+  box = var_lookup(pic, pic_obj_value(self));
+  if (! pic_test(box)) {
+    box = pic_attr_ref(pic, self, "@@box");
+  }
+
+  switch (n) {
+  case 0:
+    return pic_car(pic, box);
+
+  case 1:
+    conv = pic_attr_ref(pic, self, "@@converter");
+    if (pic_test(conv)) {
+      pic_assert_type(pic, conv, proc);
+
+      val = pic_apply1(pic, pic_proc_ptr(conv), val);
+    }
+    pic_set_car(pic, box, val);
+
+    return pic_none_value();
+
+  case 2:
+    assert(pic_false_p(tmp));
+
+    conv = pic_attr_ref(pic, self, "@@converter");
+    if (pic_test(conv)) {
+      pic_assert_type(pic, conv, proc);
+
+      return pic_apply1(pic, pic_proc_ptr(conv), val);
+    } else {
+      return val;
+    }
+  }
+  UNREACHABLE();
+}
+
+struct pic_proc *
 pic_make_var(pic_state *pic, pic_value init, struct pic_proc *conv)
 {
-  struct pic_var *var;
+  struct pic_proc *var;
 
-  var = (struct pic_var *)pic_obj_alloc(pic, sizeof(struct pic_var), PIC_TT_VAR);
-  var->stack = pic_nil_value();
-  var->conv = conv;
-
-  pic_var_push(pic, var, init);
+  var = pic_make_proc(pic, var_call, "<var-call>");
+  pic_attr_set(pic, var, "@@box", pic_list1(pic, init));
+  pic_attr_set(pic, var, "@@converter", conv ? pic_obj_value(conv) : pic_false_value());
 
   return var;
 }
 
-pic_value
-pic_var_ref(pic_state *pic, struct pic_var *var)
-{
-  return pic_car(pic, var->stack);
-}
-
-void
-pic_var_set(pic_state *pic, struct pic_var *var, pic_value value)
-{
-  if (var->conv != NULL) {
-    value = pic_apply1(pic, var->conv, value);
-  }
-  pic_set_car(pic, var->stack, value);
-}
-
-void
-pic_var_push(pic_state *pic, struct pic_var *var, pic_value value)
-{
-  if (var->conv != NULL) {
-    value = pic_apply1(pic, var->conv, value);
-  }
-  var->stack = pic_cons(pic, value, var->stack);
-}
-
-void
-pic_var_pop(pic_state *pic, struct pic_var *var)
-{
-  var->stack = pic_cdr(pic, var->stack);
-}
-
 static pic_value
 pic_var_make_parameter(pic_state *pic)
 {
@@ -61,72 +99,12 @@ pic_var_make_parameter(pic_state *pic)
   return pic_obj_value(pic_make_var(pic, init, conv));
 }
 
-static pic_value
-pic_var_parameter_ref(pic_state *pic)
-{
-  struct pic_var *var;
-  pic_value v;
-
-  pic_get_args(pic, "o", &v);
-
-  pic_assert_type(pic, v, var);
-
-  var = pic_var_ptr(v);
-
-  return pic_var_ref(pic, var);
-}
-
-static pic_value
-pic_var_parameter_set(pic_state *pic)
-{
-  struct pic_var *var;
-  pic_value v, val;
-
-  pic_get_args(pic, "oo", &v, &val);
-
-  pic_assert_type(pic, v, var);
-
-  var = pic_var_ptr(v);
-  pic_var_set(pic, var, val);
-  return pic_none_value();
-}
-
-static pic_value
-pic_var_parameter_push(pic_state *pic)
-{
-  struct pic_var *var;
-  pic_value v, val;
-
-  pic_get_args(pic, "oo", &v, &val);
-
-  pic_assert_type(pic, v, var);
-
-  var = pic_var_ptr(v);
-  pic_var_push(pic, var, val);
-  return pic_none_value();
-}
-
-static pic_value
-pic_var_parameter_pop(pic_state *pic)
-{
-  struct pic_var *var;
-  pic_value v;
-
-  pic_get_args(pic, "o", &v);
-
-  pic_assert_type(pic, v, var);
-
-  var = pic_var_ptr(v);
-  pic_var_pop(pic, var);
-  return pic_none_value();
-}
-
 void
 pic_init_var(pic_state *pic)
 {
+  pic_define(pic, "current-dynamic-environment", pic_false_value());
+
   pic_defun(pic, "make-parameter", pic_var_make_parameter);
-  pic_defun(pic, "parameter-ref", pic_var_parameter_ref);
-  pic_defun(pic, "parameter-set!", pic_var_parameter_set);
-  pic_defun(pic, "parameter-push!", pic_var_parameter_push);
-  pic_defun(pic, "parameter-pop!", pic_var_parameter_pop);
+
+  pic_set(pic, pic->PICRIN_BASE, "current-dynamic-environment", pic_obj_value(pic_make_var(pic, pic_nil_value(), NULL)));
 }

vm.c

@@ -15,7 +15,6 @@
 #include "picrin/port.h"
 #include "picrin/irep.h"
 #include "picrin/blob.h"
-#include "picrin/var.h"
 #include "picrin/lib.h"
 #include "picrin/macro.h"
 #include "picrin/error.h"
@@ -826,15 +825,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
     L_CALL:
       x = pic->sp[-c.u.i];
       if (! pic_proc_p(x)) {
-
-        if (pic_var_p(x)) {
-          if (c.u.i != 1) {
-            pic_errorf(pic, "invalid call-sequence for var object");
-          }
-          POP();
-          PUSH(pic_var_ref(pic, pic_var_ptr(x)));
-          NEXT;
-        }
 	pic_errorf(pic, "invalid application: ~s", x);
       }
       proc = pic_proc_ptr(x);