From f4efaf5dc042d5261f5fc4a0eae9113002cc93e6 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 20 Feb 2016 15:31:14 +0900 Subject: [PATCH] pic_sym * -> pic_value --- extlib/benz/bool.c | 4 +- extlib/benz/debug.c | 2 +- extlib/benz/dict.c | 63 ++++--- extlib/benz/error.c | 5 +- extlib/benz/eval.c | 245 +++++++++++++--------------- extlib/benz/gc.c | 9 +- extlib/benz/include/picrin.h | 17 +- extlib/benz/include/picrin/object.h | 8 +- extlib/benz/include/picrin/state.h | 14 +- extlib/benz/lib.c | 54 +++--- extlib/benz/macro.c | 110 ++++++------- extlib/benz/proc.c | 50 +++--- extlib/benz/read.c | 32 ++-- extlib/benz/state.c | 11 +- extlib/benz/symbol.c | 20 +-- extlib/benz/write.c | 25 ++- 16 files changed, 317 insertions(+), 352 deletions(-) diff --git a/extlib/benz/bool.c b/extlib/benz/bool.c index 5bf320c1..1a1a4310 100644 --- a/extlib/benz/bool.c +++ b/extlib/benz/bool.c @@ -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; diff --git a/extlib/benz/debug.c b/extlib/benz/debug.c index 85389535..6ba134c9 100644 --- a/extlib/benz/debug.c +++ b/extlib/benz/debug.c @@ -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, " "); } diff --git a/extlib/benz/dict.c b/extlib/benz/dict.c index 301d0c4b..8675d5e9 100644 --- a/extlib/benz/dict.c +++ b/extlib/benz/dict.c @@ -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; diff --git a/extlib/benz/error.c b/extlib/benz/error.c index e17c41a5..dff5d0e5 100644 --- a/extlib/benz/error.c +++ b/extlib/benz/error.c @@ -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); diff --git a/extlib/benz/eval.c b/extlib/benz/eval.c index 248b67f9..d8b86146 100644 --- a/extlib/benz/eval.c +++ b/extlib/benz/eval.c @@ -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); diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c index d1e2070e..fa35d5be 100644 --- a/extlib/benz/gc.c +++ b/extlib/benz/gc.c @@ -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) diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 5f9850c2..51b0c8f5 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -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); diff --git a/extlib/benz/include/picrin/object.h b/extlib/benz/include/picrin/object.h index f8d18457..953b73d5 100644 --- a/extlib/benz/include/picrin/object.h +++ b/extlib/benz/include/picrin/object.h @@ -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 *); diff --git a/extlib/benz/include/picrin/state.h b/extlib/benz/include/picrin/state.h index 30220021..a3e9ce88 100644 --- a/extlib/benz/include/picrin/state.h +++ b/extlib/benz/include/picrin/state.h @@ -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; diff --git a/extlib/benz/lib.c b/extlib/benz/lib.c index bd315e2d..73e29c11 100644 --- a/extlib/benz/lib.c +++ b/extlib/benz/lib.c @@ -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; diff --git a/extlib/benz/macro.c b/extlib/benz/macro.c index faad8f45..aaf463ae 100644 --- a/extlib/benz/macro.c +++ b/extlib/benz/macro.c @@ -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); } } diff --git a/extlib/benz/proc.c b/extlib/benz/proc.c index 69d7d34d..d678e813 100644 --- a/extlib/benz/proc.c +++ b/extlib/benz/proc.c @@ -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); } diff --git a/extlib/benz/read.c b/extlib/benz/read.c index 92fa0b60..077a8334 100644 --- a/extlib/benz/read.c +++ b/extlib/benz/read.c @@ -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 diff --git a/extlib/benz/state.c b/extlib/benz/state.c index 60ed6d9a..c0ecea1b 100644 --- a/extlib/benz/state.c +++ b/extlib/benz/state.c @@ -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); diff --git a/extlib/benz/symbol.c b/extlib/benz/symbol.c index 2db1da56..3ef567d9 100644 --- a/extlib/benz/symbol.c +++ b/extlib/benz/symbol.c @@ -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 diff --git a/extlib/benz/write.c b/extlib/benz/write.c index 11de3960..cd363025 100644 --- a/extlib/benz/write.c +++ b/extlib/benz/write.c @@ -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);