diff --git a/docs/lang.rst b/docs/lang.rst index 9d6c6786..220addb2 100644 --- a/docs/lang.rst +++ b/docs/lang.rst @@ -55,6 +55,37 @@ Libraries Delimited control operators. +- ``(picrin dictionary)`` + + Symbol to Object table. Internally it is implemented on hash-table. + + Note that dictionary is not a weak map; if you are going to make a highly memory-consuming program with dictionaries, you should know that dictionaries keep their bound objects and never let them free until you explicitly deletes bindings. + + - ``(dictionary)`` + + Returns a newly allocated empty dictionary. In the future, it is planned to extend this function to take optional arguments for initial key/values. + + - ``(dictionary? obj)`` + + Returns ``#t`` if obj is a dictionary. + + - ``(dictionary-ref dict key)`` + + Look up dictionary dict for a value associated with symbol key. If no object is associated with key, it will raise an error. + + - ``(dictionary-set! dict key obj)`` + + If there is no value already associated with key, this function newly creates a binding of key with obj. Otherwise, updates the existing binding with given obj. + + - ``(dictionary-delete dict key)`` + + Deletes the binding associated with key from dict. If no binding on dict is associated with key, an error will be raised. + + + - ``(dictionary-size dict)`` + + Returns the number of registered elements in dict. + - ``(picrin user)`` When you start the REPL, you are dropped into here. diff --git a/extlib/xhash b/extlib/xhash index 47a31fdb..ddc2ea28 160000 --- a/extlib/xhash +++ b/extlib/xhash @@ -1 +1 @@ -Subproject commit 47a31fdbf88ea61f060b7cb45203b3a2f0149e9f +Subproject commit ddc2ea288b37b3f5de37024ff2648d11aa18811a diff --git a/include/picrin/dict.h b/include/picrin/dict.h new file mode 100644 index 00000000..bb720534 --- /dev/null +++ b/include/picrin/dict.h @@ -0,0 +1,24 @@ +/** + * See Copyright Notice in picrin.h + */ + +#ifndef PICRIN_DICT_H__ +#define PICRIN_DICT_H__ + +#if defined(__cplusplus) +extern "C" { +#endif + +struct pic_dict { + PIC_OBJECT_HEADER + xhash hash; +}; + +#define pic_dict_p(v) (pic_type(v) == PIC_TT_DICT) +#define pic_dict_ptr(v) ((struct pic_dict *)pic_ptr(v)) + +#if defined(__cplusplus) +} +#endif + +#endif diff --git a/include/picrin/value.h b/include/picrin/value.h index 600140b7..44dd0763 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -116,7 +116,8 @@ enum pic_tt { PIC_TT_VAR, PIC_TT_IREP, PIC_TT_DATA, - PIC_TT_BOX + PIC_TT_BOX, + PIC_TT_DICT }; #define PIC_OBJECT_HEADER \ @@ -146,7 +147,8 @@ typedef struct pic_blob pic_blob; #define pic_sym(v) ((v).u.sym) #define pic_char(v) ((v).u.c) -#define pic_obj_ptr(o) ((struct pic_object *)pic_ptr(o)) +#define pic_obj_p(v) (pic_vtype(v) == PIC_VTYPE_HEAP) +#define pic_obj_ptr(v) ((struct pic_object *)pic_ptr(v)) #define pic_nil_p(v) (pic_vtype(v) == PIC_VTYPE_NIL) #define pic_true_p(v) (pic_vtype(v) == PIC_VTYPE_TRUE) @@ -269,6 +271,8 @@ pic_type_repr(enum pic_tt tt) return "data"; case PIC_TT_BOX: return "box"; + case PIC_TT_DICT: + return "dict"; } UNREACHABLE(); } diff --git a/src/codegen.c b/src/codegen.c index 1940ea8f..63abd247 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -825,6 +825,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) case PIC_TT_IREP: case PIC_TT_DATA: case PIC_TT_BOX: + case PIC_TT_DICT: pic_errorf(pic, "invalid expression given: ~s", obj); } UNREACHABLE(); diff --git a/src/dict.c b/src/dict.c new file mode 100644 index 00000000..ddbe2cb5 --- /dev/null +++ b/src/dict.c @@ -0,0 +1,100 @@ +/** + * See Copyright Notice in picrin.h + */ + +#include "picrin.h" +#include "picrin/dict.h" + +static pic_value +pic_dict_dict(pic_state *pic) +{ + struct pic_dict *dict; + + pic_get_args(pic, ""); + + dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT); + + xh_init_int(&dict->hash, sizeof(pic_value)); + + return pic_obj_value(dict); +} + +static pic_value +pic_dict_dict_p(pic_state *pic) +{ + pic_value obj; + + pic_get_args(pic, "o", &obj); + + return pic_bool_value(pic_dict_p(obj)); +} + +static pic_value +pic_dict_dict_ref(pic_state *pic) +{ + struct pic_dict *dict; + pic_sym key; + xh_entry *e; + + pic_get_args(pic, "dm", &dict, &key); + + e = xh_get_int(&dict->hash, key); + if (! e) { + pic_errorf(pic, "element not found for a key: ~s", pic_sym_value(key)); + } + return xh_val(e, pic_value); +} + +static pic_value +pic_dict_dict_set(pic_state *pic) +{ + struct pic_dict *dict; + pic_sym key; + pic_value val; + + pic_get_args(pic, "dmo", &dict, &key, &val); + + xh_put_int(&dict->hash, key, &val); + + return pic_none_value(); +} + +static pic_value +pic_dict_dict_del(pic_state *pic) +{ + struct pic_dict *dict; + pic_sym key; + + pic_get_args(pic, "dm", &dict, &key); + + if (xh_get_int(&dict->hash, key) == NULL) { + pic_errorf(pic, "no slot named ~s found in dictionary", pic_sym_value(key)); + } + + xh_del_int(&dict->hash, key); + + return pic_none_value(); +} + +static pic_value +pic_dict_dict_size(pic_state *pic) +{ + struct pic_dict *dict; + + pic_get_args(pic, "d", &dict); + + return pic_int_value(dict->hash.count); +} + +void +pic_init_dict(pic_state *pic) +{ + pic_deflibrary ("(picrin dictionary)") { + pic_defun(pic, "dictionary", pic_dict_dict); + pic_defun(pic, "dictionary?", pic_dict_dict_p); + pic_defun(pic, "dictionary-ref", pic_dict_dict_ref); + pic_defun(pic, "dictionary-set!", pic_dict_dict_set); + pic_defun(pic, "dictionary-delete", pic_dict_dict_del); + pic_defun(pic, "dictionary-size", pic_dict_dict_size); + } +} diff --git a/src/gc.c b/src/gc.c index a2dc677e..efbd98f5 100644 --- a/src/gc.c +++ b/src/gc.c @@ -20,6 +20,7 @@ #include "picrin/var.h" #include "picrin/data.h" #include "picrin/box.h" +#include "picrin/dict.h" #if GC_DEBUG # include @@ -504,6 +505,16 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) gc_mark(pic, box->value); break; } + case PIC_TT_DICT: { + struct pic_dict *dict = (struct pic_dict *)obj; + xh_iter it; + + xh_begin(&it, &dict->hash); + 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: @@ -657,6 +668,11 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj) case PIC_TT_BOX: { break; } + case PIC_TT_DICT: { + struct pic_dict *dict = (struct pic_dict *)obj; + xh_destroy(&dict->hash); + break; + } case PIC_TT_NIL: case PIC_TT_BOOL: case PIC_TT_FLOAT: diff --git a/src/init.c b/src/init.c index 26050194..91e55daa 100644 --- a/src/init.c +++ b/src/init.c @@ -29,6 +29,7 @@ void pic_init_macro(pic_state *); void pic_init_var(pic_state *); void pic_init_load(pic_state *); void pic_init_write(pic_state *); +void pic_init_dict(pic_state *); void pic_load_piclib(pic_state *); @@ -93,6 +94,7 @@ pic_init_core(pic_state *pic) pic_init_var(pic); DONE; pic_init_load(pic); DONE; pic_init_write(pic); DONE; + pic_init_dict(pic); DONE; pic_load_piclib(pic); DONE; diff --git a/src/macro.c b/src/macro.c index 12752cec..7783c0e4 100644 --- a/src/macro.c +++ b/src/macro.c @@ -569,6 +569,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu case PIC_TT_IREP: case PIC_TT_DATA: case PIC_TT_BOX: + case PIC_TT_DICT: pic_errorf(pic, "unexpected value type: ~s", expr); } UNREACHABLE(); diff --git a/src/vm.c b/src/vm.c index 8709b574..c2d0b1e0 100644 --- a/src/vm.c +++ b/src/vm.c @@ -19,6 +19,7 @@ #include "picrin/lib.h" #include "picrin/macro.h" #include "picrin/error.h" +#include "picrin/dict.h" #define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)]) @@ -49,6 +50,7 @@ pic_get_proc(pic_state *pic) * c char * l lambda object * p port object + * d dictionary object * * | optional operator * * variable length operator @@ -327,6 +329,23 @@ pic_get_args(pic_state *pic, const char *format, ...) } break; } + case 'd': { + struct pic_dict **d; + pic_value v; + + d = va_arg(ap, struct pic_dict **); + if (i < argc) { + v = GET_OPERAND(pic,i); + if (pic_dict_p(v)) { + *d = pic_dict_ptr(v); + } + else { + pic_error(pic, "pic_get_args, expected dictionary"); + } + i++; + } + break; + } default: pic_error(pic, "pic_get_args: invalid argument specifier given"); } diff --git a/src/write.c b/src/write.c index 2eb3575e..952bf436 100644 --- a/src/write.c +++ b/src/write.c @@ -338,6 +338,9 @@ write_core(struct writer_control *p, pic_value obj) case PIC_TT_BOX: xfprintf(file, "#", pic_ptr(obj)); break; + case PIC_TT_DICT: + xfprintf(file, "#", pic_ptr(obj)); + break; } }