Merge branch 'master' into trampoline
This commit is contained in:
commit
d100dde6b1
|
@ -1 +1 @@
|
|||
Subproject commit b9d10d4fc9bed39c95f0155f520ea1a8b37d70fe
|
||||
Subproject commit 44c9f36dca1bbc2b158c812359a7e9d5a5f7e9bb
|
|
@ -33,6 +33,8 @@ extern "C" {
|
|||
#include <setjmp.h>
|
||||
#include <stdio.h>
|
||||
|
||||
#include "xhash/xhash.h"
|
||||
|
||||
#if __STDC_VERSION__ >= 201112L
|
||||
# define NORETURN _Noreturn
|
||||
#elif __GNUC__ || __clang__
|
||||
|
@ -94,12 +96,12 @@ typedef struct {
|
|||
pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
|
||||
pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;
|
||||
|
||||
struct xhash *sym_tbl;
|
||||
xhash *sym_tbl;
|
||||
const char **sym_pool;
|
||||
size_t slen, scapa;
|
||||
int uniq_sym_count;
|
||||
|
||||
struct xhash *global_tbl;
|
||||
xhash *global_tbl;
|
||||
pic_value *globals;
|
||||
size_t glen, gcapa;
|
||||
|
||||
|
|
|
@ -13,7 +13,7 @@ struct pic_lib {
|
|||
PIC_OBJECT_HEADER
|
||||
pic_value name;
|
||||
struct pic_senv *senv;
|
||||
struct xhash *exports;
|
||||
xhash *exports;
|
||||
};
|
||||
|
||||
#define pic_lib_ptr(o) ((struct pic_lib *)pic_ptr(o))
|
||||
|
|
|
@ -13,7 +13,7 @@ struct pic_senv {
|
|||
PIC_OBJECT_HEADER
|
||||
struct pic_senv *up;
|
||||
/* positive for variables, negative for macros (bitwise-not) */
|
||||
struct xhash *tbl;
|
||||
xhash *tbl;
|
||||
struct pic_syntax **stx;
|
||||
size_t xlen, xcapa;
|
||||
};
|
||||
|
|
142
src/codegen.c
142
src/codegen.c
|
@ -11,7 +11,6 @@
|
|||
#include "picrin/proc.h"
|
||||
#include "picrin/lib.h"
|
||||
#include "picrin/macro.h"
|
||||
#include "xhash/xhash.h"
|
||||
|
||||
#if PIC_NONE_IS_FALSE
|
||||
# define OP_PUSHNONE OP_PUSHFALSE
|
||||
|
@ -80,7 +79,7 @@ typedef struct analyze_scope {
|
|||
bool varg;
|
||||
int argc, localc;
|
||||
/* if variable v is captured, then xh_get(var_tbl, v) == 1 */
|
||||
struct xhash *var_tbl;
|
||||
xhash *var_tbl;
|
||||
pic_sym *vars;
|
||||
|
||||
struct analyze_scope *up;
|
||||
|
@ -103,8 +102,8 @@ static void pop_scope(analyze_state *);
|
|||
} while (0)
|
||||
|
||||
#define register_renamed_symbol(pic, state, slot, lib, name) do { \
|
||||
struct xh_entry *e; \
|
||||
if (! (e = xh_get(lib->senv->tbl, name))) \
|
||||
xh_entry *e; \
|
||||
if (! (e = xh_get_int(lib->senv->tbl, pic_intern_cstr(pic, name)))) \
|
||||
pic_error(pic, "internal error! native VM procedure not found"); \
|
||||
state->slot = e->val; \
|
||||
} while (0)
|
||||
|
@ -113,8 +112,8 @@ static analyze_state *
|
|||
new_analyze_state(pic_state *pic)
|
||||
{
|
||||
analyze_state *state;
|
||||
struct xhash *global_tbl;
|
||||
struct xh_iter it;
|
||||
xhash *global_tbl;
|
||||
xh_iter it;
|
||||
struct pic_lib *stdlib;
|
||||
|
||||
state = (analyze_state *)pic_alloc(pic, sizeof(analyze_state));
|
||||
|
@ -149,7 +148,7 @@ new_analyze_state(pic_state *pic)
|
|||
|
||||
global_tbl = pic->global_tbl;
|
||||
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;
|
||||
|
@ -171,7 +170,7 @@ push_scope(analyze_state *state, pic_value args)
|
|||
|
||||
scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope));
|
||||
scope->up = state->scope;
|
||||
scope->var_tbl = xh_new();
|
||||
scope->var_tbl = xh_new_int();
|
||||
scope->varg = false;
|
||||
scope->vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc);
|
||||
|
||||
|
@ -180,7 +179,7 @@ push_scope(analyze_state *state, pic_value args)
|
|||
}
|
||||
|
||||
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;
|
||||
|
@ -204,16 +203,15 @@ static int
|
|||
lookup_var(analyze_state *state, pic_sym sym)
|
||||
{
|
||||
analyze_scope *scope = state->scope;
|
||||
struct xh_entry *e;
|
||||
xh_entry *e;
|
||||
int depth = 0;
|
||||
const char *key = pic_symbol_name(state->pic, sym);
|
||||
|
||||
enter:
|
||||
|
||||
e = xh_get(scope->var_tbl, key);
|
||||
e = xh_get_int(scope->var_tbl, sym);
|
||||
if (e) {
|
||||
if (depth > 0) { /* mark dirty */
|
||||
xh_put(scope->var_tbl, key, 1);
|
||||
xh_put_int(scope->var_tbl, sym, 1);
|
||||
}
|
||||
return depth;
|
||||
}
|
||||
|
@ -230,9 +228,14 @@ define_var(analyze_state *state, pic_sym sym)
|
|||
{
|
||||
pic_state *pic = state->pic;
|
||||
analyze_scope *scope = state->scope;
|
||||
const char *name = pic_symbol_name(pic, sym);
|
||||
xh_entry *e;
|
||||
|
||||
xh_put(state->scope->var_tbl, name, 0);
|
||||
if ((e = xh_get_int(scope->var_tbl, sym))) {
|
||||
pic_warn(pic, "redefining variable");
|
||||
return;
|
||||
}
|
||||
|
||||
xh_put_int(scope->var_tbl, sym, 0);
|
||||
|
||||
scope->localc++;
|
||||
scope->vars = (pic_sym *)pic_realloc(pic, scope->vars, sizeof(pic_sym) * (scope->argc + scope->localc));
|
||||
|
@ -638,7 +641,7 @@ analyze_lambda(analyze_state *state, pic_value obj)
|
|||
closes = pic_nil_value();
|
||||
for (i = 1; i < scope->argc + scope->localc; ++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);
|
||||
}
|
||||
}
|
||||
|
@ -669,7 +672,7 @@ typedef struct resolver_scope {
|
|||
int depth;
|
||||
bool varg;
|
||||
int argc, localc;
|
||||
struct xhash *cvs, *lvs;
|
||||
xhash *cvs, *lvs;
|
||||
unsigned cv_num;
|
||||
|
||||
struct resolver_scope *up;
|
||||
|
@ -721,26 +724,26 @@ push_resolver_scope(resolver_state *state, pic_value args, pic_value locals, boo
|
|||
scope = (resolver_scope *)pic_alloc(pic, sizeof(resolver_scope));
|
||||
scope->up = state->scope;
|
||||
scope->depth = scope->up ? scope->up->depth + 1 : 0;
|
||||
scope->lvs = xh_new();
|
||||
scope->cvs = xh_new();
|
||||
scope->lvs = xh_new_int();
|
||||
scope->cvs = xh_new_int();
|
||||
scope->argc = pic_length(pic, args) + 1;
|
||||
scope->localc = pic_length(pic, locals);
|
||||
scope->varg = varg;
|
||||
|
||||
/* arguments */
|
||||
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 */
|
||||
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 */
|
||||
scope->cv_num = 0;
|
||||
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;
|
||||
|
@ -763,18 +766,17 @@ pop_resolver_scope(resolver_state *state)
|
|||
static bool
|
||||
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
|
||||
resolve_gref(resolver_state *state, pic_sym sym)
|
||||
{
|
||||
pic_state *pic = state->pic;
|
||||
const char *name = pic_symbol_name(pic, sym);
|
||||
struct xh_entry *e;
|
||||
xh_entry *e;
|
||||
size_t i;
|
||||
|
||||
if ((e = xh_get(pic->global_tbl, name))) {
|
||||
if ((e = xh_get_int(pic->global_tbl, sym))) {
|
||||
i = e->val;
|
||||
}
|
||||
else {
|
||||
|
@ -782,7 +784,7 @@ resolve_gref(resolver_state *state, pic_sym sym)
|
|||
if (i >= pic->gcapa) {
|
||||
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));
|
||||
}
|
||||
|
@ -793,7 +795,7 @@ resolve_lref(resolver_state *state, pic_sym sym)
|
|||
pic_state *pic = state->pic;
|
||||
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));
|
||||
}
|
||||
|
@ -810,7 +812,7 @@ resolve_cref(resolver_state *state, int depth, pic_sym sym)
|
|||
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,
|
||||
pic_symbol_value(state->sCREF),
|
||||
|
@ -984,7 +986,7 @@ push_codegen_context(codegen_state *state, pic_value args, pic_value locals, boo
|
|||
pic_state *pic = state->pic;
|
||||
codegen_context *cxt;
|
||||
int i, c;
|
||||
struct xhash *vars;
|
||||
xhash *vars;
|
||||
|
||||
cxt = (codegen_context *)pic_alloc(pic, sizeof(codegen_context));
|
||||
cxt->up = state->cxt;
|
||||
|
@ -993,12 +995,12 @@ push_codegen_context(codegen_state *state, pic_value args, pic_value locals, boo
|
|||
cxt->varg = varg;
|
||||
|
||||
/* number local variables */
|
||||
vars = xh_new();
|
||||
vars = xh_new_int();
|
||||
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) {
|
||||
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 */
|
||||
|
@ -1007,7 +1009,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) {
|
||||
i = 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);
|
||||
|
@ -1439,61 +1441,68 @@ pic_compile(pic_state *pic, pic_value obj)
|
|||
}
|
||||
|
||||
static int
|
||||
scope_global_define(pic_state *pic, const char *name)
|
||||
global_ref(pic_state *pic, const char *name)
|
||||
{
|
||||
struct xh_entry *e;
|
||||
xh_entry *e;
|
||||
pic_sym sym;
|
||||
|
||||
if ((e = xh_get(pic->global_tbl, name))) {
|
||||
pic_warn(pic, "redefining global");
|
||||
sym = pic_intern_cstr(pic, name);
|
||||
if (! (e = xh_get_int(pic->lib->senv->tbl, sym))) {
|
||||
return -1;
|
||||
}
|
||||
assert(e->val >= 0);
|
||||
if (! (e = xh_get_int(pic->global_tbl, e->val))) {
|
||||
return -1;
|
||||
}
|
||||
return e->val;
|
||||
}
|
||||
e = xh_put(pic->global_tbl, name, pic->glen++);
|
||||
|
||||
static int
|
||||
global_def(pic_state *pic, const char *name)
|
||||
{
|
||||
pic_sym sym, gsym;
|
||||
size_t gidx;
|
||||
|
||||
sym = pic_intern_cstr(pic, name);
|
||||
if ((gidx = global_ref(pic, name)) != -1) {
|
||||
pic_warn(pic, "redefining global");
|
||||
return gidx;
|
||||
}
|
||||
|
||||
gsym = pic_gensym(pic, sym);
|
||||
|
||||
/* register to the senv */
|
||||
xh_put_int(pic->lib->senv->tbl, sym, gsym);
|
||||
|
||||
/* register to the global table */
|
||||
gidx = pic->glen++;
|
||||
if (pic->glen >= pic->gcapa) {
|
||||
pic_error(pic, "global table overflow");
|
||||
}
|
||||
return e->val;
|
||||
xh_put_int(pic->global_tbl, gsym, gidx);
|
||||
|
||||
return gidx;
|
||||
}
|
||||
|
||||
void
|
||||
pic_define(pic_state *pic, const char *name, pic_value val)
|
||||
{
|
||||
int idx;
|
||||
pic_sym gsym;
|
||||
|
||||
gsym = pic_gensym(pic, pic_intern_cstr(pic, name));
|
||||
|
||||
/* push to the global arena */
|
||||
idx = scope_global_define(pic, pic_symbol_name(pic, gsym));
|
||||
pic->globals[idx] = val;
|
||||
|
||||
/* register to the senv */
|
||||
xh_put(pic->lib->senv->tbl, name, gsym);
|
||||
pic->globals[global_def(pic, name)] = val;
|
||||
|
||||
/* export! */
|
||||
pic_export(pic, pic_intern_cstr(pic, name));
|
||||
}
|
||||
|
||||
static int
|
||||
global_ref(pic_state *pic, const char *name)
|
||||
{
|
||||
struct xh_entry *e;
|
||||
|
||||
if (! (e = xh_get(pic->lib->senv->tbl, name))) {
|
||||
pic_error(pic, "symbol not defined");
|
||||
}
|
||||
assert(e->val >= 0);
|
||||
if (! (e = xh_get(pic->global_tbl, pic_symbol_name(pic, (pic_sym)e->val)))) {
|
||||
pic_abort(pic, "logic flaw");
|
||||
}
|
||||
return e->val;
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_ref(pic_state *pic, const char *name)
|
||||
{
|
||||
int gid;
|
||||
|
||||
gid = global_ref(pic, name);
|
||||
if (gid == -1) {
|
||||
pic_error(pic, "symbol not defined");
|
||||
}
|
||||
return pic->globals[gid];
|
||||
}
|
||||
|
||||
|
@ -1503,6 +1512,9 @@ pic_set(pic_state *pic, const char *name, pic_value value)
|
|||
int gid;
|
||||
|
||||
gid = global_ref(pic, name);
|
||||
if (gid == -1) {
|
||||
pic_error(pic, "symbol not defined");
|
||||
}
|
||||
pic->globals[gid] = value;
|
||||
}
|
||||
|
||||
|
|
1
src/gc.c
1
src/gc.c
|
@ -15,7 +15,6 @@
|
|||
#include "picrin/macro.h"
|
||||
#include "picrin/lib.h"
|
||||
#include "picrin/var.h"
|
||||
#include "xhash/xhash.h"
|
||||
|
||||
#if GC_DEBUG
|
||||
# include <string.h>
|
||||
|
|
|
@ -9,7 +9,6 @@
|
|||
#include "picrin/pair.h"
|
||||
#include "picrin/lib.h"
|
||||
#include "picrin/macro.h"
|
||||
#include "xhash/xhash.h"
|
||||
|
||||
void pic_init_bool(pic_state *);
|
||||
void pic_init_pair(pic_state *);
|
||||
|
|
|
@ -6,7 +6,6 @@
|
|||
#include "picrin/lib.h"
|
||||
#include "picrin/pair.h"
|
||||
#include "picrin/macro.h"
|
||||
#include "xhash/xhash.h"
|
||||
|
||||
struct pic_lib *
|
||||
pic_make_library(pic_state *pic, pic_value name)
|
||||
|
@ -29,7 +28,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->senv = senv;
|
||||
lib->exports = xh_new();
|
||||
lib->exports = xh_new_int();
|
||||
lib->name = name;
|
||||
|
||||
/* register! */
|
||||
|
|
74
src/macro.c
74
src/macro.c
|
@ -11,7 +11,6 @@
|
|||
#include "picrin/proc.h"
|
||||
#include "picrin/macro.h"
|
||||
#include "picrin/lib.h"
|
||||
#include "xhash/xhash.h"
|
||||
|
||||
static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *);
|
||||
static pic_value macroexpand_list(pic_state *, pic_value, struct pic_senv *);
|
||||
|
@ -23,7 +22,7 @@ pic_null_syntactic_env(pic_state *pic)
|
|||
|
||||
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
|
||||
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->xlen = 0;
|
||||
senv->xcapa = PIC_MACROS_SIZE;
|
||||
|
@ -32,8 +31,9 @@ pic_null_syntactic_env(pic_state *pic)
|
|||
}
|
||||
|
||||
#define register_core_syntax(pic,senv,kind,name) do { \
|
||||
senv->stx[senv->xlen] = pic_syntax_new(pic, kind, pic_intern_cstr(pic, name)); \
|
||||
xh_put(senv->tbl, name, ~senv->xlen); \
|
||||
pic_sym sym = pic_intern_cstr(pic, name); \
|
||||
senv->stx[senv->xlen] = pic_syntax_new(pic, kind, sym); \
|
||||
xh_put_int(senv->tbl, sym, ~senv->xlen); \
|
||||
senv->xlen++; \
|
||||
} while (0)
|
||||
|
||||
|
@ -83,7 +83,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->up = up;
|
||||
senv->tbl = xh_new();
|
||||
senv->tbl = xh_new_int();
|
||||
senv->stx = NULL;
|
||||
senv->xlen = 0;
|
||||
senv->xcapa = 0;
|
||||
|
@ -98,14 +98,14 @@ new_local_senv(pic_state *pic, pic_value formals, struct pic_senv *up)
|
|||
pic_error(pic, "syntax error");
|
||||
}
|
||||
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)) {
|
||||
a = macroexpand(pic, a, up);
|
||||
}
|
||||
if (pic_sym_p(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)) {
|
||||
pic_error(pic, "syntax error");
|
||||
|
@ -180,7 +180,7 @@ void
|
|||
pic_import(pic_state *pic, pic_value spec)
|
||||
{
|
||||
struct pic_lib *lib;
|
||||
struct xh_iter it;
|
||||
xh_iter it;
|
||||
|
||||
lib = pic_find_library(pic, spec);
|
||||
if (! lib) {
|
||||
|
@ -189,14 +189,14 @@ pic_import(pic_state *pic, pic_value spec)
|
|||
for (xh_begin(lib->exports, &it); ! xh_isend(&it); xh_next(&it)) {
|
||||
#if DEBUG
|
||||
if (it.e->val >= 0) {
|
||||
printf("* importing %s as %s\n", it.e->key, pic_symbol_name(pic, (pic_sym)it.e->val));
|
||||
printf("* importing %s as %s\n", pic_symbol_name(pic, (long)it.e->key), pic_symbol_name(pic, it.e->val));
|
||||
}
|
||||
else {
|
||||
printf("* importing %s\n", it.e->key);
|
||||
printf("* importing %s\n", pic_symbol_name(pic, (long)it.e->key));
|
||||
}
|
||||
#endif
|
||||
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 */
|
||||
size_t idx;
|
||||
|
@ -208,7 +208,7 @@ pic_import(pic_state *pic, pic_value spec)
|
|||
}
|
||||
/* bring macro object from imported lib */
|
||||
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++;
|
||||
}
|
||||
}
|
||||
|
@ -217,30 +217,32 @@ pic_import(pic_state *pic, pic_value spec)
|
|||
void
|
||||
pic_export(pic_state *pic, pic_sym sym)
|
||||
{
|
||||
struct xh_entry *e;
|
||||
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) {
|
||||
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
|
||||
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_senv *global_senv = pic->lib->senv;
|
||||
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;
|
||||
if (idx >= global_senv->xcapa) {
|
||||
pic_abort(pic, "macro table overflow");
|
||||
}
|
||||
global_senv->stx[idx] = stx;
|
||||
xh_put(global_senv->tbl, name, ~idx);
|
||||
xh_put_int(global_senv->tbl, sym, ~idx);
|
||||
global_senv->xlen++;
|
||||
}
|
||||
|
||||
|
@ -269,16 +271,16 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
|||
return macroexpand(pic, sc->expr, sc->senv);
|
||||
}
|
||||
case PIC_TT_SYMBOL: {
|
||||
struct xh_entry *e;
|
||||
xh_entry *e;
|
||||
pic_sym uniq;
|
||||
|
||||
if (! pic_interned_p(pic, pic_sym(expr))) {
|
||||
return expr;
|
||||
}
|
||||
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)
|
||||
return pic_symbol_value((pic_sym)e->val);
|
||||
return pic_symbol_value(e->val);
|
||||
else
|
||||
return pic_obj_value(senv->stx[~e->val]);
|
||||
}
|
||||
|
@ -287,7 +289,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
|||
senv = senv->up;
|
||||
}
|
||||
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);
|
||||
}
|
||||
case PIC_TT_PAIR: {
|
||||
|
@ -453,29 +455,28 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
|||
return v;
|
||||
}
|
||||
case PIC_STX_DEFINE: {
|
||||
pic_sym uniq;
|
||||
pic_value var;
|
||||
pic_sym var;
|
||||
pic_value formals;
|
||||
|
||||
if (pic_length(pic, expr) < 2) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
|
||||
var = pic_cadr(pic, expr);
|
||||
if (pic_pair_p(var)) {
|
||||
struct pic_senv *in = new_local_senv(pic, pic_cdr(pic, var), senv);
|
||||
formals = pic_cadr(pic, expr);
|
||||
if (pic_pair_p(formals)) {
|
||||
struct pic_senv *in = new_local_senv(pic, pic_cdr(pic, formals), senv);
|
||||
pic_value a;
|
||||
pic_sym sym;
|
||||
|
||||
/* defined symbol */
|
||||
a = pic_car(pic, var);
|
||||
a = pic_car(pic, formals);
|
||||
if (! pic_sym_p(a)) {
|
||||
a = macroexpand(pic, a, senv);
|
||||
}
|
||||
if (! pic_sym_p(a)) {
|
||||
pic_error(pic, "binding to non-symbol object");
|
||||
}
|
||||
sym = pic_sym(a);
|
||||
xh_put(senv->tbl, pic_symbol_name(pic, sym), (int)pic_gensym(pic, sym));
|
||||
var = pic_sym(a);
|
||||
xh_put_int(senv->tbl, var, pic_gensym(pic, var));
|
||||
|
||||
/* binding value */
|
||||
v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),
|
||||
|
@ -488,14 +489,17 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
|||
return v;
|
||||
}
|
||||
|
||||
if (! pic_sym_p(var)) {
|
||||
var = macroexpand(pic, var, senv);
|
||||
if (! pic_sym_p(formals)) {
|
||||
formals = macroexpand(pic, formals, senv);
|
||||
}
|
||||
if (! pic_sym_p(var)) {
|
||||
if (! pic_sym_p(formals)) {
|
||||
pic_error(pic, "binding to non-symbol object");
|
||||
}
|
||||
uniq = pic_gensym(pic, pic_sym(var));
|
||||
xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(var)), (int)uniq);
|
||||
var = pic_sym(formals);
|
||||
/* do not make duplicate variable slot */
|
||||
if (xh_get_int(senv->tbl, var) == NULL) {
|
||||
xh_put_int(senv->tbl, var, pic_gensym(pic, var));
|
||||
}
|
||||
}
|
||||
FALLTHROUGH;
|
||||
case PIC_STX_SET:
|
||||
|
|
|
@ -9,7 +9,6 @@
|
|||
#include "picrin/proc.h"
|
||||
#include "picrin/macro.h"
|
||||
#include "picrin/cont.h"
|
||||
#include "xhash/xhash.h"
|
||||
|
||||
void pic_init_core(pic_state *);
|
||||
|
||||
|
@ -53,14 +52,14 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
init_heap(pic->heap);
|
||||
|
||||
/* 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->slen = 0;
|
||||
pic->scapa = pic->slen + PIC_SYM_POOL_SIZE;
|
||||
pic->uniq_sym_count = 0;
|
||||
|
||||
/* 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->glen = 0;
|
||||
pic->gcapa = PIC_GLOBALS_SIZE;
|
||||
|
|
|
@ -8,12 +8,11 @@
|
|||
#include <assert.h>
|
||||
|
||||
#include "picrin.h"
|
||||
#include "xhash/xhash.h"
|
||||
|
||||
pic_sym
|
||||
pic_intern_cstr(pic_state *pic, const char *str)
|
||||
{
|
||||
struct xh_entry *e;
|
||||
xh_entry *e;
|
||||
pic_sym id;
|
||||
|
||||
e = xh_get(pic->sym_tbl, str);
|
||||
|
@ -21,6 +20,8 @@ pic_intern_cstr(pic_state *pic, const char *str)
|
|||
return e->val;
|
||||
}
|
||||
|
||||
str = pic_strdup(pic, str);
|
||||
|
||||
if (pic->slen >= pic->scapa) {
|
||||
|
||||
#if DEBUG
|
||||
|
@ -31,7 +32,7 @@ pic_intern_cstr(pic_state *pic, const char *str)
|
|||
pic->sym_pool = pic_realloc(pic, pic->sym_pool, sizeof(const char *) * pic->scapa);
|
||||
}
|
||||
id = pic->slen++;
|
||||
pic->sym_pool[id] = pic_strdup(pic, str);
|
||||
pic->sym_pool[id] = str;
|
||||
xh_put(pic->sym_tbl, str, id);
|
||||
return id;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue