conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use xh_new_int

This commit is contained in:
Yuichi Nishiwaki 2014-02-07 01:08:57 +09:00
parent 104fd823b2
commit a4062b5b76
4 changed files with 57 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
src/codegen.c
View File

@ -104,7 +104,7 @@ static void pop_scope(analyze_state *);
#define register_renamed_symbol(pic, state, slot, lib, name) do { \ #define register_renamed_symbol(pic, state, slot, lib, name) do { \
struct xh_entry *e; \ struct xh_entry *e; \
if (! (e = xh_get(lib->senv->tbl, name))) \ if (! (e = xh_get_int(lib->senv->tbl, pic_intern_cstr(pic, name)))) \
pic_error(pic, "internal error! native VM procedure not found"); \ pic_error(pic, "internal error! native VM procedure not found"); \
state->slot = e->val; \ state->slot = e->val; \
} while (0) } while (0)
@ -149,7 +149,7 @@ new_analyze_state(pic_state *pic)
global_tbl = pic->global_tbl; global_tbl = pic->global_tbl;
for (xh_begin(global_tbl, &it); ! xh_isend(&it); xh_next(&it)) { for (xh_begin(global_tbl, &it); ! xh_isend(&it); xh_next(&it)) {
xh_put(state->scope->var_tbl, it.e->key, 0); xh_put_int(state->scope->var_tbl, (long)it.e->key, 0);
} }
return state; return state;
@ -171,7 +171,7 @@ push_scope(analyze_state *state, pic_value args)
scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope));
scope->up = state->scope; scope->up = state->scope;
scope->var_tbl = xh_new(); scope->var_tbl = xh_new_int();
scope->varg = false; scope->varg = false;
scope->vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc); scope->vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc);
@ -180,7 +180,7 @@ push_scope(analyze_state *state, pic_value args)
} }
for (i = 1; i < scope->argc + scope->localc; ++i) { for (i = 1; i < scope->argc + scope->localc; ++i) {
xh_put(scope->var_tbl, pic_symbol_name(pic, scope->vars[i]), 0); xh_put_int(scope->var_tbl, scope->vars[i], 0);
} }
state->scope = scope; state->scope = scope;
@ -206,14 +206,13 @@ lookup_var(analyze_state *state, pic_sym sym)
analyze_scope *scope = state->scope; analyze_scope *scope = state->scope;
struct xh_entry *e; struct xh_entry *e;
int depth = 0; int depth = 0;
const char *key = pic_symbol_name(state->pic, sym);
enter: enter:
e = xh_get(scope->var_tbl, key); e = xh_get_int(scope->var_tbl, sym);
if (e) { if (e) {
if (depth > 0) { /* mark dirty */ if (depth > 0) { /* mark dirty */
xh_put(scope->var_tbl, key, 1); xh_put_int(scope->var_tbl, sym, 1);
} }
return depth; return depth;
} }
@ -230,9 +229,8 @@ define_var(analyze_state *state, pic_sym sym)
{ {
pic_state *pic = state->pic; pic_state *pic = state->pic;
analyze_scope *scope = state->scope; analyze_scope *scope = state->scope;
const char *name = pic_symbol_name(pic, sym);
xh_put(state->scope->var_tbl, name, 0); xh_put_int(state->scope->var_tbl, sym, 0);
scope->localc++; scope->localc++;
scope->vars = (pic_sym *)pic_realloc(pic, scope->vars, sizeof(pic_sym) * (scope->argc + scope->localc)); scope->vars = (pic_sym *)pic_realloc(pic, scope->vars, sizeof(pic_sym) * (scope->argc + scope->localc));
@ -638,7 +636,7 @@ analyze_lambda(analyze_state *state, pic_value obj)
closes = pic_nil_value(); closes = pic_nil_value();
for (i = 1; i < scope->argc + scope->localc; ++i) { for (i = 1; i < scope->argc + scope->localc; ++i) {
pic_sym var = scope->vars[i]; pic_sym var = scope->vars[i];
if (xh_get(scope->var_tbl, pic_symbol_name(pic, var))->val == 1) { if (xh_get_int(scope->var_tbl, var)->val == 1) {
closes = pic_cons(pic, pic_symbol_value(var), closes); closes = pic_cons(pic, pic_symbol_value(var), closes);
} }
} }
@ -721,26 +719,26 @@ push_resolver_scope(resolver_state *state, pic_value args, pic_value locals, boo
scope = (resolver_scope *)pic_alloc(pic, sizeof(resolver_scope)); scope = (resolver_scope *)pic_alloc(pic, sizeof(resolver_scope));
scope->up = state->scope; scope->up = state->scope;
scope->depth = scope->up ? scope->up->depth + 1 : 0; scope->depth = scope->up ? scope->up->depth + 1 : 0;
scope->lvs = xh_new(); scope->lvs = xh_new_int();
scope->cvs = xh_new(); scope->cvs = xh_new_int();
scope->argc = pic_length(pic, args) + 1; scope->argc = pic_length(pic, args) + 1;
scope->localc = pic_length(pic, locals); scope->localc = pic_length(pic, locals);
scope->varg = varg; scope->varg = varg;
/* arguments */ /* arguments */
for (i = 1; i < scope->argc; ++i) { for (i = 1; i < scope->argc; ++i) {
xh_put(scope->lvs, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, args, i - 1))), i); xh_put_int(scope->lvs, pic_sym(pic_list_ref(pic, args, i - 1)), i);
} }
/* locals */ /* locals */
for (i = 0; i < scope->localc; ++i) { for (i = 0; i < scope->localc; ++i) {
xh_put(scope->lvs, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, locals, i))), scope->argc + i); xh_put_int(scope->lvs, pic_sym(pic_list_ref(pic, locals, i)), scope->argc + i);
} }
/* closed variables */ /* closed variables */
scope->cv_num = 0; scope->cv_num = 0;
for (i = 0, c = pic_length(pic, closes); i < c; ++i) { for (i = 0, c = pic_length(pic, closes); i < c; ++i) {
xh_put(scope->cvs, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, closes, i))), scope->cv_num++); xh_put_int(scope->cvs, pic_sym(pic_list_ref(pic, closes, i)), scope->cv_num++);
} }
state->scope = scope; state->scope = scope;
@ -763,18 +761,17 @@ pop_resolver_scope(resolver_state *state)
static bool static bool
is_closed(resolver_state *state, pic_sym sym) is_closed(resolver_state *state, pic_sym sym)
{ {
return xh_get(state->scope->cvs, pic_symbol_name(state->pic, sym)) != NULL; return xh_get_int(state->scope->cvs, sym) != NULL;
} }
static pic_value static pic_value
resolve_gref(resolver_state *state, pic_sym sym) resolve_gref(resolver_state *state, pic_sym sym)
{ {
pic_state *pic = state->pic; pic_state *pic = state->pic;
const char *name = pic_symbol_name(pic, sym);
struct xh_entry *e; struct xh_entry *e;
size_t i; size_t i;
if ((e = xh_get(pic->global_tbl, name))) { if ((e = xh_get_int(pic->global_tbl, sym))) {
i = e->val; i = e->val;
} }
else { else {
@ -782,7 +779,7 @@ resolve_gref(resolver_state *state, pic_sym sym)
if (i >= pic->gcapa) { if (i >= pic->gcapa) {
pic_error(pic, "global table overflow"); pic_error(pic, "global table overflow");
} }
xh_put(pic->global_tbl, name, i); xh_put_int(pic->global_tbl, sym, i);
} }
return pic_list(pic, 2, pic_symbol_value(state->sGREF), pic_int_value(i)); return pic_list(pic, 2, pic_symbol_value(state->sGREF), pic_int_value(i));
} }
@ -793,7 +790,7 @@ resolve_lref(resolver_state *state, pic_sym sym)
pic_state *pic = state->pic; pic_state *pic = state->pic;
int i; int i;
i = xh_get(state->scope->lvs, pic_symbol_name(pic, sym))->val; i = xh_get_int(state->scope->lvs, sym)->val;
return pic_list(pic, 2, pic_symbol_value(state->sLREF), pic_int_value(i)); return pic_list(pic, 2, pic_symbol_value(state->sLREF), pic_int_value(i));
} }
@ -810,7 +807,7 @@ resolve_cref(resolver_state *state, int depth, pic_sym sym)
scope = scope->up; scope = scope->up;
} }
i = xh_get(scope->cvs, pic_symbol_name(pic, sym))->val; i = xh_get_int(scope->cvs, sym)->val;
return pic_list(pic, 3, return pic_list(pic, 3,
pic_symbol_value(state->sCREF), pic_symbol_value(state->sCREF),
@ -993,12 +990,12 @@ push_codegen_context(codegen_state *state, pic_value args, pic_value locals, boo
cxt->varg = varg; cxt->varg = varg;
/* number local variables */ /* number local variables */
vars = xh_new(); vars = xh_new_int();
for (i = 1; i < cxt->argc; ++i) { for (i = 1; i < cxt->argc; ++i) {
xh_put(vars, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, args, i - 1))), i); xh_put_int(vars, pic_sym(pic_list_ref(pic, args, i - 1)), i);
} }
for (i = 0; i < cxt->localc; ++i) { for (i = 0; i < cxt->localc; ++i) {
xh_put(vars, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, locals, i))), cxt->argc + i); xh_put_int(vars, pic_sym(pic_list_ref(pic, locals, i)), cxt->argc + i);
} }
/* closed variables */ /* closed variables */
@ -1007,7 +1004,7 @@ push_codegen_context(codegen_state *state, pic_value args, pic_value locals, boo
for (i = 0, c = pic_length(pic, closes); i < c; ++i) { for (i = 0, c = pic_length(pic, closes); i < c; ++i) {
i = cxt->cv_num++; i = cxt->cv_num++;
cxt->cv_tbl = (unsigned *)pic_realloc(pic, cxt->cv_tbl, sizeof(unsigned) * cxt->cv_num); cxt->cv_tbl = (unsigned *)pic_realloc(pic, cxt->cv_tbl, sizeof(unsigned) * cxt->cv_num);
cxt->cv_tbl[i] = xh_get(vars, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, closes, i))))->val; cxt->cv_tbl[i] = xh_get_int(vars, pic_sym(pic_list_ref(pic, closes, i)))->val;
} }
xh_destroy(vars); xh_destroy(vars);
@ -1439,15 +1436,15 @@ pic_compile(pic_state *pic, pic_value obj)
} }
static int static int
scope_global_define(pic_state *pic, const char *name) scope_global_define(pic_state *pic, pic_sym sym)
{ {
struct xh_entry *e; struct xh_entry *e;
if ((e = xh_get(pic->global_tbl, name))) { if ((e = xh_get_int(pic->global_tbl, sym))) {
pic_warn(pic, "redefining global"); pic_warn(pic, "redefining global");
return e->val; return e->val;
} }
e = xh_put(pic->global_tbl, name, pic->glen++); e = xh_put_int(pic->global_tbl, sym, pic->glen++);
if (pic->glen >= pic->gcapa) { if (pic->glen >= pic->gcapa) {
pic_error(pic, "global table overflow"); pic_error(pic, "global table overflow");
} }
@ -1458,16 +1455,17 @@ void
pic_define(pic_state *pic, const char *name, pic_value val) pic_define(pic_state *pic, const char *name, pic_value val)
{ {
int idx; int idx;
pic_sym gsym; pic_sym sym, gsym;
gsym = pic_gensym(pic, pic_intern_cstr(pic, name)); sym = pic_intern_cstr(pic, name);
gsym = pic_gensym(pic, sym);
/* push to the global arena */ /* push to the global arena */
idx = scope_global_define(pic, pic_symbol_name(pic, gsym)); idx = scope_global_define(pic, gsym);
pic->globals[idx] = val; pic->globals[idx] = val;
/* register to the senv */ /* register to the senv */
xh_put(pic->lib->senv->tbl, name, gsym); xh_put_int(pic->lib->senv->tbl, sym, gsym);
/* export! */ /* export! */
pic_export(pic, pic_intern_cstr(pic, name)); pic_export(pic, pic_intern_cstr(pic, name));
@ -1477,12 +1475,14 @@ static int
global_ref(pic_state *pic, const char *name) global_ref(pic_state *pic, const char *name)
{ {
struct xh_entry *e; struct xh_entry *e;
pic_sym sym;
if (! (e = xh_get(pic->lib->senv->tbl, name))) { sym = pic_intern_cstr(pic, name);
if (! (e = xh_get_int(pic->lib->senv->tbl, sym))) {
pic_error(pic, "symbol not defined"); pic_error(pic, "symbol not defined");
} }
assert(e->val >= 0); assert(e->val >= 0);
if (! (e = xh_get(pic->global_tbl, pic_symbol_name(pic, (pic_sym)e->val)))) { if (! (e = xh_get_int(pic->global_tbl, e->val))) {
pic_abort(pic, "logic flaw"); pic_abort(pic, "logic flaw");
} }
return e->val; return e->val;

2
src/lib.c
View File

@ -29,7 +29,7 @@ pic_make_library(pic_state *pic, pic_value name)
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB); lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
lib->senv = senv; lib->senv = senv;
lib->exports = xh_new(); lib->exports = xh_new_int();
lib->name = name; lib->name = name;
/* register! */ /* register! */

37
src/macro.c
View File

@ -23,7 +23,7 @@ pic_null_syntactic_env(pic_state *pic)
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV); senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
senv->up = NULL; senv->up = NULL;
senv->tbl = xh_new(); senv->tbl = xh_new_int();
senv->stx = (struct pic_syntax **)pic_calloc(pic, PIC_MACROS_SIZE, sizeof(struct pic_syntax *)); senv->stx = (struct pic_syntax **)pic_calloc(pic, PIC_MACROS_SIZE, sizeof(struct pic_syntax *));
senv->xlen = 0; senv->xlen = 0;
senv->xcapa = PIC_MACROS_SIZE; senv->xcapa = PIC_MACROS_SIZE;
@ -32,8 +32,9 @@ pic_null_syntactic_env(pic_state *pic)
} }
#define register_core_syntax(pic,senv,kind,name) do { \ #define register_core_syntax(pic,senv,kind,name) do { \
senv->stx[senv->xlen] = pic_syntax_new(pic, kind, pic_intern_cstr(pic, name)); \ pic_sym sym = pic_intern_cstr(pic, name); \
xh_put(senv->tbl, name, ~senv->xlen); \ senv->stx[senv->xlen] = pic_syntax_new(pic, kind, sym); \
xh_put_int(senv->tbl, sym, ~senv->xlen); \
senv->xlen++; \ senv->xlen++; \
} while (0) } while (0)
@ -83,7 +84,7 @@ new_local_senv(pic_state *pic, pic_value formals, struct pic_senv *up)
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV); senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
senv->up = up; senv->up = up;
senv->tbl = xh_new(); senv->tbl = xh_new_int();
senv->stx = NULL; senv->stx = NULL;
senv->xlen = 0; senv->xlen = 0;
senv->xcapa = 0; senv->xcapa = 0;
@ -98,14 +99,14 @@ new_local_senv(pic_state *pic, pic_value formals, struct pic_senv *up)
pic_error(pic, "syntax error"); pic_error(pic, "syntax error");
} }
sym = pic_sym(v); sym = pic_sym(v);
xh_put(senv->tbl, pic_symbol_name(pic, sym), (int)pic_gensym(pic, sym)); xh_put_int(senv->tbl, sym, pic_gensym(pic, sym));
} }
if (! pic_sym_p(a)) { if (! pic_sym_p(a)) {
a = macroexpand(pic, a, up); a = macroexpand(pic, a, up);
} }
if (pic_sym_p(a)) { if (pic_sym_p(a)) {
sym = pic_sym(a); sym = pic_sym(a);
xh_put(senv->tbl, pic_symbol_name(pic, sym), (int)pic_gensym(pic, sym)); xh_put_int(senv->tbl, sym, pic_gensym(pic, sym));
} }
else if (! pic_nil_p(a)) { else if (! pic_nil_p(a)) {
pic_error(pic, "syntax error"); pic_error(pic, "syntax error");
@ -196,7 +197,7 @@ pic_import(pic_state *pic, pic_value spec)
} }
#endif #endif
if (it.e->val >= 0) { if (it.e->val >= 0) {
xh_put(pic->lib->senv->tbl, it.e->key, it.e->val); xh_put_int(pic->lib->senv->tbl, (long)it.e->key, it.e->val);
} }
else { /* syntax object */ else { /* syntax object */
size_t idx; size_t idx;
@ -208,7 +209,7 @@ pic_import(pic_state *pic, pic_value spec)
} }
/* bring macro object from imported lib */ /* bring macro object from imported lib */
senv->stx[idx] = lib->senv->stx[~it.e->val]; senv->stx[idx] = lib->senv->stx[~it.e->val];
xh_put(senv->tbl, it.e->key, ~idx); xh_put_int(senv->tbl, (long)it.e->key, ~idx);
senv->xlen++; senv->xlen++;
} }
} }
@ -219,28 +220,30 @@ pic_export(pic_state *pic, pic_sym sym)
{ {
struct xh_entry *e; struct xh_entry *e;
e = xh_get(pic->lib->senv->tbl, pic_symbol_name(pic, sym)); e = xh_get_int(pic->lib->senv->tbl, sym);
if (! e) { if (! e) {
pic_error(pic, "symbol not defined"); pic_error(pic, "symbol not defined");
} }
xh_put(pic->lib->exports, e->key, e->val); xh_put_int(pic->lib->exports, (long)e->key, e->val);
} }
static void static void
pic_defsyntax(pic_state *pic, const char *name, struct pic_proc *macro, struct pic_senv *mac_env) pic_defsyntax(pic_state *pic, const char *name, struct pic_proc *macro, struct pic_senv *mac_env)
{ {
pic_sym sym;
struct pic_syntax *stx; struct pic_syntax *stx;
struct pic_senv *global_senv = pic->lib->senv; struct pic_senv *global_senv = pic->lib->senv;
size_t idx; size_t idx;
stx = pic_syntax_new_macro(pic, pic_intern_cstr(pic, name), macro, mac_env); sym = pic_intern_cstr(pic, name);
stx = pic_syntax_new_macro(pic, sym, macro, mac_env);
idx = global_senv->xlen; idx = global_senv->xlen;
if (idx >= global_senv->xcapa) { if (idx >= global_senv->xcapa) {
pic_abort(pic, "macro table overflow"); pic_abort(pic, "macro table overflow");
} }
global_senv->stx[idx] = stx; global_senv->stx[idx] = stx;
xh_put(global_senv->tbl, name, ~idx); xh_put_int(global_senv->tbl, sym, ~idx);
global_senv->xlen++; global_senv->xlen++;
} }
@ -276,9 +279,9 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
return expr; return expr;
} }
while (true) { while (true) {
if ((e = xh_get(senv->tbl, pic_symbol_name(pic, pic_sym(expr)))) != NULL) { if ((e = xh_get_int(senv->tbl, pic_sym(expr))) != NULL) {
if (e->val >= 0) if (e->val >= 0)
return pic_symbol_value((pic_sym)e->val); return pic_symbol_value(e->val);
else else
return pic_obj_value(senv->stx[~e->val]); return pic_obj_value(senv->stx[~e->val]);
} }
@ -287,7 +290,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
senv = senv->up; senv = senv->up;
} }
uniq = pic_gensym(pic, pic_sym(expr)); uniq = pic_gensym(pic, pic_sym(expr));
xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(expr)), (int)uniq); xh_put_int(senv->tbl, pic_sym(expr), uniq);
return pic_symbol_value(uniq); return pic_symbol_value(uniq);
} }
case PIC_TT_PAIR: { case PIC_TT_PAIR: {
@ -475,7 +478,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
pic_error(pic, "binding to non-symbol object"); pic_error(pic, "binding to non-symbol object");
} }
sym = pic_sym(a); sym = pic_sym(a);
xh_put(senv->tbl, pic_symbol_name(pic, sym), (int)pic_gensym(pic, sym)); xh_put_int(senv->tbl, sym, pic_gensym(pic, sym));
/* binding value */ /* binding value */
v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym), v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),
@ -495,7 +498,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
pic_error(pic, "binding to non-symbol object"); pic_error(pic, "binding to non-symbol object");
} }
uniq = pic_gensym(pic, pic_sym(var)); uniq = pic_gensym(pic, pic_sym(var));
xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(var)), (int)uniq); xh_put_int(senv->tbl, pic_sym(var), (int)uniq);
} }
FALLTHROUGH; FALLTHROUGH;
case PIC_STX_SET: case PIC_STX_SET:

