From d8c182bc692bdbee007b379e6682005cee23aa1e Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 29 Mar 2014 20:42:06 +0900
Subject: [PATCH] add user-defined data type API

---
 include/picrin/data.h  | 33 +++++++++++++++++++++++++++++++++
 include/picrin/value.h |  5 ++++-
 src/codegen.c          |  1 +
 src/data.c             | 15 +++++++++++++++
 src/gc.c               | 17 +++++++++++++++++
 src/macro.c            |  1 +
 src/write.c            |  3 +++
 7 files changed, 74 insertions(+), 1 deletion(-)
 create mode 100644 include/picrin/data.h
 create mode 100644 src/data.c

diff --git a/include/picrin/data.h b/include/picrin/data.h
new file mode 100644
index 00000000..84c2f580
--- /dev/null
+++ b/include/picrin/data.h
@@ -0,0 +1,33 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#ifndef PICRIN_DATA_H__
+#define PICRIN_DATA_H__
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+typedef struct {
+  const char *type_name;
+  void (*dtor)(pic_state *, void *);
+} pic_data_type;
+
+struct pic_data {
+  PIC_OBJECT_HEADER;
+  const pic_data_type *type;
+  xhash storage;                /* const char * to pic_value table */
+  void *data;
+};
+
+#define pic_data_p(o) (pic_type(o) == PIC_TT_DATA)
+#define pic_data_ptr(o) ((struct pic_data *)pic_ptr(o))
+
+struct pic_data *pic_data_alloc(pic_state *, const pic_data_type *, void *);
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif
diff --git a/include/picrin/value.h b/include/picrin/value.h
index 8079dae9..74bfef10 100644
--- a/include/picrin/value.h
+++ b/include/picrin/value.h
@@ -114,7 +114,8 @@ enum pic_tt {
   PIC_TT_SC,
   PIC_TT_LIB,
   PIC_TT_VAR,
-  PIC_TT_IREP
+  PIC_TT_IREP,
+  PIC_TT_DATA
 };
 
 #define PIC_OBJECT_HEADER			\
@@ -258,6 +259,8 @@ pic_type_repr(enum pic_tt tt)
     return "var";
   case PIC_TT_IREP:
     return "irep";
+  case PIC_TT_DATA:
+    return "data";
   }
   return 0;                     /* logic flaw */
 }
diff --git a/src/codegen.c b/src/codegen.c
index 9ab47032..3ca94193 100644
--- a/src/codegen.c
+++ b/src/codegen.c
@@ -823,6 +823,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
   case PIC_TT_LIB:
   case PIC_TT_VAR:
   case PIC_TT_IREP:
+  case PIC_TT_DATA:
     pic_errorf(pic, "invalid expression given: ~s", obj);
   }
   UNREACHABLE();
diff --git a/src/data.c b/src/data.c
new file mode 100644
index 00000000..5d586c56
--- /dev/null
+++ b/src/data.c
@@ -0,0 +1,15 @@
+#include "picrin.h"
+#include "picrin/data.h"
+
+struct pic_data *
+pic_data_alloc(pic_state *pic, const pic_data_type *type, void *userdata)
+{
+  struct pic_data *data;
+
+  data = (struct pic_data *)pic_obj_alloc(pic, sizeof(struct pic_data), PIC_TT_DATA);
+  data->type = type;
+  data->data = userdata;
+  xh_init_str(&data->storage, sizeof(pic_value));
+
+  return data;
+}
diff --git a/src/gc.c b/src/gc.c
index 8a43a215..e450b785 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -18,6 +18,7 @@
 #include "picrin/macro.h"
 #include "picrin/lib.h"
 #include "picrin/var.h"
+#include "picrin/data.h"
 
 #if GC_DEBUG
 # include <string.h>
@@ -485,6 +486,16 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     }
     break;
   }
+  case PIC_TT_DATA: {
+    struct pic_data *data = (struct pic_data *)obj;
+    xh_iter it;
+
+    xh_begin(&it, &data->storage);
+    while (xh_next(&it)) {
+      gc_mark(pic, xh_val(it.e, pic_value));
+    }
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
@@ -629,6 +640,12 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     pic_free(pic, irep->pool);
     break;
   }
+  case PIC_TT_DATA: {
+    struct pic_data *data = (struct pic_data *)obj;
+    data->type->dtor(pic, data->data);
+    xh_destroy(&data->storage);
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
diff --git a/src/macro.c b/src/macro.c
index 7a5bbe83..d89488e3 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -508,6 +508,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
   case PIC_TT_LIB:
   case PIC_TT_VAR:
   case PIC_TT_IREP:
+  case PIC_TT_DATA:
     pic_error(pic, "unexpected value type");
     return pic_undef_value();	/* unreachable */
   }
diff --git a/src/write.c b/src/write.c
index daf0b3a3..56379593 100644
--- a/src/write.c
+++ b/src/write.c
@@ -332,6 +332,9 @@ write_core(struct writer_control *p, pic_value obj)
   case PIC_TT_IREP:
     xfprintf(file, "#<irep %p>", pic_ptr(obj));
     break;
+  case PIC_TT_DATA:
+    xfprintf(file, "#<data %p>", pic_ptr(obj));
+    break;
   }
 }