/** * See Copyright Notice in picrin.h */ #include "picrin.h" KHASH_DEFINE(s, const char *, pic_sym *, kh_str_hash_func, kh_str_hash_equal) static pic_sym * pic_make_symbol(pic_state *pic, pic_str *str) { pic_sym *sym; sym = (pic_sym *)pic_obj_alloc(pic, sizeof(struct pic_symbol), PIC_TT_SYMBOL); sym->str = str; return sym; } pic_sym * pic_intern(pic_state *pic, pic_str *str) { khash_t(s) *h = &pic->syms; pic_sym *sym; char *cstr; khiter_t it; int ret; it = kh_put(s, h, pic_str_cstr(pic, str), &ret); if (ret == 0) { /* if exists */ sym = kh_val(h, it); pic_gc_protect(pic, pic_obj_value(sym)); return sym; } cstr = pic_malloc(pic, pic_str_len(str) + 1); strcpy(cstr, pic_str_cstr(pic, str)); kh_key(h, it) = cstr; sym = pic_make_symbol(pic, str); kh_val(h, it) = sym; return sym; } pic_sym * pic_intern_cstr(pic_state *pic, const char *str) { return pic_intern(pic, pic_make_str(pic, str, strlen(str))); } const char * pic_symbol_name(pic_state *pic, pic_sym *sym) { return pic_str_cstr(pic, sym->str); } static pic_value pic_symbol_symbol_p(pic_state *pic) { pic_value v; pic_get_args(pic, "o", &v); return pic_bool_value(pic_sym_p(v)); } static pic_value pic_symbol_symbol_eq_p(pic_state *pic) { size_t argc, i; pic_value *argv; pic_get_args(pic, "*", &argc, &argv); for (i = 0; i < argc; ++i) { if (! pic_sym_p(argv[i])) { return pic_false_value(); } if (! pic_eq_p(argv[i], argv[0])) { return pic_false_value(); } } return pic_true_value(); } static pic_value pic_symbol_symbol_to_string(pic_state *pic) { pic_sym *sym; pic_get_args(pic, "m", &sym); return pic_obj_value(sym->str); } static pic_value pic_symbol_string_to_symbol(pic_state *pic) { pic_str *str; pic_get_args(pic, "s", &str); return pic_obj_value(pic_intern(pic, str)); } void pic_init_symbol(pic_state *pic) { void pic_defun_vm(pic_state *, const char *, pic_sym *, pic_func_t); pic_defun_vm(pic, "symbol?", pic->uSYMBOLP, pic_symbol_symbol_p); pic_defun(pic, "symbol->string", pic_symbol_symbol_to_string); pic_defun(pic, "string->symbol", pic_symbol_string_to_symbol); pic_defun(pic, "symbol=?", pic_symbol_symbol_eq_p); }