pic_sym * -> pic_value
This commit is contained in:
parent
1a316a7a69
commit
f4efaf5dc0
|
@ -95,7 +95,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
|
|||
switch (pic_type(pic, x)) {
|
||||
case PIC_TYPE_ID: {
|
||||
pic_id *id1, *id2;
|
||||
pic_sym *s1, *s2;
|
||||
pic_value s1, s2;
|
||||
|
||||
id1 = pic_id_ptr(x);
|
||||
id2 = pic_id_ptr(y);
|
||||
|
@ -103,7 +103,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
|
|||
s1 = pic_find_identifier(pic, id1->u.id, id1->env);
|
||||
s2 = pic_find_identifier(pic, id2->u.id, id2->env);
|
||||
|
||||
return s1 == s2;
|
||||
return pic_eq_p(pic, s1, s2);
|
||||
}
|
||||
case PIC_TYPE_STRING: {
|
||||
return pic_str_cmp(pic, x, y) == 0;
|
||||
|
|
|
@ -46,7 +46,7 @@ pic_print_backtrace(pic_state *pic, xFILE *file)
|
|||
pic_value elem, it;
|
||||
|
||||
e = pic_error_ptr(pic->err);
|
||||
if (e->type != pic_intern_lit(pic, "")) {
|
||||
if (! pic_eq_p(pic, pic_obj_value(e->type), pic_intern_lit(pic, ""))) {
|
||||
pic_fwrite(pic, pic_obj_value(e->type), file);
|
||||
xfprintf(pic, file, " ");
|
||||
}
|
||||
|
|
|
@ -18,26 +18,26 @@ pic_make_dict(pic_state *pic)
|
|||
}
|
||||
|
||||
pic_value
|
||||
pic_dict_ref(pic_state *pic, pic_value dict, pic_sym *key)
|
||||
pic_dict_ref(pic_state *pic, pic_value dict, pic_value key)
|
||||
{
|
||||
khash_t(dict) *h = &pic_dict_ptr(pic, dict)->hash;
|
||||
khiter_t it;
|
||||
|
||||
it = kh_get(dict, h, key);
|
||||
it = kh_get(dict, h, pic_sym_ptr(pic, key));
|
||||
if (it == kh_end(h)) {
|
||||
pic_errorf(pic, "element not found for a key: ~s", pic_obj_value(key));
|
||||
pic_errorf(pic, "element not found for a key: ~s", key);
|
||||
}
|
||||
return kh_val(h, it);
|
||||
}
|
||||
|
||||
void
|
||||
pic_dict_set(pic_state *pic, pic_value dict, pic_sym *key, pic_value val)
|
||||
pic_dict_set(pic_state *pic, pic_value dict, pic_value key, pic_value val)
|
||||
{
|
||||
khash_t(dict) *h = &pic_dict_ptr(pic, dict)->hash;
|
||||
int ret;
|
||||
khiter_t it;
|
||||
|
||||
it = kh_put(dict, h, key, &ret);
|
||||
it = kh_put(dict, h, pic_sym_ptr(pic, key), &ret);
|
||||
kh_val(h, it) = val;
|
||||
}
|
||||
|
||||
|
@ -48,35 +48,35 @@ pic_dict_size(pic_state PIC_UNUSED(*pic), pic_value dict)
|
|||
}
|
||||
|
||||
bool
|
||||
pic_dict_has(pic_state *pic, pic_value dict, pic_sym *key)
|
||||
pic_dict_has(pic_state *pic, pic_value dict, pic_value key)
|
||||
{
|
||||
khash_t(dict) *h = &pic_dict_ptr(pic, dict)->hash;
|
||||
|
||||
return kh_get(dict, h, key) != kh_end(h);
|
||||
return kh_get(dict, h, pic_sym_ptr(pic, key)) != kh_end(h);
|
||||
}
|
||||
|
||||
void
|
||||
pic_dict_del(pic_state *pic, pic_value dict, pic_sym *key)
|
||||
pic_dict_del(pic_state *pic, pic_value dict, pic_value key)
|
||||
{
|
||||
khash_t(dict) *h = &pic_dict_ptr(pic, dict)->hash;
|
||||
khiter_t it;
|
||||
|
||||
it = kh_get(dict, h, key);
|
||||
it = kh_get(dict, h, pic_sym_ptr(pic, key));
|
||||
if (it == kh_end(h)) {
|
||||
pic_errorf(pic, "no slot named ~s found in dictionary", pic_obj_value(key));
|
||||
pic_errorf(pic, "no slot named ~s found in dictionary", key);
|
||||
}
|
||||
kh_del(dict, h, it);
|
||||
}
|
||||
|
||||
bool
|
||||
pic_dict_next(pic_state PIC_UNUSED(*pic), pic_value dict, int *iter, pic_sym **key, pic_value *val)
|
||||
pic_dict_next(pic_state PIC_UNUSED(*pic), pic_value dict, int *iter, pic_value *key, pic_value *val)
|
||||
{
|
||||
khash_t(dict) *h = &pic_dict_ptr(pic, dict)->hash;
|
||||
int it = *iter;
|
||||
|
||||
for (it = *iter; it != kh_end(h); ++it) {
|
||||
if (kh_exist(h, it)) {
|
||||
if (key) *key = kh_key(h, it);
|
||||
if (key) *key = pic_obj_value(kh_key(h, it));
|
||||
if (val) *val = kh_val(h, it);
|
||||
*iter = ++it;
|
||||
return true;
|
||||
|
@ -105,7 +105,7 @@ pic_dict_dictionary(pic_state *pic)
|
|||
|
||||
for (i = 0; i < argc; i += 2) {
|
||||
pic_assert_type(pic, argv[i], sym);
|
||||
pic_dict_set(pic, dict, pic_sym_ptr(argv[i]), argv[i+1]);
|
||||
pic_dict_set(pic, dict, argv[i], argv[i+1]);
|
||||
}
|
||||
|
||||
return dict;
|
||||
|
@ -124,23 +124,20 @@ pic_dict_dictionary_p(pic_state *pic)
|
|||
static pic_value
|
||||
pic_dict_dictionary_ref(pic_state *pic)
|
||||
{
|
||||
pic_value dict;
|
||||
pic_sym *key;
|
||||
pic_value dict, key;
|
||||
|
||||
pic_get_args(pic, "dm", &dict, &key);
|
||||
|
||||
if (! pic_dict_has(pic, dict, key)) {
|
||||
return pic_false_value(pic);
|
||||
}
|
||||
return pic_cons(pic, pic_obj_value(key), pic_dict_ref(pic, dict, key));
|
||||
return pic_cons(pic, key, pic_dict_ref(pic, dict, key));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_dict_dictionary_set(pic_state *pic)
|
||||
{
|
||||
pic_value dict;
|
||||
pic_sym *key;
|
||||
pic_value val;
|
||||
pic_value dict, key, val;
|
||||
|
||||
pic_get_args(pic, "dmo", &dict, &key, &val);
|
||||
|
||||
|
@ -168,14 +165,13 @@ pic_dict_dictionary_size(pic_state *pic)
|
|||
static pic_value
|
||||
pic_dict_dictionary_map(pic_state *pic)
|
||||
{
|
||||
pic_value dict, proc, ret = pic_nil_value(pic);
|
||||
pic_sym *key;
|
||||
pic_value dict, proc, key, ret = pic_nil_value(pic);
|
||||
int it = 0;
|
||||
|
||||
pic_get_args(pic, "ld", &proc, &dict);
|
||||
|
||||
while (pic_dict_next(pic, dict, &it, &key, NULL)) {
|
||||
pic_push(pic, pic_call(pic, proc, 1, pic_obj_value(key)), ret);
|
||||
pic_push(pic, pic_call(pic, proc, 1, key), ret);
|
||||
}
|
||||
return pic_reverse(pic, ret);
|
||||
}
|
||||
|
@ -183,14 +179,13 @@ pic_dict_dictionary_map(pic_state *pic)
|
|||
static pic_value
|
||||
pic_dict_dictionary_for_each(pic_state *pic)
|
||||
{
|
||||
pic_value dict, proc;
|
||||
pic_sym *key;
|
||||
pic_value dict, proc, key;
|
||||
int it;
|
||||
|
||||
pic_get_args(pic, "ld", &proc, &dict);
|
||||
|
||||
while (pic_dict_next(pic, dict, &it, &key, NULL)) {
|
||||
pic_call(pic, proc, 1, pic_obj_value(key));
|
||||
pic_call(pic, proc, 1, key);
|
||||
}
|
||||
|
||||
return pic_undef_value(pic);
|
||||
|
@ -199,14 +194,13 @@ pic_dict_dictionary_for_each(pic_state *pic)
|
|||
static pic_value
|
||||
pic_dict_dictionary_to_alist(pic_state *pic)
|
||||
{
|
||||
pic_value dict, val, alist = pic_nil_value(pic);
|
||||
pic_sym *sym;
|
||||
pic_value dict, key, val, alist = pic_nil_value(pic);
|
||||
int it = 0;
|
||||
|
||||
pic_get_args(pic, "d", &dict);
|
||||
|
||||
while (pic_dict_next(pic, dict, &it, &sym, &val)) {
|
||||
pic_push(pic, pic_cons(pic, pic_obj_value(sym), val), alist);
|
||||
while (pic_dict_next(pic, dict, &it, &key, &val)) {
|
||||
pic_push(pic, pic_cons(pic, key, val), alist);
|
||||
}
|
||||
|
||||
return alist;
|
||||
|
@ -223,7 +217,7 @@ pic_dict_alist_to_dictionary(pic_state *pic)
|
|||
|
||||
pic_for_each (e, pic_reverse(pic, alist), it) {
|
||||
pic_assert_type(pic, pic_car(pic, e), sym);
|
||||
pic_dict_set(pic, dict, pic_sym_ptr(pic_car(pic, e)), pic_cdr(pic, e));
|
||||
pic_dict_set(pic, dict, pic_car(pic, e), pic_cdr(pic, e));
|
||||
}
|
||||
|
||||
return dict;
|
||||
|
@ -232,15 +226,14 @@ pic_dict_alist_to_dictionary(pic_state *pic)
|
|||
static pic_value
|
||||
pic_dict_dictionary_to_plist(pic_state *pic)
|
||||
{
|
||||
pic_value dict, val, plist = pic_nil_value(pic);
|
||||
pic_sym *sym;
|
||||
pic_value dict, key, val, plist = pic_nil_value(pic);
|
||||
int it = 0;
|
||||
|
||||
pic_get_args(pic, "d", &dict);
|
||||
|
||||
while (pic_dict_next(pic, dict, &it, &sym, &val)) {
|
||||
while (pic_dict_next(pic, dict, &it, &key, &val)) {
|
||||
pic_push(pic, val, plist);
|
||||
pic_push(pic, pic_obj_value(sym), plist);
|
||||
pic_push(pic, key, plist);
|
||||
}
|
||||
|
||||
return plist;
|
||||
|
@ -257,7 +250,7 @@ pic_dict_plist_to_dictionary(pic_state *pic)
|
|||
|
||||
for (e = pic_reverse(pic, plist); ! pic_nil_p(pic, e); e = pic_cddr(pic, e)) {
|
||||
pic_assert_type(pic, pic_cadr(pic, e), sym);
|
||||
pic_dict_set(pic, dict, pic_sym_ptr(pic_cadr(pic, e)), pic_car(pic, e));
|
||||
pic_dict_set(pic, dict, pic_cadr(pic, e), pic_car(pic, e));
|
||||
}
|
||||
|
||||
return dict;
|
||||
|
|
|
@ -92,13 +92,12 @@ struct pic_error *
|
|||
pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs)
|
||||
{
|
||||
struct pic_error *e;
|
||||
pic_value stack;
|
||||
pic_sym *ty = pic_intern_cstr(pic, type);
|
||||
pic_value stack, ty = pic_intern_cstr(pic, type);
|
||||
|
||||
stack = pic_get_backtrace(pic);
|
||||
|
||||
e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TYPE_ERROR);
|
||||
e->type = ty;
|
||||
e->type = pic_sym_ptr(pic, ty);
|
||||
e->msg = pic_str_ptr(pic, pic_cstr_value(pic, msg));
|
||||
e->irrs = irrs;
|
||||
e->stack = pic_str_ptr(pic, stack);
|
||||
|
|
|
@ -19,12 +19,12 @@ optimize_beta(pic_state *pic, pic_value expr)
|
|||
return expr;
|
||||
|
||||
if (pic_sym_p(pic, pic_list_ref(pic, expr, 0))) {
|
||||
pic_sym *sym = pic_sym_ptr(pic_list_ref(pic, expr, 0));
|
||||
pic_value sym = pic_list_ref(pic, expr, 0);
|
||||
|
||||
if (sym == pic->sQUOTE) {
|
||||
if (pic_eq_p(pic, sym, pic->sQUOTE)) {
|
||||
return expr;
|
||||
} else if (sym == pic->sLAMBDA) {
|
||||
return pic_list(pic, 3, pic_list_ref(pic, expr, 0), pic_list_ref(pic, expr, 1), optimize_beta(pic, pic_list_ref(pic, expr, 2)));
|
||||
} else if (pic_eq_p(pic, sym, pic->sLAMBDA)) {
|
||||
return pic_list(pic, 3, pic->sLAMBDA, pic_list_ref(pic, expr, 1), optimize_beta(pic, pic_list_ref(pic, expr, 2)));
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -38,7 +38,7 @@ optimize_beta(pic_state *pic, pic_value expr)
|
|||
pic_protect(pic, expr);
|
||||
|
||||
functor = pic_list_ref(pic, expr, 0);
|
||||
if (pic_pair_p(pic, functor) && pic_eq_p(pic, pic_car(pic, functor), pic_obj_value(pic->sLAMBDA))) {
|
||||
if (pic_pair_p(pic, functor) && pic_eq_p(pic, pic_car(pic, functor), pic->sLAMBDA)) {
|
||||
formals = pic_list_ref(pic, functor, 1);
|
||||
if (! pic_list_p(pic, formals))
|
||||
goto exit; /* TODO: support ((lambda args x) 1 2) */
|
||||
|
@ -47,12 +47,12 @@ optimize_beta(pic_state *pic, pic_value expr)
|
|||
goto exit;
|
||||
defs = pic_nil_value(pic);
|
||||
pic_for_each (val, args, it) {
|
||||
pic_push(pic, pic_list(pic, 3, pic_obj_value(pic->sDEFINE), pic_car(pic, formals), val), defs);
|
||||
pic_push(pic, pic_list(pic, 3, pic->sDEFINE, pic_car(pic, formals), val), defs);
|
||||
formals = pic_cdr(pic, formals);
|
||||
}
|
||||
expr = pic_list_ref(pic, functor, 2);
|
||||
pic_for_each (val, defs, it) {
|
||||
expr = pic_list(pic, 3, pic_obj_value(pic->sBEGIN), val, expr);
|
||||
expr = pic_list(pic, 3, pic->sBEGIN, val, expr);
|
||||
}
|
||||
}
|
||||
exit:
|
||||
|
@ -68,17 +68,14 @@ pic_optimize(pic_state *pic, pic_value expr)
|
|||
return optimize_beta(pic, expr);
|
||||
}
|
||||
|
||||
KHASH_DECLARE(a, pic_sym *, int)
|
||||
KHASH_DEFINE2(a, pic_sym *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal)
|
||||
|
||||
/**
|
||||
* TODO: don't use khash_t, use kvec_t instead
|
||||
*/
|
||||
|
||||
typedef struct analyze_scope {
|
||||
int depth;
|
||||
pic_sym *rest; /* Nullable */
|
||||
khash_t(a) args, locals, captures; /* rest args variable is counted as a local */
|
||||
pic_value rest; /* Nullable */
|
||||
pic_value args, locals, captures; /* rest args variable is counted as a local */
|
||||
pic_value defer;
|
||||
struct analyze_scope *up;
|
||||
} analyze_scope;
|
||||
|
@ -86,22 +83,20 @@ typedef struct analyze_scope {
|
|||
static void
|
||||
analyzer_scope_init(pic_state *pic, analyze_scope *scope, pic_value formal, analyze_scope *up)
|
||||
{
|
||||
int ret;
|
||||
|
||||
kh_init(a, &scope->args);
|
||||
kh_init(a, &scope->locals);
|
||||
kh_init(a, &scope->captures);
|
||||
scope->args = pic_make_dict(pic);
|
||||
scope->locals = pic_make_dict(pic);
|
||||
scope->captures = pic_make_dict(pic);
|
||||
|
||||
/* analyze formal */
|
||||
for (; pic_pair_p(pic, formal); formal = pic_cdr(pic, formal)) {
|
||||
kh_put(a, &scope->args, pic_sym_ptr(pic_car(pic, formal)), &ret);
|
||||
pic_dict_set(pic, scope->args, pic_car(pic, formal), pic_true_value(pic));
|
||||
}
|
||||
if (pic_nil_p(pic, formal)) {
|
||||
scope->rest = NULL;
|
||||
scope->rest = pic_false_value(pic);
|
||||
}
|
||||
else {
|
||||
scope->rest = pic_sym_ptr(formal);
|
||||
kh_put(a, &scope->locals, pic_sym_ptr(formal), &ret);
|
||||
scope->rest = formal;
|
||||
pic_dict_set(pic, scope->locals, formal, pic_true_value(pic));
|
||||
}
|
||||
|
||||
scope->up = up;
|
||||
|
@ -110,28 +105,26 @@ analyzer_scope_init(pic_state *pic, analyze_scope *scope, pic_value formal, anal
|
|||
}
|
||||
|
||||
static void
|
||||
analyzer_scope_destroy(pic_state *pic, analyze_scope *scope)
|
||||
analyzer_scope_destroy(pic_state PIC_UNUSED(*pic), analyze_scope PIC_UNUSED(*scope))
|
||||
{
|
||||
kh_destroy(a, &scope->args);
|
||||
kh_destroy(a, &scope->locals);
|
||||
kh_destroy(a, &scope->captures);
|
||||
/* nothing here */
|
||||
}
|
||||
|
||||
static bool
|
||||
search_scope(pic_state *pic, analyze_scope *scope, pic_sym *sym)
|
||||
search_scope(pic_state *pic, analyze_scope *scope, pic_value sym)
|
||||
{
|
||||
return kh_get(a, &scope->args, sym) != kh_end(&scope->args) || kh_get(a, &scope->locals, sym) != kh_end(&scope->locals) || scope->depth == 0;
|
||||
return pic_dict_has(pic, scope->args, sym) || pic_dict_has(pic, scope->locals, sym) || scope->depth == 0;
|
||||
}
|
||||
|
||||
static int
|
||||
find_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
|
||||
find_var(pic_state *pic, analyze_scope *scope, pic_value sym)
|
||||
{
|
||||
int depth = 0, ret;
|
||||
int depth = 0;
|
||||
|
||||
while (scope) {
|
||||
if (search_scope(pic, scope, sym)) {
|
||||
if (depth > 0) {
|
||||
kh_put(a, &scope->captures, sym, &ret); /* capture! */
|
||||
pic_dict_set(pic, scope->captures, sym, pic_true_value(pic)); /* capture! */
|
||||
}
|
||||
return depth;
|
||||
}
|
||||
|
@ -142,20 +135,18 @@ find_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
|
|||
}
|
||||
|
||||
static void
|
||||
define_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
|
||||
define_var(pic_state *pic, analyze_scope *scope, pic_value sym)
|
||||
{
|
||||
int ret;
|
||||
|
||||
if (search_scope(pic, scope, sym)) {
|
||||
if (scope->depth > 0 || pic_weak_has(pic, pic->globals, pic_obj_value(sym))) {
|
||||
pic_warnf(pic, "redefining variable: ~s", pic_obj_value(sym));
|
||||
if (scope->depth > 0 || pic_weak_has(pic, pic->globals, sym)) {
|
||||
pic_warnf(pic, "redefining variable: ~s", sym);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
pic_weak_set(pic, pic->globals, pic_obj_value(sym), pic_invalid_value());
|
||||
pic_weak_set(pic, pic->globals, sym, pic_invalid_value());
|
||||
|
||||
kh_put(a, &scope->locals, sym, &ret);
|
||||
pic_dict_set(pic, scope->locals, sym, pic_true_value(pic));
|
||||
}
|
||||
|
||||
static pic_value analyze(pic_state *, analyze_scope *, pic_value);
|
||||
|
@ -167,18 +158,18 @@ static pic_value analyze_lambda(pic_state *, analyze_scope *, pic_value);
|
|||
#define CALL pic_intern_lit(pic, "call")
|
||||
|
||||
static pic_value
|
||||
analyze_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
|
||||
analyze_var(pic_state *pic, analyze_scope *scope, pic_value sym)
|
||||
{
|
||||
int depth;
|
||||
|
||||
depth = find_var(pic, scope, sym);
|
||||
|
||||
if (depth == scope->depth) {
|
||||
return pic_list(pic, 2, pic_obj_value(GREF), pic_obj_value(sym));
|
||||
return pic_list(pic, 2, GREF, sym);
|
||||
} else if (depth == 0) {
|
||||
return pic_list(pic, 2, pic_obj_value(LREF), pic_obj_value(sym));
|
||||
return pic_list(pic, 2, LREF, sym);
|
||||
} else {
|
||||
return pic_list(pic, 3, pic_obj_value(CREF), pic_int_value(pic, depth), pic_obj_value(sym));
|
||||
return pic_list(pic, 3, CREF, pic_int_value(pic, depth), sym);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -216,10 +207,9 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
|
|||
{
|
||||
analyze_scope s, *scope = &s;
|
||||
pic_value formals, body;
|
||||
pic_value rest = pic_undef_value(pic);
|
||||
pic_value args, locals, captures;
|
||||
int i, j;
|
||||
khiter_t it;
|
||||
pic_value rest;
|
||||
pic_value args, locals, captures, key;
|
||||
int i, j, it;
|
||||
|
||||
formals = pic_list_ref(pic, form, 1);
|
||||
body = pic_list_ref(pic, form, 2);
|
||||
|
@ -230,38 +220,35 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
|
|||
body = analyze(pic, scope, body);
|
||||
analyze_deferred(pic, scope);
|
||||
|
||||
args = pic_make_vec(pic, kh_size(&scope->args), NULL);
|
||||
args = pic_make_vec(pic, pic_dict_size(pic, scope->args), NULL);
|
||||
for (i = 0; pic_pair_p(pic, formals); formals = pic_cdr(pic, formals), i++) {
|
||||
pic_vec_set(pic, args, i, pic_car(pic, formals));
|
||||
}
|
||||
|
||||
if (scope->rest != NULL) {
|
||||
rest = pic_obj_value(scope->rest);
|
||||
}
|
||||
rest = scope->rest;
|
||||
|
||||
locals = pic_make_vec(pic, kh_size(&scope->locals), NULL);
|
||||
locals = pic_make_vec(pic, pic_dict_size(pic, scope->locals), NULL);
|
||||
j = 0;
|
||||
if (scope->rest != NULL) {
|
||||
pic_vec_set(pic, locals, j++, pic_obj_value(scope->rest));
|
||||
if (pic_sym_p(pic, scope->rest)) {
|
||||
pic_vec_set(pic, locals, j++, scope->rest);
|
||||
}
|
||||
for (it = kh_begin(&scope->locals); it < kh_end(&scope->locals); ++it) {
|
||||
if (kh_exist(&scope->locals, it)) {
|
||||
if (scope->rest != NULL && kh_key(&scope->locals, it) == scope->rest)
|
||||
continue;
|
||||
pic_vec_set(pic, locals, j++, pic_obj_value(kh_key(&scope->locals, it)));
|
||||
}
|
||||
it = 0;
|
||||
while (pic_dict_next(pic, scope->locals, &it, &key, NULL)) {
|
||||
if (pic_eq_p(pic, key, rest))
|
||||
continue;
|
||||
pic_vec_set(pic, locals, j++, key);
|
||||
}
|
||||
|
||||
captures = pic_make_vec(pic, kh_size(&scope->captures), NULL);
|
||||
for (it = kh_begin(&scope->captures), j = 0; it < kh_end(&scope->captures); ++it) {
|
||||
if (kh_exist(&scope->captures, it)) {
|
||||
pic_vec_set(pic, captures, j++, pic_obj_value(kh_key(&scope->captures, it)));
|
||||
}
|
||||
captures = pic_make_vec(pic, pic_dict_size(pic, scope->captures), NULL);
|
||||
it = 0;
|
||||
j = 0;
|
||||
while (pic_dict_next(pic, scope->captures, &it, &key, NULL)) {
|
||||
pic_vec_set(pic, captures, j++, key);
|
||||
}
|
||||
|
||||
analyzer_scope_destroy(pic, scope);
|
||||
|
||||
return pic_list(pic, 6, pic_obj_value(pic->sLAMBDA), rest, args, locals, captures, body);
|
||||
return pic_list(pic, 6, pic->sLAMBDA, rest, args, locals, captures, body);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -279,7 +266,7 @@ analyze_list(pic_state *pic, analyze_scope *scope, pic_value obj)
|
|||
static pic_value
|
||||
analyze_define(pic_state *pic, analyze_scope *scope, pic_value obj)
|
||||
{
|
||||
define_var(pic, scope, pic_sym_ptr(pic_list_ref(pic, obj, 1)));
|
||||
define_var(pic, scope, pic_list_ref(pic, obj, 1));
|
||||
|
||||
return pic_cons(pic, pic_car(pic, obj), analyze_list(pic, scope, pic_cdr(pic, obj)));
|
||||
}
|
||||
|
@ -287,7 +274,7 @@ analyze_define(pic_state *pic, analyze_scope *scope, pic_value obj)
|
|||
static pic_value
|
||||
analyze_call(pic_state *pic, analyze_scope *scope, pic_value obj)
|
||||
{
|
||||
return pic_cons(pic, pic_obj_value(CALL), analyze_list(pic, scope, obj));
|
||||
return pic_cons(pic, CALL, analyze_list(pic, scope, obj));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -295,7 +282,7 @@ analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
|
|||
{
|
||||
switch (pic_type(pic, obj)) {
|
||||
case PIC_TYPE_SYMBOL: {
|
||||
return analyze_var(pic, scope, pic_sym_ptr(obj));
|
||||
return analyze_var(pic, scope, obj);
|
||||
}
|
||||
case PIC_TYPE_PAIR: {
|
||||
pic_value proc;
|
||||
|
@ -306,18 +293,18 @@ analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
|
|||
|
||||
proc = pic_list_ref(pic, obj, 0);
|
||||
if (pic_sym_p(pic, proc)) {
|
||||
pic_sym *sym = pic_sym_ptr(proc);
|
||||
pic_value sym = proc;
|
||||
|
||||
if (sym == pic->sDEFINE) {
|
||||
if (pic_eq_p(pic, sym, pic->sDEFINE)) {
|
||||
return analyze_define(pic, scope, obj);
|
||||
}
|
||||
else if (sym == pic->sLAMBDA) {
|
||||
else if (pic_eq_p(pic, sym, pic->sLAMBDA)) {
|
||||
return analyze_defer(pic, scope, obj);
|
||||
}
|
||||
else if (sym == pic->sQUOTE) {
|
||||
else if (pic_eq_p(pic, sym, pic->sQUOTE)) {
|
||||
return obj;
|
||||
}
|
||||
else if (sym == pic->sBEGIN || sym == pic->sSETBANG || sym == pic->sIF) {
|
||||
else if (pic_eq_p(pic, sym, pic->sBEGIN) || pic_eq_p(pic, sym, pic->sSETBANG) || pic_eq_p(pic, sym, pic->sIF)) {
|
||||
return pic_cons(pic, pic_car(pic, obj), analyze_list(pic, scope, pic_cdr(pic, obj)));
|
||||
}
|
||||
}
|
||||
|
@ -325,7 +312,7 @@ analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
|
|||
return analyze_call(pic, scope, obj);
|
||||
}
|
||||
default:
|
||||
return pic_list(pic, 2, pic_obj_value(pic->sQUOTE), obj);
|
||||
return pic_list(pic, 2, pic->sQUOTE, obj);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -359,7 +346,7 @@ pic_analyze(pic_state *pic, pic_value obj)
|
|||
|
||||
typedef struct codegen_context {
|
||||
/* rest args variable is counted as a local */
|
||||
pic_sym *rest;
|
||||
pic_value rest;
|
||||
pic_value args, locals, captures;
|
||||
/* actual bit code sequence */
|
||||
pic_code *code;
|
||||
|
@ -381,7 +368,7 @@ typedef struct codegen_context {
|
|||
static void create_activation(pic_state *, codegen_context *);
|
||||
|
||||
static void
|
||||
codegen_context_init(pic_state *pic, codegen_context *cxt, codegen_context *up, pic_sym *rest, pic_value args, pic_value locals, pic_value captures)
|
||||
codegen_context_init(pic_state *pic, codegen_context *cxt, codegen_context *up, pic_value rest, pic_value args, pic_value locals, pic_value captures)
|
||||
{
|
||||
cxt->up = up;
|
||||
cxt->rest = rest;
|
||||
|
@ -421,7 +408,7 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
|
|||
/* create irep */
|
||||
irep = pic_malloc(pic, sizeof(struct pic_irep));
|
||||
irep->refc = 1;
|
||||
irep->varg = cxt->rest != NULL;
|
||||
irep->varg = pic_sym_p(pic, cxt->rest);
|
||||
irep->argc = pic_vec_len(pic, cxt->args) + 1;
|
||||
irep->localc = pic_vec_len(pic, cxt->locals);
|
||||
irep->capturec = pic_vec_len(pic, cxt->captures);
|
||||
|
@ -481,7 +468,7 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
|
|||
#define emit_ret(pic, cxt, tailpos) if (tailpos) emit_n(pic, cxt, OP_RET)
|
||||
|
||||
static int
|
||||
index_capture(pic_state *pic, codegen_context *cxt, pic_sym *sym, int depth)
|
||||
index_capture(pic_state *pic, codegen_context *cxt, pic_value sym, int depth)
|
||||
{
|
||||
int i;
|
||||
|
||||
|
@ -490,38 +477,38 @@ index_capture(pic_state *pic, codegen_context *cxt, pic_sym *sym, int depth)
|
|||
}
|
||||
|
||||
for (i = 0; i < pic_vec_len(pic, cxt->captures); ++i) {
|
||||
if (pic_sym_ptr(pic_vec_ref(pic, cxt->captures, i)) == sym)
|
||||
if (pic_eq_p(pic, sym, pic_vec_ref(pic, cxt->captures, i)))
|
||||
return i;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
static int
|
||||
index_local(pic_state *pic, codegen_context *cxt, pic_sym *sym)
|
||||
index_local(pic_state *pic, codegen_context *cxt, pic_value sym)
|
||||
{
|
||||
int i, offset;
|
||||
|
||||
offset = 1;
|
||||
for (i = 0; i < pic_vec_len(pic, cxt->args); ++i) {
|
||||
if (pic_sym_ptr(pic_vec_ref(pic, cxt->args, i)) == sym)
|
||||
if (pic_eq_p(pic, sym, pic_vec_ref(pic, cxt->args, i)))
|
||||
return i + offset;
|
||||
}
|
||||
offset += i;
|
||||
for (i = 0; i < pic_vec_len(pic, cxt->locals); ++i) {
|
||||
if (pic_sym_ptr(pic_vec_ref(pic, cxt->locals, i)) == sym)
|
||||
if (pic_eq_p(pic, sym, pic_vec_ref(pic, cxt->locals, i)))
|
||||
return i + offset;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
static int
|
||||
index_global(pic_state *pic, codegen_context *cxt, pic_sym *name)
|
||||
index_global(pic_state *pic, codegen_context *cxt, pic_value name)
|
||||
{
|
||||
int pidx;
|
||||
|
||||
check_pool_size(pic, cxt);
|
||||
pidx = (int)cxt->plen++;
|
||||
cxt->pool[pidx] = (struct pic_object *)name;
|
||||
cxt->pool[pidx] = (struct pic_object *)pic_sym_ptr(pic, name);
|
||||
|
||||
return pidx;
|
||||
}
|
||||
|
@ -532,10 +519,10 @@ create_activation(pic_state *pic, codegen_context *cxt)
|
|||
int i, n;
|
||||
|
||||
for (i = 0; i < pic_vec_len(pic, cxt->captures); ++i) {
|
||||
pic_sym *sym = pic_sym_ptr(pic_vec_ref(pic, cxt->captures, i));
|
||||
pic_value sym = pic_vec_ref(pic, cxt->captures, i);
|
||||
n = index_local(pic, cxt, sym);
|
||||
assert(n != -1);
|
||||
if (n <= pic_vec_len(pic, cxt->args) || cxt->rest == sym) {
|
||||
if (n <= pic_vec_len(pic, cxt->args) || pic_eq_p(pic, sym, cxt->rest)) {
|
||||
/* copy arguments to capture variable area */
|
||||
emit_i(pic, cxt, OP_LREF, n);
|
||||
} else {
|
||||
|
@ -550,30 +537,30 @@ static void codegen(pic_state *, codegen_context *, pic_value, bool);
|
|||
static void
|
||||
codegen_ref(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
|
||||
{
|
||||
pic_sym *sym;
|
||||
pic_value sym;
|
||||
|
||||
sym = pic_sym_ptr(pic_car(pic, obj));
|
||||
if (sym == GREF) {
|
||||
pic_sym *name;
|
||||
sym = pic_car(pic, obj);
|
||||
if (pic_eq_p(pic, sym, GREF)) {
|
||||
pic_value name;
|
||||
|
||||
name = pic_sym_ptr(pic_list_ref(pic, obj, 1));
|
||||
name = pic_list_ref(pic, obj, 1);
|
||||
emit_i(pic, cxt, OP_GREF, index_global(pic, cxt, name));
|
||||
emit_ret(pic, cxt, tailpos);
|
||||
}
|
||||
else if (sym == CREF) {
|
||||
pic_sym *name;
|
||||
else if (pic_eq_p(pic, sym, CREF)) {
|
||||
pic_value name;
|
||||
int depth;
|
||||
|
||||
depth = pic_int(pic, pic_list_ref(pic, obj, 1));
|
||||
name = pic_sym_ptr(pic_list_ref(pic, obj, 2));
|
||||
name = pic_list_ref(pic, obj, 2);
|
||||
emit_r(pic, cxt, OP_CREF, depth, index_capture(pic, cxt, name, depth));
|
||||
emit_ret(pic, cxt, tailpos);
|
||||
}
|
||||
else if (sym == LREF) {
|
||||
pic_sym *name;
|
||||
else if (pic_eq_p(pic, sym, LREF)) {
|
||||
pic_value name;
|
||||
int i;
|
||||
|
||||
name = pic_sym_ptr(pic_list_ref(pic, obj, 1));
|
||||
name = pic_list_ref(pic, obj, 1);
|
||||
if ((i = index_capture(pic, cxt, name, 0)) != -1) {
|
||||
emit_i(pic, cxt, OP_LREF, i + pic_vec_len(pic, cxt->args) + pic_vec_len(pic, cxt->locals) + 1);
|
||||
emit_ret(pic, cxt, tailpos);
|
||||
|
@ -588,34 +575,34 @@ static void
|
|||
codegen_set(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
|
||||
{
|
||||
pic_value var, val;
|
||||
pic_sym *type;
|
||||
pic_value type;
|
||||
|
||||
val = pic_list_ref(pic, obj, 2);
|
||||
codegen(pic, cxt, val, false);
|
||||
|
||||
var = pic_list_ref(pic, obj, 1);
|
||||
type = pic_sym_ptr(pic_list_ref(pic, var, 0));
|
||||
if (type == GREF) {
|
||||
pic_sym *name;
|
||||
type = pic_list_ref(pic, var, 0);
|
||||
if (pic_eq_p(pic, type, GREF)) {
|
||||
pic_value name;
|
||||
|
||||
name = pic_sym_ptr(pic_list_ref(pic, var, 1));
|
||||
name = pic_list_ref(pic, var, 1);
|
||||
emit_i(pic, cxt, OP_GSET, index_global(pic, cxt, name));
|
||||
emit_ret(pic, cxt, tailpos);
|
||||
}
|
||||
else if (type == CREF) {
|
||||
pic_sym *name;
|
||||
else if (pic_eq_p(pic, type, CREF)) {
|
||||
pic_value name;
|
||||
int depth;
|
||||
|
||||
depth = pic_int(pic, pic_list_ref(pic, var, 1));
|
||||
name = pic_sym_ptr(pic_list_ref(pic, var, 2));
|
||||
name = pic_list_ref(pic, var, 2);
|
||||
emit_r(pic, cxt, OP_CSET, depth, index_capture(pic, cxt, name, depth));
|
||||
emit_ret(pic, cxt, tailpos);
|
||||
}
|
||||
else if (type == LREF) {
|
||||
pic_sym *name;
|
||||
else if (pic_eq_p(pic, type, LREF)) {
|
||||
pic_value name;
|
||||
int i;
|
||||
|
||||
name = pic_sym_ptr(pic_list_ref(pic, var, 1));
|
||||
name = pic_list_ref(pic, var, 1);
|
||||
if ((i = index_capture(pic, cxt, name, 0)) != -1) {
|
||||
emit_i(pic, cxt, OP_LSET, i + pic_vec_len(pic, cxt->args) + pic_vec_len(pic, cxt->locals) + 1);
|
||||
emit_ret(pic, cxt, tailpos);
|
||||
|
@ -630,17 +617,13 @@ static void
|
|||
codegen_lambda(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
|
||||
{
|
||||
codegen_context c, *inner_cxt = &c;
|
||||
pic_value rest_opt, body;
|
||||
pic_sym *rest = NULL;
|
||||
pic_value rest, body;
|
||||
pic_value args, locals, captures;
|
||||
|
||||
check_irep_size(pic, cxt);
|
||||
|
||||
/* extract arguments */
|
||||
rest_opt = pic_list_ref(pic, obj, 1);
|
||||
if (pic_sym_p(pic, rest_opt)) {
|
||||
rest = pic_sym_ptr(rest_opt);
|
||||
}
|
||||
rest = pic_list_ref(pic, obj, 1);
|
||||
args = pic_list_ref(pic, obj, 2);
|
||||
locals = pic_list_ref(pic, obj, 3);
|
||||
captures = pic_list_ref(pic, obj, 4);
|
||||
|
@ -741,11 +724,11 @@ codegen_quote(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
|
|||
}
|
||||
|
||||
#define VM(uid, op) \
|
||||
if (sym == uid) { \
|
||||
emit_i(pic, cxt, op, len - 1); \
|
||||
emit_ret(pic, cxt, tailpos); \
|
||||
return; \
|
||||
}
|
||||
if (pic_eq_p(pic, sym, uid)) { \
|
||||
emit_i(pic, cxt, op, len - 1); \
|
||||
emit_ret(pic, cxt, tailpos); \
|
||||
return; \
|
||||
}
|
||||
|
||||
static void
|
||||
codegen_call(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
|
||||
|
@ -758,10 +741,10 @@ codegen_call(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
|
|||
}
|
||||
|
||||
functor = pic_list_ref(pic, obj, 1);
|
||||
if (pic_sym_ptr(pic_list_ref(pic, functor, 0)) == GREF) {
|
||||
pic_sym *sym;
|
||||
if (pic_eq_p(pic, pic_list_ref(pic, functor, 0), GREF)) {
|
||||
pic_value sym;
|
||||
|
||||
sym = pic_sym_ptr(pic_list_ref(pic, functor, 1));
|
||||
sym = pic_list_ref(pic, functor, 1);
|
||||
|
||||
VM(pic->sCONS, OP_CONS)
|
||||
VM(pic->sCAR, OP_CAR)
|
||||
|
@ -787,28 +770,28 @@ codegen_call(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
|
|||
static void
|
||||
codegen(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
|
||||
{
|
||||
pic_sym *sym;
|
||||
pic_value sym;
|
||||
|
||||
sym = pic_sym_ptr(pic_car(pic, obj));
|
||||
if (sym == GREF || sym == CREF || sym == LREF) {
|
||||
sym = pic_car(pic, obj);
|
||||
if (pic_eq_p(pic, sym, GREF) || pic_eq_p(pic, sym, CREF) || pic_eq_p(pic, sym, LREF)) {
|
||||
codegen_ref(pic, cxt, obj, tailpos);
|
||||
}
|
||||
else if (sym == pic->sSETBANG || sym == pic->sDEFINE) {
|
||||
else if (pic_eq_p(pic, sym, pic->sSETBANG) || pic_eq_p(pic, sym, pic->sDEFINE)) {
|
||||
codegen_set(pic, cxt, obj, tailpos);
|
||||
}
|
||||
else if (sym == pic->sLAMBDA) {
|
||||
else if (pic_eq_p(pic, sym, pic->sLAMBDA)) {
|
||||
codegen_lambda(pic, cxt, obj, tailpos);
|
||||
}
|
||||
else if (sym == pic->sIF) {
|
||||
else if (pic_eq_p(pic, sym, pic->sIF)) {
|
||||
codegen_if(pic, cxt, obj, tailpos);
|
||||
}
|
||||
else if (sym == pic->sBEGIN) {
|
||||
else if (pic_eq_p(pic, sym, pic->sBEGIN)) {
|
||||
codegen_begin(pic, cxt, obj, tailpos);
|
||||
}
|
||||
else if (sym == pic->sQUOTE) {
|
||||
else if (pic_eq_p(pic, sym, pic->sQUOTE)) {
|
||||
codegen_quote(pic, cxt, obj, tailpos);
|
||||
}
|
||||
else if (sym == CALL) {
|
||||
else if (pic_eq_p(pic, sym, CALL)) {
|
||||
codegen_call(pic, cxt, obj, tailpos);
|
||||
}
|
||||
else {
|
||||
|
@ -822,7 +805,7 @@ pic_codegen(pic_state *pic, pic_value obj)
|
|||
pic_value empty = pic_make_vec(pic, 0, NULL);
|
||||
codegen_context c, *cxt = &c;
|
||||
|
||||
codegen_context_init(pic, cxt, NULL, NULL, empty, empty, empty);
|
||||
codegen_context_init(pic, cxt, NULL, pic_false_value(pic), empty, empty, empty);
|
||||
|
||||
codegen(pic, cxt, obj, true);
|
||||
|
||||
|
|
|
@ -358,12 +358,11 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
|
|||
break;
|
||||
}
|
||||
case PIC_TYPE_DICT: {
|
||||
pic_sym *sym;
|
||||
pic_value val;
|
||||
pic_value key, val;
|
||||
int it = 0;
|
||||
|
||||
while (pic_dict_next(pic, pic_obj_value(&obj->u.dict), &it, &sym, &val)) {
|
||||
gc_mark_object(pic, (struct pic_object *)sym);
|
||||
while (pic_dict_next(pic, pic_obj_value(&obj->u.dict), &it, &key, &val)) {
|
||||
gc_mark(pic, key);
|
||||
gc_mark(pic, val);
|
||||
}
|
||||
break;
|
||||
|
@ -411,7 +410,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
|
|||
}
|
||||
}
|
||||
|
||||
#define M(x) gc_mark_object(pic, (struct pic_object *)pic->x)
|
||||
#define M(x) gc_mark(pic, pic->x)
|
||||
|
||||
static void
|
||||
gc_mark_phase(pic_state *pic)
|
||||
|
|
|
@ -52,7 +52,6 @@ typedef struct {
|
|||
#endif
|
||||
|
||||
struct pic_object;
|
||||
struct pic_symbol;
|
||||
struct pic_port;
|
||||
struct pic_error;
|
||||
struct pic_env;
|
||||
|
@ -102,7 +101,7 @@ void pic_in_library(pic_state *, const char *lib);
|
|||
bool pic_find_library(pic_state *, const char *lib);
|
||||
const char *pic_current_library(pic_state *);
|
||||
void pic_import(pic_state *, const char *lib);
|
||||
void pic_export(pic_state *, pic_sym *sym);
|
||||
void pic_export(pic_state *, pic_value sym);
|
||||
|
||||
PIC_NORETURN void pic_panic(pic_state *, const char *msg);
|
||||
PIC_NORETURN void pic_errorf(pic_state *, const char *fmt, ...);
|
||||
|
@ -234,12 +233,12 @@ int pic_vec_len(pic_state *, pic_value vec);
|
|||
|
||||
/* dictionary */
|
||||
pic_value pic_make_dict(pic_state *);
|
||||
pic_value pic_dict_ref(pic_state *, pic_value dict, pic_sym *);
|
||||
void pic_dict_set(pic_state *, pic_value dict, pic_sym *, pic_value);
|
||||
void pic_dict_del(pic_state *, pic_value dict, pic_sym *);
|
||||
bool pic_dict_has(pic_state *, pic_value dict, pic_sym *);
|
||||
pic_value pic_dict_ref(pic_state *, pic_value dict, pic_value key);
|
||||
void pic_dict_set(pic_state *, pic_value dict, pic_value key, pic_value);
|
||||
void pic_dict_del(pic_state *, pic_value dict, pic_value key);
|
||||
bool pic_dict_has(pic_state *, pic_value dict, pic_value key);
|
||||
int pic_dict_size(pic_state *, pic_value dict);
|
||||
bool pic_dict_next(pic_state *, pic_value dict, int *iter, pic_sym **key, pic_value *val);
|
||||
bool pic_dict_next(pic_state *, pic_value dict, int *iter, pic_value *key, pic_value *val);
|
||||
|
||||
/* ephemeron */
|
||||
pic_value pic_make_weak(pic_state *);
|
||||
|
@ -249,11 +248,11 @@ void pic_weak_del(pic_state *, pic_value weak, pic_value key);
|
|||
bool pic_weak_has(pic_state *, pic_value weak, pic_value key);
|
||||
|
||||
/* symbol */
|
||||
pic_sym *pic_intern(pic_state *, pic_value str);
|
||||
pic_value pic_intern(pic_state *, pic_value str);
|
||||
#define pic_intern_str(pic,s,i) pic_intern(pic, pic_str_value(pic, (s), (i)))
|
||||
#define pic_intern_cstr(pic,s) pic_intern(pic, pic_cstr_value(pic, (s)))
|
||||
#define pic_intern_lit(pic,lit) pic_intern(pic, pic_lit_value(pic, lit))
|
||||
pic_value pic_sym_name(pic_state *, pic_sym *);
|
||||
pic_value pic_sym_name(pic_state *, pic_value sym);
|
||||
|
||||
/* string */
|
||||
int pic_str_len(pic_state *, pic_value str);
|
||||
|
|
|
@ -115,6 +115,7 @@ struct pic_port {
|
|||
xFILE *file;
|
||||
};
|
||||
|
||||
#define pic_sym_ptr(pic, o) ((pic_sym *)pic_obj_ptr(o))
|
||||
#define pic_str_ptr(pic, o) ((struct pic_string *)pic_obj_ptr(o))
|
||||
#define pic_blob_ptr(pic, o) ((struct pic_blob *)pic_obj_ptr(o))
|
||||
#define pic_pair_ptr(pic, o) ((struct pic_pair *)pic_obj_ptr(o))
|
||||
|
@ -123,7 +124,6 @@ struct pic_port {
|
|||
#define pic_weak_ptr(pic, o) ((struct pic_weak *)pic_obj_ptr(o))
|
||||
#define pic_data_ptr(pic, o) ((struct pic_data *)pic_obj_ptr(o))
|
||||
#define pic_proc_ptr(pic, o) ((struct pic_proc *)pic_obj_ptr(o))
|
||||
#define pic_sym_ptr(v) ((pic_sym *)pic_obj_ptr(v))
|
||||
#define pic_id_ptr(v) ((pic_id *)pic_obj_ptr(v))
|
||||
#define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o))
|
||||
#define pic_rec_ptr(v) ((struct pic_record *)pic_obj_ptr(v))
|
||||
|
@ -158,9 +158,9 @@ struct pic_record *pic_make_rec(pic_state *, pic_value, pic_value);
|
|||
struct pic_error *pic_make_error(pic_state *, const char *, const char *, pic_value);
|
||||
struct pic_env *pic_make_env(pic_state *, struct pic_env *);
|
||||
|
||||
pic_sym *pic_add_identifier(pic_state *, pic_id *, struct pic_env *);
|
||||
pic_sym *pic_put_identifier(pic_state *, pic_id *, pic_sym *, struct pic_env *);
|
||||
pic_sym *pic_find_identifier(pic_state *, pic_id *, struct pic_env *);
|
||||
pic_value pic_add_identifier(pic_state *, pic_id *, struct pic_env *);
|
||||
pic_value pic_put_identifier(pic_state *, pic_id *, pic_value uid, struct pic_env *);
|
||||
pic_value pic_find_identifier(pic_state *, pic_id *, struct pic_env *);
|
||||
pic_value pic_id_name(pic_state *, pic_id *);
|
||||
|
||||
void pic_rope_incref(pic_state *, struct pic_rope *);
|
||||
|
|
|
@ -67,13 +67,13 @@ struct pic_state {
|
|||
|
||||
struct pic_lib *lib;
|
||||
|
||||
pic_sym *sDEFINE, *sDEFINE_MACRO, *sLAMBDA, *sIF, *sBEGIN, *sSETBANG;
|
||||
pic_sym *sQUOTE, *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING;
|
||||
pic_sym *sSYNTAX_QUOTE, *sSYNTAX_QUASIQUOTE;
|
||||
pic_sym *sSYNTAX_UNQUOTE, *sSYNTAX_UNQUOTE_SPLICING;
|
||||
pic_sym *sDEFINE_LIBRARY, *sIMPORT, *sEXPORT, *sCOND_EXPAND;
|
||||
pic_sym *sCONS, *sCAR, *sCDR, *sNILP, *sSYMBOLP, *sPAIRP;
|
||||
pic_sym *sADD, *sSUB, *sMUL, *sDIV, *sEQ, *sLT, *sLE, *sGT, *sGE, *sNOT;
|
||||
pic_value sDEFINE, sDEFINE_MACRO, sLAMBDA, sIF, sBEGIN, sSETBANG;
|
||||
pic_value sQUOTE, sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
|
||||
pic_value sSYNTAX_QUOTE, sSYNTAX_QUASIQUOTE;
|
||||
pic_value sSYNTAX_UNQUOTE, sSYNTAX_UNQUOTE_SPLICING;
|
||||
pic_value sDEFINE_LIBRARY, sIMPORT, sEXPORT, sCOND_EXPAND;
|
||||
pic_value sCONS, sCAR, sCDR, sNILP, sSYMBOLP, sPAIRP;
|
||||
pic_value sADD, sSUB, sMUL, sDIV, sEQ, sLT, sLE, sGT, sGE, sNOT;
|
||||
|
||||
pic_value features;
|
||||
|
||||
|
|
|
@ -42,10 +42,10 @@ make_library_env(pic_state *pic, pic_value name)
|
|||
kh_init(env, &env->map);
|
||||
|
||||
/* set up default environment */
|
||||
pic_put_identifier(pic, (pic_id *)pic->sDEFINE_LIBRARY, pic->sDEFINE_LIBRARY, env);
|
||||
pic_put_identifier(pic, (pic_id *)pic->sIMPORT, pic->sIMPORT, env);
|
||||
pic_put_identifier(pic, (pic_id *)pic->sEXPORT, pic->sEXPORT, env);
|
||||
pic_put_identifier(pic, (pic_id *)pic->sCOND_EXPAND, pic->sCOND_EXPAND, env);
|
||||
pic_put_identifier(pic, pic_id_ptr(pic->sDEFINE_LIBRARY), pic->sDEFINE_LIBRARY, env);
|
||||
pic_put_identifier(pic, pic_id_ptr(pic->sIMPORT), pic->sIMPORT, env);
|
||||
pic_put_identifier(pic, pic_id_ptr(pic->sEXPORT), pic->sEXPORT, env);
|
||||
pic_put_identifier(pic, pic_id_ptr(pic->sCOND_EXPAND), pic->sCOND_EXPAND, env);
|
||||
|
||||
return env;
|
||||
}
|
||||
|
@ -109,27 +109,25 @@ pic_library_environment(pic_state *pic, const char *lib)
|
|||
void
|
||||
pic_import(pic_state *pic, const char *lib)
|
||||
{
|
||||
pic_sym *name, *realname, *uid;
|
||||
pic_value name, realname, uid;
|
||||
int it = 0;
|
||||
pic_value val;
|
||||
struct pic_lib *libp;
|
||||
|
||||
libp = get_library(pic, lib);
|
||||
|
||||
while (pic_dict_next(pic, pic_obj_value(libp->exports), &it, &name, &val)) {
|
||||
realname = pic_sym_ptr(val);
|
||||
|
||||
if ((uid = pic_find_identifier(pic, (pic_id *)realname, libp->env)) == NULL) {
|
||||
pic_errorf(pic, "attempted to export undefined variable '~s'", pic_obj_value(realname));
|
||||
while (pic_dict_next(pic, pic_obj_value(libp->exports), &it, &name, &realname)) {
|
||||
uid = pic_find_identifier(pic, pic_id_ptr(realname), libp->env);
|
||||
if (! pic_weak_has(pic, pic->globals, uid) && ! pic_weak_has(pic, pic->macros, uid)) {
|
||||
pic_errorf(pic, "attempted to export undefined variable '~s'", realname);
|
||||
}
|
||||
pic_put_identifier(pic, (pic_id *)name, uid, pic->lib->env);
|
||||
pic_put_identifier(pic, pic_id_ptr(name), uid, pic->lib->env);
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
pic_export(pic_state *pic, pic_sym *name)
|
||||
pic_export(pic_state *pic, pic_value name)
|
||||
{
|
||||
pic_dict_set(pic, pic_obj_value(pic->lib->exports), name, pic_obj_value(name));
|
||||
pic_dict_set(pic, pic_obj_value(pic->lib->exports), name, name);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -176,44 +174,45 @@ static pic_value
|
|||
pic_lib_library_import(pic_state *pic)
|
||||
{
|
||||
const char *lib;
|
||||
pic_sym *name, *realname, *uid, *alias = NULL;
|
||||
pic_value name, alias = pic_false_value(pic), realname, uid;
|
||||
struct pic_lib *libp;
|
||||
|
||||
pic_get_args(pic, "zm|m", &lib, &name, &alias);
|
||||
|
||||
if (alias == NULL) {
|
||||
if (pic_false_p(pic, alias)) {
|
||||
alias = name;
|
||||
}
|
||||
|
||||
libp = get_library(pic, lib);
|
||||
|
||||
if (! pic_dict_has(pic, pic_obj_value(libp->exports), name)) {
|
||||
pic_errorf(pic, "attempted to import undefined variable '~s'", pic_obj_value(name));
|
||||
pic_errorf(pic, "library-import: variable is not exported '~s'", name);
|
||||
} else {
|
||||
realname = pic_sym_ptr(pic_dict_ref(pic, pic_obj_value(libp->exports), name));
|
||||
realname = pic_dict_ref(pic, pic_obj_value(libp->exports), name);
|
||||
}
|
||||
|
||||
if ((uid = pic_find_identifier(pic, (pic_id *)realname, libp->env)) == NULL) {
|
||||
pic_errorf(pic, "attempted to export undefined variable '~s'", pic_obj_value(realname));
|
||||
} else {
|
||||
pic_put_identifier(pic, (pic_id *)alias, uid, pic->lib->env);
|
||||
uid = pic_find_identifier(pic, pic_id_ptr(realname), libp->env);
|
||||
if (! pic_weak_has(pic, pic->globals, uid) && ! pic_weak_has(pic, pic->macros, uid)) {
|
||||
pic_errorf(pic, "attempted to export undefined variable '~s'", realname);
|
||||
}
|
||||
|
||||
pic_put_identifier(pic, pic_id_ptr(alias), uid, pic->lib->env);
|
||||
|
||||
return pic_undef_value(pic);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_lib_library_export(pic_state *pic)
|
||||
{
|
||||
pic_sym *name, *alias = NULL;
|
||||
pic_value name, alias = pic_false_value(pic);
|
||||
|
||||
pic_get_args(pic, "m|m", &name, &alias);
|
||||
|
||||
if (alias == NULL) {
|
||||
if (pic_false_p(pic, alias)) {
|
||||
alias = name;
|
||||
}
|
||||
|
||||
pic_dict_set(pic, pic_obj_value(pic->lib->exports), alias, pic_obj_value(name));
|
||||
pic_dict_set(pic, pic_obj_value(pic->lib->exports), alias, name);
|
||||
|
||||
return pic_undef_value(pic);
|
||||
}
|
||||
|
@ -222,8 +221,7 @@ static pic_value
|
|||
pic_lib_library_exports(pic_state *pic)
|
||||
{
|
||||
const char *lib;
|
||||
pic_value exports = pic_nil_value(pic);
|
||||
pic_sym *sym;
|
||||
pic_value sym, exports = pic_nil_value(pic);
|
||||
int it = 0;
|
||||
struct pic_lib *libp;
|
||||
|
||||
|
@ -232,7 +230,7 @@ pic_lib_library_exports(pic_state *pic)
|
|||
libp = get_library(pic, lib);
|
||||
|
||||
while (pic_dict_next(pic, pic_obj_value(libp->exports), &it, &sym, NULL)) {
|
||||
pic_push(pic, pic_obj_value(sym), exports);
|
||||
pic_push(pic, sym, exports);
|
||||
}
|
||||
|
||||
return exports;
|
||||
|
|
|
@ -21,12 +21,11 @@ pic_make_env(pic_state *pic, struct pic_env *up)
|
|||
return env;
|
||||
}
|
||||
|
||||
pic_sym *
|
||||
pic_value
|
||||
pic_add_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
|
||||
{
|
||||
const char *name;
|
||||
pic_sym *uid;
|
||||
pic_value str;
|
||||
pic_value uid, str;
|
||||
|
||||
name = pic_str(pic, pic_id_name(pic, id));
|
||||
|
||||
|
@ -40,63 +39,58 @@ pic_add_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
|
|||
return pic_put_identifier(pic, id, uid, env);
|
||||
}
|
||||
|
||||
pic_sym *
|
||||
pic_put_identifier(pic_state *pic, pic_id *id, pic_sym *uid, struct pic_env *env)
|
||||
pic_value
|
||||
pic_put_identifier(pic_state *pic, pic_id *id, pic_value uid, struct pic_env *env)
|
||||
{
|
||||
khiter_t it;
|
||||
int ret;
|
||||
|
||||
it = kh_put(env, &env->map, id, &ret);
|
||||
kh_val(&env->map, it) = uid;
|
||||
kh_val(&env->map, it) = pic_sym_ptr(pic, uid);
|
||||
|
||||
return uid;
|
||||
}
|
||||
|
||||
pic_sym *
|
||||
search_scope(pic_state *pic, pic_id *id, struct pic_env *env)
|
||||
static bool
|
||||
search_scope(pic_state *pic, pic_id *id, struct pic_env *env, pic_value *uid)
|
||||
{
|
||||
khiter_t it;
|
||||
|
||||
it = kh_get(env, &env->map, id);
|
||||
if (it == kh_end(&env->map)) {
|
||||
return NULL;
|
||||
return false;
|
||||
}
|
||||
return kh_val(&env->map, it);
|
||||
*uid = pic_obj_value(kh_val(&env->map, it));
|
||||
return true;
|
||||
}
|
||||
|
||||
static pic_sym *
|
||||
search(pic_state *pic, pic_id *id, struct pic_env *env)
|
||||
static bool
|
||||
search(pic_state *pic, pic_id *id, struct pic_env *env, pic_value *uid)
|
||||
{
|
||||
pic_sym *uid = NULL;
|
||||
|
||||
while (env != NULL) {
|
||||
uid = search_scope(pic, id, env);
|
||||
if (uid != NULL) {
|
||||
break;
|
||||
if (search_scope(pic, id, env, uid)) {
|
||||
return true;
|
||||
}
|
||||
env = env->up;
|
||||
}
|
||||
return uid;
|
||||
return false;
|
||||
}
|
||||
|
||||
pic_sym *
|
||||
pic_value
|
||||
pic_find_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
|
||||
{
|
||||
pic_sym *uid;
|
||||
pic_value uid;
|
||||
|
||||
while ((uid = search(pic, id, env)) == NULL) {
|
||||
while (! search(pic, id, env, &uid)) {
|
||||
if (pic_sym_p(pic, pic_obj_value(id))) {
|
||||
break;
|
||||
while (env->up != NULL) {
|
||||
env = env->up;
|
||||
}
|
||||
return pic_add_identifier(pic, id, env);
|
||||
}
|
||||
env = id->env; /* do not overwrite id first */
|
||||
id = id->u.id;
|
||||
}
|
||||
if (uid == NULL) {
|
||||
while (env->up != NULL) {
|
||||
env = env->up;
|
||||
}
|
||||
uid = pic_add_identifier(pic, id, env);
|
||||
}
|
||||
return uid;
|
||||
}
|
||||
|
||||
|
@ -107,28 +101,29 @@ pic_find_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
|
|||
|
||||
|
||||
static void
|
||||
define_macro(pic_state *pic, pic_sym *uid, pic_value mac)
|
||||
define_macro(pic_state *pic, pic_value uid, pic_value mac)
|
||||
{
|
||||
if (pic_weak_has(pic, pic->macros, pic_obj_value(uid))) {
|
||||
pic_warnf(pic, "redefining syntax variable: ~s", pic_obj_value(uid));
|
||||
if (pic_weak_has(pic, pic->macros, uid)) {
|
||||
pic_warnf(pic, "redefining syntax variable: ~s", uid);
|
||||
}
|
||||
pic_weak_set(pic, pic->macros, pic_obj_value(uid), mac);
|
||||
pic_weak_set(pic, pic->macros, uid, mac);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
find_macro(pic_state *pic, pic_sym *uid)
|
||||
static bool
|
||||
find_macro(pic_state *pic, pic_value uid, pic_value *mac)
|
||||
{
|
||||
if (! pic_weak_has(pic, pic->macros, pic_obj_value(uid))) {
|
||||
return pic_false_value(pic);
|
||||
if (! pic_weak_has(pic, pic->macros, uid)) {
|
||||
return false;
|
||||
}
|
||||
return pic_weak_ref(pic, pic->macros, pic_obj_value(uid));
|
||||
*mac = pic_weak_ref(pic, pic->macros, uid);
|
||||
return true;
|
||||
}
|
||||
|
||||
static void
|
||||
shadow_macro(pic_state *pic, pic_sym *uid)
|
||||
shadow_macro(pic_state *pic, pic_value uid)
|
||||
{
|
||||
if (pic_weak_has(pic, pic->macros, pic_obj_value(uid))) {
|
||||
pic_weak_del(pic, pic->macros, pic_obj_value(uid));
|
||||
if (pic_weak_has(pic, pic->macros, uid)) {
|
||||
pic_weak_del(pic, pic->macros, uid);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -138,21 +133,20 @@ static pic_value expand_lambda(pic_state *, pic_value, struct pic_env *);
|
|||
static pic_value
|
||||
expand_var(pic_state *pic, pic_id *id, struct pic_env *env, pic_value deferred)
|
||||
{
|
||||
pic_value mac;
|
||||
pic_sym *functor;
|
||||
pic_value mac, functor;
|
||||
|
||||
functor = pic_find_identifier(pic, id, env);
|
||||
|
||||
if (! pic_false_p(pic, mac = find_macro(pic, functor))) {
|
||||
if (find_macro(pic, functor, &mac)) {
|
||||
return expand(pic, pic_call(pic, mac, 2, pic_obj_value(id), pic_obj_value(env)), env, deferred);
|
||||
}
|
||||
return pic_obj_value(functor);
|
||||
return functor;
|
||||
}
|
||||
|
||||
static pic_value
|
||||
expand_quote(pic_state *pic, pic_value expr)
|
||||
{
|
||||
return pic_cons(pic, pic_obj_value(pic->sQUOTE), pic_cdr(pic, expr));
|
||||
return pic_cons(pic, pic->sQUOTE, pic_cdr(pic, expr));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -226,25 +220,24 @@ expand_lambda(pic_state *pic, pic_value expr, struct pic_env *env)
|
|||
|
||||
expand_deferred(pic, deferred, in);
|
||||
|
||||
return pic_list(pic, 3, pic_obj_value(pic->sLAMBDA), formal, body);
|
||||
return pic_list(pic, 3, pic->sLAMBDA, formal, body);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
expand_define(pic_state *pic, pic_value expr, struct pic_env *env, pic_value deferred)
|
||||
{
|
||||
pic_sym *uid;
|
||||
pic_value uid, val;
|
||||
pic_id *id;
|
||||
pic_value val;
|
||||
|
||||
id = pic_id_ptr(pic_cadr(pic, expr));
|
||||
if ((uid = search_scope(pic, id, env)) == NULL) {
|
||||
if (! search_scope(pic, id, env, &uid)) {
|
||||
uid = pic_add_identifier(pic, id, env);
|
||||
} else {
|
||||
shadow_macro(pic, uid);
|
||||
}
|
||||
val = expand(pic, pic_list_ref(pic, expr, 2), env, deferred);
|
||||
|
||||
return pic_list(pic, 3, pic_obj_value(pic->sDEFINE), pic_obj_value(uid), val);
|
||||
return pic_list(pic, 3, pic->sDEFINE, uid, val);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -252,11 +245,10 @@ expand_defmacro(pic_state *pic, pic_value expr, struct pic_env *env)
|
|||
{
|
||||
pic_value pic_compile(pic_state *, pic_value);
|
||||
pic_id *id;
|
||||
pic_value val;
|
||||
pic_sym *uid;
|
||||
pic_value uid, val;
|
||||
|
||||
id = pic_id_ptr(pic_cadr(pic, expr));
|
||||
if ((uid = search_scope(pic, id, env)) == NULL) {
|
||||
if (! search_scope(pic, id, env, &uid)) {
|
||||
uid = pic_add_identifier(pic, id, env);
|
||||
}
|
||||
|
||||
|
@ -286,24 +278,24 @@ expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value defer
|
|||
}
|
||||
|
||||
if (pic_id_p(pic, pic_car(pic, expr))) {
|
||||
pic_sym *functor;
|
||||
pic_value functor;
|
||||
|
||||
functor = pic_find_identifier(pic, pic_id_ptr(pic_car(pic, expr)), env);
|
||||
|
||||
if (functor == pic->sDEFINE_MACRO) {
|
||||
if (pic_eq_p(pic, functor, pic->sDEFINE_MACRO)) {
|
||||
return expand_defmacro(pic, expr, env);
|
||||
}
|
||||
else if (functor == pic->sLAMBDA) {
|
||||
else if (pic_eq_p(pic, functor, pic->sLAMBDA)) {
|
||||
return expand_defer(pic, expr, deferred);
|
||||
}
|
||||
else if (functor == pic->sDEFINE) {
|
||||
else if (pic_eq_p(pic, functor, pic->sDEFINE)) {
|
||||
return expand_define(pic, expr, env, deferred);
|
||||
}
|
||||
else if (functor == pic->sQUOTE) {
|
||||
else if (pic_eq_p(pic, functor, pic->sQUOTE)) {
|
||||
return expand_quote(pic, expr);
|
||||
}
|
||||
|
||||
if (! pic_false_p(pic, mac = find_macro(pic, functor))) {
|
||||
if (find_macro(pic, functor, &mac)) {
|
||||
return expand(pic, pic_call(pic, mac, 2, expr, pic_obj_value(env)), env, deferred);
|
||||
}
|
||||
}
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
* F double *, bool * float with exactness
|
||||
* c char * char
|
||||
* z char ** c string
|
||||
* m pic_sym ** symbol
|
||||
* m pic_value * symbol
|
||||
* v pic_value * vector object
|
||||
* s pic_value * string object
|
||||
* b pic_value * bytevector object
|
||||
|
@ -147,13 +147,13 @@ pic_get_args(pic_state *pic, const char *format, ...)
|
|||
#define PTR_CASE(c, type, ctype) \
|
||||
VAL_CASE(c, type, ctype, pic_## type ##_ptr(v))
|
||||
|
||||
PTR_CASE('m', sym, pic_sym *)
|
||||
PTR_CASE('p', port, struct pic_port *)
|
||||
PTR_CASE('e', error, struct pic_error *)
|
||||
PTR_CASE('r', rec, struct pic_record *)
|
||||
|
||||
#define OBJ_CASE(c, type) VAL_CASE(c, type, pic_value, v)
|
||||
|
||||
OBJ_CASE('m', sym)
|
||||
OBJ_CASE('s', str)
|
||||
OBJ_CASE('l', proc)
|
||||
OBJ_CASE('b', blob)
|
||||
|
@ -180,18 +180,21 @@ pic_get_args(pic_state *pic, const char *format, ...)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
vm_gref(pic_state *pic, pic_sym *uid)
|
||||
vm_gref(pic_state *pic, pic_value uid)
|
||||
{
|
||||
if (! pic_weak_has(pic, pic->globals, pic_obj_value(uid))) {
|
||||
pic_errorf(pic, "uninitialized global variable: %s", pic_str(pic, pic_sym_name(pic, uid)));
|
||||
pic_value val;
|
||||
|
||||
val = pic_weak_ref(pic, pic->globals, uid);;
|
||||
if (pic_invalid_p(pic, val)) {
|
||||
pic_errorf(pic, "uninitialized global variable: ~s", uid);
|
||||
}
|
||||
return pic_weak_ref(pic, pic->globals, pic_obj_value(uid));
|
||||
return val;
|
||||
}
|
||||
|
||||
static void
|
||||
vm_gset(pic_state *pic, pic_sym *uid, pic_value value)
|
||||
vm_gset(pic_state *pic, pic_value uid, pic_value value)
|
||||
{
|
||||
pic_weak_set(pic, pic->globals, pic_obj_value(uid), value);
|
||||
pic_weak_set(pic, pic->globals, uid, value);
|
||||
}
|
||||
|
||||
static void
|
||||
|
@ -422,11 +425,11 @@ pic_apply(pic_state *pic, pic_value proc, int argc, pic_value *argv)
|
|||
NEXT;
|
||||
}
|
||||
CASE(OP_GREF) {
|
||||
PUSH(vm_gref(pic, (pic_sym *)pic->ci->irep->pool[c.a]));
|
||||
PUSH(vm_gref(pic, pic_obj_value(pic->ci->irep->pool[c.a])));
|
||||
NEXT;
|
||||
}
|
||||
CASE(OP_GSET) {
|
||||
vm_gset(pic, (pic_sym *)pic->ci->irep->pool[c.a], POP());
|
||||
vm_gset(pic, pic_obj_value(pic->ci->irep->pool[c.a]), POP());
|
||||
PUSH(pic_undef_value(pic));
|
||||
NEXT;
|
||||
}
|
||||
|
@ -887,33 +890,32 @@ pic_defvar(pic_state *pic, const char *name, pic_value init, pic_value conv)
|
|||
void
|
||||
pic_define(pic_state *pic, const char *lib, const char *name, pic_value val)
|
||||
{
|
||||
pic_sym *sym, *uid;
|
||||
pic_value sym, uid;
|
||||
struct pic_env *env;
|
||||
|
||||
sym = pic_intern_cstr(pic, name);
|
||||
|
||||
env = pic_library_environment(pic, lib);
|
||||
if ((uid = pic_find_identifier(pic, (pic_id *)sym, env)) == NULL) {
|
||||
uid = pic_add_identifier(pic, (pic_id *)sym, env);
|
||||
} else {
|
||||
if (pic_weak_has(pic, pic->globals, pic_obj_value(uid))) {
|
||||
pic_warnf(pic, "redefining variable: ~s", pic_obj_value(uid));
|
||||
}
|
||||
}
|
||||
|
||||
pic_set(pic, lib, name, val);
|
||||
uid = pic_find_identifier(pic, pic_id_ptr(sym), env);
|
||||
if (pic_weak_has(pic, pic->globals, uid)) {
|
||||
pic_warnf(pic, "redefining variable: ~s", uid);
|
||||
}
|
||||
pic_weak_set(pic, pic->globals, uid, val);
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_ref(pic_state *pic, const char *lib, const char *name)
|
||||
{
|
||||
pic_sym *sym, *uid;
|
||||
pic_value sym, uid;
|
||||
struct pic_env *env;
|
||||
|
||||
sym = pic_intern_cstr(pic, name);
|
||||
|
||||
env = pic_library_environment(pic, lib);
|
||||
if ((uid = pic_find_identifier(pic, (pic_id *)sym, env)) == NULL) {
|
||||
|
||||
uid = pic_find_identifier(pic, pic_id_ptr(sym), env);
|
||||
if (! pic_weak_has(pic, pic->globals, uid)) {
|
||||
pic_errorf(pic, "symbol \"%s\" not defined in library %s", name, lib);
|
||||
}
|
||||
|
||||
|
@ -923,13 +925,15 @@ pic_ref(pic_state *pic, const char *lib, const char *name)
|
|||
void
|
||||
pic_set(pic_state *pic, const char *lib, const char *name, pic_value val)
|
||||
{
|
||||
pic_sym *sym, *uid;
|
||||
pic_value sym, uid;
|
||||
struct pic_env *env;
|
||||
|
||||
sym = pic_intern_cstr(pic, name);
|
||||
|
||||
env = pic_library_environment(pic, lib);
|
||||
if ((uid = pic_find_identifier(pic, (pic_id *)sym, env)) == NULL) {
|
||||
|
||||
uid = pic_find_identifier(pic, pic_id_ptr(sym), env);
|
||||
if (! pic_weak_has(pic, pic->globals, uid)) {
|
||||
pic_errorf(pic, "symbol \"%s\" not defined in library %s", name, lib);
|
||||
}
|
||||
|
||||
|
|
|
@ -149,49 +149,49 @@ read_directive(pic_state *pic, xFILE *file, int c)
|
|||
static pic_value
|
||||
read_quote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
|
||||
{
|
||||
return pic_list(pic, 2, pic_obj_value(pic->sQUOTE), read(pic, file, next(pic, file)));
|
||||
return pic_list(pic, 2, pic->sQUOTE, read(pic, file, next(pic, file)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_quasiquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
|
||||
{
|
||||
return pic_list(pic, 2, pic_obj_value(pic->sQUASIQUOTE), read(pic, file, next(pic, file)));
|
||||
return pic_list(pic, 2, pic->sQUASIQUOTE, read(pic, file, next(pic, file)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_unquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
|
||||
{
|
||||
pic_sym *tag = pic->sUNQUOTE;
|
||||
pic_value tag = pic->sUNQUOTE;
|
||||
|
||||
if (peek(pic, file) == '@') {
|
||||
tag = pic->sUNQUOTE_SPLICING;
|
||||
next(pic, file);
|
||||
}
|
||||
return pic_list(pic, 2, pic_obj_value(tag), read(pic, file, next(pic, file)));
|
||||
return pic_list(pic, 2, tag, read(pic, file, next(pic, file)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_syntax_quote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
|
||||
{
|
||||
return pic_list(pic, 2, pic_obj_value(pic->sSYNTAX_QUOTE), read(pic, file, next(pic, file)));
|
||||
return pic_list(pic, 2, pic->sSYNTAX_QUOTE, read(pic, file, next(pic, file)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_syntax_quasiquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
|
||||
{
|
||||
return pic_list(pic, 2, pic_obj_value(pic->sSYNTAX_QUASIQUOTE), read(pic, file, next(pic, file)));
|
||||
return pic_list(pic, 2, pic->sSYNTAX_QUASIQUOTE, read(pic, file, next(pic, file)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_syntax_unquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
|
||||
{
|
||||
pic_sym *tag = pic->sSYNTAX_UNQUOTE;
|
||||
pic_value tag = pic->sSYNTAX_UNQUOTE;
|
||||
|
||||
if (peek(pic, file) == '@') {
|
||||
tag = pic->sSYNTAX_UNQUOTE_SPLICING;
|
||||
next(pic, file);
|
||||
}
|
||||
return pic_list(pic, 2, pic_obj_value(tag), read(pic, file, next(pic, file)));
|
||||
return pic_list(pic, 2, tag, read(pic, file, next(pic, file)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -199,7 +199,7 @@ read_symbol(pic_state *pic, xFILE *file, int c)
|
|||
{
|
||||
int len;
|
||||
char *buf;
|
||||
pic_sym *sym;
|
||||
pic_value sym;
|
||||
|
||||
len = 1;
|
||||
buf = pic_malloc(pic, len + 1);
|
||||
|
@ -217,7 +217,7 @@ read_symbol(pic_state *pic, xFILE *file, int c)
|
|||
sym = pic_intern_cstr(pic, buf);
|
||||
pic_free(pic, buf);
|
||||
|
||||
return pic_obj_value(sym);
|
||||
return sym;
|
||||
}
|
||||
|
||||
static unsigned
|
||||
|
@ -320,10 +320,10 @@ read_minus(pic_state *pic, xFILE *file, int c)
|
|||
}
|
||||
else {
|
||||
sym = read_symbol(pic, file, c);
|
||||
if (strcaseeq(pic_str(pic, pic_sym_name(pic, pic_sym_ptr(sym))), "-inf.0")) {
|
||||
if (strcaseeq(pic_str(pic, pic_sym_name(pic, sym)), "-inf.0")) {
|
||||
return pic_float_value(pic, -(1.0 / 0.0));
|
||||
}
|
||||
if (strcaseeq(pic_str(pic, pic_sym_name(pic, pic_sym_ptr(sym))), "-nan.0")) {
|
||||
if (strcaseeq(pic_str(pic, pic_sym_name(pic, sym)), "-nan.0")) {
|
||||
return pic_float_value(pic, -(0.0 / 0.0));
|
||||
}
|
||||
return sym;
|
||||
|
@ -340,10 +340,10 @@ read_plus(pic_state *pic, xFILE *file, int c)
|
|||
}
|
||||
else {
|
||||
sym = read_symbol(pic, file, c);
|
||||
if (strcaseeq(pic_str(pic, pic_sym_name(pic, pic_sym_ptr(sym))), "+inf.0")) {
|
||||
if (strcaseeq(pic_str(pic, pic_sym_name(pic, sym)), "+inf.0")) {
|
||||
return pic_float_value(pic, 1.0 / 0.0);
|
||||
}
|
||||
if (strcaseeq(pic_str(pic, pic_sym_name(pic, pic_sym_ptr(sym))), "+nan.0")) {
|
||||
if (strcaseeq(pic_str(pic, pic_sym_name(pic, sym)), "+nan.0")) {
|
||||
return pic_float_value(pic, 0.0 / 0.0);
|
||||
}
|
||||
return sym;
|
||||
|
@ -453,7 +453,7 @@ read_pipe(pic_state *pic, xFILE *file, int c)
|
|||
{
|
||||
char *buf;
|
||||
int size, cnt;
|
||||
pic_sym *sym;
|
||||
pic_value sym;
|
||||
/* Currently supports only ascii chars */
|
||||
char HEX_BUF[3];
|
||||
size_t i = 0;
|
||||
|
@ -489,7 +489,7 @@ read_pipe(pic_state *pic, xFILE *file, int c)
|
|||
sym = pic_intern_cstr(pic, buf);
|
||||
pic_free(pic, buf);
|
||||
|
||||
return pic_obj_value(sym);
|
||||
return sym;
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
|
|
@ -66,7 +66,7 @@ pic_init_features(pic_state *pic)
|
|||
void
|
||||
pic_add_feature(pic_state *pic, const char *feature)
|
||||
{
|
||||
pic_push(pic, pic_obj_value(pic_intern_cstr(pic, feature)), pic->features);
|
||||
pic_push(pic, pic_intern_cstr(pic, feature), pic->features);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -78,16 +78,16 @@ pic_features(pic_state *pic)
|
|||
}
|
||||
|
||||
#define import_builtin_syntax(name) do { \
|
||||
pic_sym *nick, *real; \
|
||||
pic_value nick, real; \
|
||||
nick = pic_intern_lit(pic, "builtin:" name); \
|
||||
real = pic_intern_lit(pic, name); \
|
||||
pic_put_identifier(pic, (pic_id *)nick, real, pic->lib->env); \
|
||||
pic_put_identifier(pic, pic_id_ptr(nick), real, pic->lib->env); \
|
||||
} while (0)
|
||||
|
||||
#define declare_vm_procedure(name) do { \
|
||||
pic_sym *sym; \
|
||||
pic_value sym; \
|
||||
sym = pic_intern_lit(pic, name); \
|
||||
pic_put_identifier(pic, (pic_id *)sym, sym, pic->lib->env); \
|
||||
pic_put_identifier(pic, pic_id_ptr(sym), sym, pic->lib->env); \
|
||||
} while (0)
|
||||
|
||||
void pic_init_bool(pic_state *);
|
||||
|
@ -116,7 +116,6 @@ extern const char pic_boot[][80];
|
|||
static void
|
||||
pic_init_core(pic_state *pic)
|
||||
{
|
||||
struct pic_box *pic_vm_gref_slot(pic_state *, pic_sym *);
|
||||
size_t ai;
|
||||
|
||||
pic_init_features(pic);
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
|
||||
KHASH_DEFINE(oblist, struct pic_string *, pic_sym *, kh_pic_str_hash, kh_pic_str_cmp)
|
||||
|
||||
pic_sym *
|
||||
pic_value
|
||||
pic_intern(pic_state *pic, pic_value str)
|
||||
{
|
||||
khash_t(oblist) *h = &pic->oblist;
|
||||
|
@ -22,16 +22,16 @@ pic_intern(pic_state *pic, pic_value str)
|
|||
if (ret == 0) { /* if exists */
|
||||
sym = kh_val(h, it);
|
||||
pic_protect(pic, pic_obj_value(sym));
|
||||
return sym;
|
||||
return pic_obj_value(sym);
|
||||
}
|
||||
|
||||
kh_val(h, it) = pic->sQUOTE; /* dummy */
|
||||
kh_val(h, it) = pic_sym_ptr(pic, pic->sQUOTE); /* dummy */
|
||||
|
||||
sym = (pic_sym *)pic_obj_alloc(pic, offsetof(pic_sym, env), PIC_TYPE_SYMBOL);
|
||||
sym->u.str = pic_str_ptr(pic, str);
|
||||
kh_val(h, it) = sym;
|
||||
|
||||
return sym;
|
||||
return pic_obj_value(sym);
|
||||
}
|
||||
|
||||
pic_id *
|
||||
|
@ -46,9 +46,9 @@ pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
|
|||
}
|
||||
|
||||
pic_value
|
||||
pic_sym_name(pic_state PIC_UNUSED(*pic), pic_sym *sym)
|
||||
pic_sym_name(pic_state PIC_UNUSED(*pic), pic_value sym)
|
||||
{
|
||||
return pic_obj_value(sym->u.str);
|
||||
return pic_obj_value(pic_sym_ptr(pic, sym)->u.str);
|
||||
}
|
||||
|
||||
pic_value
|
||||
|
@ -58,7 +58,7 @@ pic_id_name(pic_state *pic, pic_id *id)
|
|||
id = id->u.id;
|
||||
}
|
||||
|
||||
return pic_sym_name(pic, (pic_sym *)id);
|
||||
return pic_sym_name(pic, pic_obj_value(id));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -93,11 +93,11 @@ pic_symbol_symbol_eq_p(pic_state *pic)
|
|||
static pic_value
|
||||
pic_symbol_symbol_to_string(pic_state *pic)
|
||||
{
|
||||
pic_sym *sym;
|
||||
pic_value sym;
|
||||
|
||||
pic_get_args(pic, "m", &sym);
|
||||
|
||||
return pic_obj_value(sym->u.str);
|
||||
return pic_sym_name(pic, sym);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -107,7 +107,7 @@ pic_symbol_string_to_symbol(pic_state *pic)
|
|||
|
||||
pic_get_args(pic, "s", &str);
|
||||
|
||||
return pic_obj_value(pic_intern(pic, str));
|
||||
return pic_intern(pic, str);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
|
|
@ -173,46 +173,46 @@ write_pair(struct writer_control *p, pic_value pair)
|
|||
{
|
||||
pic_state *pic = p->pic;
|
||||
xFILE *file = p->file;
|
||||
pic_sym *tag;
|
||||
pic_value tag;
|
||||
|
||||
if (pic_pair_p(pic, pic_cdr(pic, pair)) && pic_nil_p(pic, pic_cddr(pic, pair)) && pic_sym_p(pic, pic_car(pic, pair))) {
|
||||
tag = pic_sym_ptr(pic_car(pic, pair));
|
||||
if (tag == pic->sQUOTE) {
|
||||
tag = pic_car(pic, pair);
|
||||
if (pic_eq_p(pic, tag, pic->sQUOTE)) {
|
||||
xfprintf(pic, file, "'");
|
||||
write_core(p, pic_cadr(pic, pair));
|
||||
return;
|
||||
}
|
||||
else if (tag == pic->sUNQUOTE) {
|
||||
else if (pic_eq_p(pic, tag, pic->sUNQUOTE)) {
|
||||
xfprintf(pic, file, ",");
|
||||
write_core(p, pic_cadr(pic, pair));
|
||||
return;
|
||||
}
|
||||
else if (tag == pic->sUNQUOTE_SPLICING) {
|
||||
else if (pic_eq_p(pic, tag, pic->sUNQUOTE_SPLICING)) {
|
||||
xfprintf(pic, file, ",@");
|
||||
write_core(p, pic_cadr(pic, pair));
|
||||
return;
|
||||
}
|
||||
else if (tag == pic->sQUASIQUOTE) {
|
||||
else if (pic_eq_p(pic, tag, pic->sQUASIQUOTE)) {
|
||||
xfprintf(pic, file, "`");
|
||||
write_core(p, pic_cadr(pic, pair));
|
||||
return;
|
||||
}
|
||||
else if (tag == pic->sSYNTAX_QUOTE) {
|
||||
else if (pic_eq_p(pic, tag, pic->sSYNTAX_QUOTE)) {
|
||||
xfprintf(pic, file, "#'");
|
||||
write_core(p, pic_cadr(pic, pair));
|
||||
return;
|
||||
}
|
||||
else if (tag == pic->sSYNTAX_UNQUOTE) {
|
||||
else if (pic_eq_p(pic, tag, pic->sSYNTAX_UNQUOTE)) {
|
||||
xfprintf(pic, file, "#,");
|
||||
write_core(p, pic_cadr(pic, pair));
|
||||
return;
|
||||
}
|
||||
else if (tag == pic->sSYNTAX_UNQUOTE_SPLICING) {
|
||||
else if (pic_eq_p(pic, tag, pic->sSYNTAX_UNQUOTE_SPLICING)) {
|
||||
xfprintf(pic, file, "#,@");
|
||||
write_core(p, pic_cadr(pic, pair));
|
||||
return;
|
||||
}
|
||||
else if (tag == pic->sSYNTAX_QUASIQUOTE) {
|
||||
else if (pic_eq_p(pic, tag, pic->sSYNTAX_QUASIQUOTE)) {
|
||||
xfprintf(pic, file, "#`");
|
||||
write_core(p, pic_cadr(pic, pair));
|
||||
return;
|
||||
|
@ -245,8 +245,7 @@ write_dict(struct writer_control *p, pic_value dict)
|
|||
{
|
||||
pic_state *pic = p->pic;
|
||||
xFILE *file = p->file;
|
||||
pic_sym *key;
|
||||
pic_value val;
|
||||
pic_value key, val;
|
||||
int it = 0;
|
||||
|
||||
xfprintf(pic, file, "#.(dictionary");
|
||||
|
@ -303,7 +302,7 @@ write_core(struct writer_control *p, pic_value obj)
|
|||
write_float(pic, pic_float(pic, obj), file);
|
||||
break;
|
||||
case PIC_TYPE_SYMBOL:
|
||||
xfprintf(pic, file, "%s", pic_str(pic, pic_sym_name(pic, pic_sym_ptr(obj))));
|
||||
xfprintf(pic, file, "%s", pic_str(pic, pic_sym_name(pic, obj)));
|
||||
break;
|
||||
case PIC_TYPE_BLOB:
|
||||
write_blob(pic, obj, file);
|
||||
|
|
Loading…
Reference in New Issue