2013-10-10 04:22:25 -04:00
|
|
|
#include <string.h>
|
2013-10-13 03:01:40 -04:00
|
|
|
#include <stdlib.h>
|
2013-10-10 04:22:25 -04:00
|
|
|
|
|
|
|
#include "picrin.h"
|
2013-10-28 13:11:31 -04:00
|
|
|
#include "xhash/xhash.h"
|
2013-10-20 01:05:35 -04:00
|
|
|
|
2013-10-28 13:11:31 -04:00
|
|
|
pic_sym
|
|
|
|
pic_intern_cstr(pic_state *pic, const char *str)
|
2013-10-20 01:05:35 -04:00
|
|
|
{
|
2013-10-28 13:11:31 -04:00
|
|
|
struct xh_entry *e;
|
|
|
|
pic_sym id;
|
2013-10-20 01:05:35 -04:00
|
|
|
|
2013-10-28 13:11:31 -04:00
|
|
|
e = xh_get(pic->sym_tbl, str);
|
|
|
|
if (e) {
|
|
|
|
return e->val;
|
2013-10-20 01:05:35 -04:00
|
|
|
}
|
|
|
|
|
2013-10-28 13:16:26 -04:00
|
|
|
if (pic->slen >= pic->scapa) {
|
|
|
|
pic->scapa *= 2;
|
|
|
|
pic->sym_pool = pic_realloc(pic, pic->sym_pool, sizeof(const char *) * pic->scapa);
|
|
|
|
}
|
2013-10-28 13:11:31 -04:00
|
|
|
id = pic->slen++;
|
|
|
|
pic->sym_pool[id] = strdup(str);
|
|
|
|
xh_put(pic->sym_tbl, str, id);
|
|
|
|
return id;
|
2013-10-20 01:05:35 -04:00
|
|
|
}
|
|
|
|
|
2013-10-28 13:11:31 -04:00
|
|
|
const char *
|
|
|
|
pic_symbol_name(pic_state *pic, pic_sym sym)
|
2013-10-20 01:05:35 -04:00
|
|
|
{
|
2013-10-28 13:11:31 -04:00
|
|
|
return pic->sym_pool[sym];
|
2013-10-10 04:22:25 -04:00
|
|
|
}
|
2013-10-28 13:49:38 -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_symbol_p(v));
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_symbol_symbol_to_string(pic_state *pic)
|
|
|
|
{
|
|
|
|
pic_value v;
|
|
|
|
|
|
|
|
pic_get_args(pic, "o", &v);
|
|
|
|
|
|
|
|
if (! pic_symbol_p(v)) {
|
|
|
|
pic_error(pic, "symbol->string: expected symbol");
|
|
|
|
}
|
|
|
|
|
2013-11-17 10:28:42 -05:00
|
|
|
return pic_obj_value(pic_str_new_cstr(pic, pic_symbol_name(pic, pic_sym(v))));
|
2013-10-28 13:49:38 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_symbol_string_to_symbol(pic_state *pic)
|
|
|
|
{
|
|
|
|
pic_value v;
|
|
|
|
|
|
|
|
pic_get_args(pic, "o", &v);
|
|
|
|
|
|
|
|
if (! pic_str_p(v)) {
|
|
|
|
pic_error(pic, "string->symbol: expected string");
|
|
|
|
}
|
|
|
|
|
|
|
|
return pic_symbol_value(pic_intern_cstr(pic, pic_str_ptr(v)->str));
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
pic_init_symbol(pic_state *pic)
|
|
|
|
{
|
|
|
|
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);
|
|
|
|
}
|