2014-08-25 00:38:09 -04:00
|
|
|
/**
|
|
|
|
* See Copyright Notice in picrin.h
|
|
|
|
*/
|
|
|
|
|
|
|
|
#include "picrin.h"
|
|
|
|
|
2015-06-24 18:05:41 -04:00
|
|
|
KHASH_DEFINE(s, const char *, pic_sym *, kh_str_hash_func, kh_str_hash_equal)
|
|
|
|
|
2015-06-25 13:32:59 -04:00
|
|
|
pic_sym *
|
2015-07-12 19:16:04 -04:00
|
|
|
pic_intern_str(pic_state *pic, pic_str *str)
|
2015-01-18 20:59:35 -05:00
|
|
|
{
|
2015-07-12 19:16:04 -04:00
|
|
|
return pic_intern(pic, pic_str_cstr(pic, str));
|
2015-01-18 20:59:35 -05:00
|
|
|
}
|
|
|
|
|
2015-01-20 02:02:28 -05:00
|
|
|
pic_sym *
|
2015-07-12 19:16:04 -04:00
|
|
|
pic_intern(pic_state *pic, const char *cstr)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
2015-06-24 18:05:41 -04:00
|
|
|
khash_t(s) *h = &pic->syms;
|
2015-01-20 02:02:28 -05:00
|
|
|
pic_sym *sym;
|
2015-06-24 18:05:41 -04:00
|
|
|
khiter_t it;
|
|
|
|
int ret;
|
2015-06-25 13:32:59 -04:00
|
|
|
char *copy;
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2015-06-25 13:32:59 -04:00
|
|
|
it = kh_put(s, h, cstr, &ret);
|
2015-06-24 18:05:41 -04:00
|
|
|
if (ret == 0) { /* if exists */
|
|
|
|
sym = kh_val(h, it);
|
2015-01-19 00:09:47 -05:00
|
|
|
pic_gc_protect(pic, pic_obj_value(sym));
|
|
|
|
return sym;
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
2015-06-25 13:32:59 -04:00
|
|
|
copy = pic_malloc(pic, strlen(cstr) + 1);
|
|
|
|
strcpy(copy, cstr);
|
|
|
|
kh_key(h, it) = copy;
|
2015-01-18 12:21:10 -05:00
|
|
|
|
2015-07-01 16:36:09 -04:00
|
|
|
kh_val(h, it) = pic->sQUOTE; /* insert dummy */
|
2015-06-27 12:47:56 -04:00
|
|
|
|
2015-06-25 13:32:59 -04:00
|
|
|
sym = (pic_sym *)pic_obj_alloc(pic, sizeof(pic_sym), PIC_TT_SYMBOL);
|
|
|
|
sym->cstr = copy;
|
2015-06-24 18:05:41 -04:00
|
|
|
kh_val(h, it) = sym;
|
|
|
|
|
2015-01-18 20:59:35 -05:00
|
|
|
return sym;
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
const char *
|
2015-06-25 13:32:59 -04:00
|
|
|
pic_symbol_name(pic_state PIC_UNUSED(*pic), pic_sym *sym)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
2015-06-25 13:32:59 -04:00
|
|
|
return sym->cstr;
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
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)
|
|
|
|
{
|
2015-08-26 06:04:27 -04:00
|
|
|
int argc, i;
|
2014-08-25 00:38:09 -04:00
|
|
|
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)
|
|
|
|
{
|
2015-01-20 02:02:28 -05:00
|
|
|
pic_sym *sym;
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2015-01-18 20:59:35 -05:00
|
|
|
pic_get_args(pic, "m", &sym);
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2015-06-25 13:32:59 -04:00
|
|
|
return pic_obj_value(pic_make_str_cstr(pic, sym->cstr));
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_symbol_string_to_symbol(pic_state *pic)
|
|
|
|
{
|
2015-01-18 20:59:35 -05:00
|
|
|
pic_str *str;
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2015-01-18 20:59:35 -05:00
|
|
|
pic_get_args(pic, "s", &str);
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2015-07-12 19:16:04 -04:00
|
|
|
return pic_obj_value(pic_intern_str(pic, str));
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
pic_init_symbol(pic_state *pic)
|
|
|
|
{
|
2015-07-01 17:17:27 -04:00
|
|
|
pic_defun(pic, "symbol?", pic_symbol_symbol_p);
|
2015-06-04 00:53:41 -04:00
|
|
|
|
2014-08-31 22:37:52 -04:00
|
|
|
pic_defun(pic, "symbol->string", pic_symbol_symbol_to_string);
|
|
|
|
pic_defun(pic, "string->symbol", pic_symbol_string_to_symbol);
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2014-08-31 22:37:52 -04:00
|
|
|
pic_defun(pic, "symbol=?", pic_symbol_symbol_eq_p);
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|