From 215164033126d9a239ace8d4f2f99887e958104e Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 29 Mar 2014 16:55:37 +0900
Subject: [PATCH] add native box API

---
 include/picrin/box.h   | 28 ++++++++++++++++++++++++++++
 include/picrin/value.h |  7 +++++--
 src/box.c              | 30 ++++++++++++++++++++++++++++++
 src/codegen.c          |  1 +
 src/gc.c               |  9 +++++++++
 src/macro.c            |  1 +
 src/write.c            |  3 +++
 7 files changed, 77 insertions(+), 2 deletions(-)
 create mode 100644 include/picrin/box.h
 create mode 100644 src/box.c

diff --git a/include/picrin/box.h b/include/picrin/box.h
new file mode 100644
index 00000000..f9826eed
--- /dev/null
+++ b/include/picrin/box.h
@@ -0,0 +1,28 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#ifndef PICRIN_BOX_H__
+#define PICRIN_BOX_H__
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+struct pic_box {
+  PIC_OBJECT_HEADER
+  pic_value value;
+};
+
+#define pic_box_p(v) (pic_type(v) == PIC_TT_BOX)
+#define pic_box_ptr(v) ((struct pic_box *)pic_ptr(v))
+
+pic_value pic_box(pic_state *, pic_value);
+pic_value pic_unbox(pic_state *, pic_value);
+void pic_set_box(pic_state *, pic_value, pic_value);
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif
diff --git a/include/picrin/value.h b/include/picrin/value.h
index 17155d80..600140b7 100644
--- a/include/picrin/value.h
+++ b/include/picrin/value.h
@@ -115,7 +115,8 @@ enum pic_tt {
   PIC_TT_LIB,
   PIC_TT_VAR,
   PIC_TT_IREP,
-  PIC_TT_DATA
+  PIC_TT_DATA,
+  PIC_TT_BOX
 };
 
 #define PIC_OBJECT_HEADER			\
@@ -266,8 +267,10 @@ pic_type_repr(enum pic_tt tt)
     return "irep";
   case PIC_TT_DATA:
     return "data";
+  case PIC_TT_BOX:
+    return "box";
   }
-  return 0;                     /* logic flaw */
+  UNREACHABLE();
 }
 
 static inline bool
diff --git a/src/box.c b/src/box.c
new file mode 100644
index 00000000..b9948fc7
--- /dev/null
+++ b/src/box.c
@@ -0,0 +1,30 @@
+#include "picrin.h"
+#include "picrin/box.h"
+
+pic_value
+pic_box(pic_state *pic, pic_value value)
+{
+  struct pic_box *box;
+
+  box = (struct pic_box *)pic_obj_alloc(pic, sizeof(struct pic_box), PIC_TT_BOX);
+  box->value = value;
+  return pic_obj_value(box);
+}
+
+pic_value
+pic_unbox(pic_state *pic, pic_value box)
+{
+  if (! pic_box_p(box)) {
+    pic_errorf(pic, "expected box, but got ~s", box);
+  }
+  return pic_box_ptr(box)->value;
+}
+
+void
+pic_set_box(pic_state *pic, pic_value box, pic_value value)
+{
+  if (! pic_box_p(box)) {
+    pic_errorf(pic, "expected box, but got ~s", box);
+  }
+  pic_box_ptr(box)->value = value;
+}
diff --git a/src/codegen.c b/src/codegen.c
index 3ca94193..ef9bd216 100644
--- a/src/codegen.c
+++ b/src/codegen.c
@@ -824,6 +824,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
   case PIC_TT_VAR:
   case PIC_TT_IREP:
   case PIC_TT_DATA:
+  case PIC_TT_BOX:
     pic_errorf(pic, "invalid expression given: ~s", obj);
   }
   UNREACHABLE();
diff --git a/src/gc.c b/src/gc.c
index e450b785..81906f66 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -19,6 +19,7 @@
 #include "picrin/lib.h"
 #include "picrin/var.h"
 #include "picrin/data.h"
+#include "picrin/box.h"
 
 #if GC_DEBUG
 # include <string.h>
@@ -496,6 +497,11 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     }
     break;
   }
+  case PIC_TT_BOX: {
+    struct pic_box *box = (struct pic_box *)obj;
+    gc_mark(pic, box->value);
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
@@ -646,6 +652,9 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     xh_destroy(&data->storage);
     break;
   }
+  case PIC_TT_BOX: {
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
diff --git a/src/macro.c b/src/macro.c
index 255f1654..a01ac238 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -509,6 +509,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
   case PIC_TT_VAR:
   case PIC_TT_IREP:
   case PIC_TT_DATA:
+  case PIC_TT_BOX:
     pic_errorf(pic, "unexpected value type: ~s", expr);
   }
   UNREACHABLE();
diff --git a/src/write.c b/src/write.c
index 56379593..4c59d8ed 100644
--- a/src/write.c
+++ b/src/write.c
@@ -335,6 +335,9 @@ write_core(struct writer_control *p, pic_value obj)
   case PIC_TT_DATA:
     xfprintf(file, "#<data %p>", pic_ptr(obj));
     break;
+  case PIC_TT_BOX:
+    xfprintf(file, "#<box %p>", pic_ptr(obj));
+    break;
   }
 }