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 @@ -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, "#", pic_ptr(obj)); break; + case PIC_TT_BOX: + xfprintf(file, "#", pic_ptr(obj)); + break; } }