picrin/extlib/benz/symbol.c

130 lines
2.2 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "picrin/symbol.h"
2014-08-25 00:38:09 -04:00
#include "picrin/string.h"
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;
}
2014-08-25 00:38:09 -04:00
pic_sym
2015-01-18 12:21:10 -05:00
pic_intern(pic_state *pic, pic_str *str)
2014-08-25 00:38:09 -04:00
{
xh_entry *e;
pic_sym sym;
char *cstr;
2014-08-25 00:38:09 -04:00
2015-01-18 12:21:10 -05:00
e = xh_get_str(&pic->syms, pic_str_cstr(str));
2014-08-25 00:38:09 -04:00
if (e) {
return xh_val(e, pic_sym);
}
cstr = pic_malloc(pic, pic_strlen(str) + 1);
2015-01-18 12:21:10 -05:00
strcpy(cstr, pic_str_cstr(str));
sym = pic_make_symbol(pic, str);
xh_put_str(&pic->syms, cstr, &sym);
return sym;
2014-08-25 00:38:09 -04:00
}
pic_sym
pic_intern_cstr(pic_state *pic, const char *str)
{
2015-01-18 12:21:10 -05:00
return pic_intern(pic, pic_make_str(pic, str, strlen(str)));
2014-08-26 00:29:36 -04:00
}
2014-08-25 00:38:09 -04:00
pic_sym
pic_gensym(pic_state *pic, pic_sym base)
{
return pic_make_symbol(pic, base->str);
2014-08-25 00:38:09 -04:00
}
bool
pic_interned_p(pic_state *pic, pic_sym sym)
{
2015-01-18 23:12:04 -05:00
xh_entry *e;
e = xh_get_str(&pic->syms, pic_str_cstr(sym->str));
if (e) {
return sym == xh_val(e, pic_sym);
} else {
return false;
}
2014-08-25 00:38:09 -04:00
}
const char *
pic_symbol_name(pic_state *pic, pic_sym sym)
{
PIC_UNUSED(pic);
return pic_str_cstr(sym->str);
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)
{
2014-09-27 07:17:02 -04:00
size_t 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)
{
pic_sym sym;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "m", &sym);
2014-08-25 00:38:09 -04:00
return pic_obj_value(sym->str);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_symbol_string_to_symbol(pic_state *pic)
{
pic_str *str;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "s", &str);
2014-08-25 00:38:09 -04:00
2015-01-18 21:08:27 -05:00
return pic_obj_value(pic_intern(pic, str));
2014-08-25 00:38:09 -04:00
}
void
pic_init_symbol(pic_state *pic)
{
2014-08-31 22:37:52 -04:00
pic_defun(pic, "symbol?", pic_symbol_symbol_p);
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
}