4
src/state.c
View File

@ -53,14 +53,14 @@ pic_open(int argc, char *argv[], char **envp)
init_heap(pic->heap); init_heap(pic->heap);
/* symbol table */ /* symbol table */
pic->sym_tbl = xh_new(); pic->sym_tbl = xh_new_str();
pic->sym_pool = (const char **)calloc(PIC_SYM_POOL_SIZE, sizeof(const char *)); pic->sym_pool = (const char **)calloc(PIC_SYM_POOL_SIZE, sizeof(const char *));
pic->slen = 0; pic->slen = 0;
pic->scapa = pic->slen + PIC_SYM_POOL_SIZE; pic->scapa = pic->slen + PIC_SYM_POOL_SIZE;
pic->uniq_sym_count = 0; pic->uniq_sym_count = 0;
/* global variables */ /* global variables */
pic->global_tbl = xh_new(); pic->global_tbl = xh_new_int();
pic->globals = (pic_value *)calloc(PIC_GLOBALS_SIZE, sizeof(pic_value)); pic->globals = (pic_value *)calloc(PIC_GLOBALS_SIZE, sizeof(pic_value));
pic->glen = 0; pic->glen = 0;
pic->gcapa = PIC_GLOBALS_SIZE; pic->gcapa = PIC_GLOBALS_SIZE;