From 615bdff61a8aaf85e22e43c985cb2c21ad0c598d Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 18 Feb 2016 20:15:42 +0900 Subject: [PATCH] add pic_state parameter (to be used by copy gc) --- contrib/10.callcc/callcc.c | 2 +- contrib/10.math/math.c | 76 ++++++++-------- contrib/20.r7rs/src/file.c | 8 +- contrib/20.r7rs/src/load.c | 2 +- contrib/20.r7rs/src/mutable-string.c | 14 +-- contrib/20.r7rs/src/system.c | 20 ++--- contrib/20.r7rs/src/time.c | 6 +- contrib/30.random/src/random.c | 2 +- contrib/30.readline/src/readline.c | 36 ++++---- contrib/30.regexp/src/regexp.c | 20 ++--- contrib/40.srfi/src/106.c | 96 ++++++++++----------- contrib/60.repl/repl.c | 2 +- docs/capi.rst | 2 +- extlib/benz/README.md | 2 +- extlib/benz/blob.c | 24 +++--- extlib/benz/bool.c | 40 ++++----- extlib/benz/char.c | 16 ++-- extlib/benz/cont.c | 10 +-- extlib/benz/debug.c | 4 +- extlib/benz/dict.c | 20 ++--- extlib/benz/error.c | 6 +- extlib/benz/eval.c | 52 +++++------ extlib/benz/gc.c | 10 +-- extlib/benz/include/picrin.h | 124 ++++++++++++++------------- extlib/benz/include/picrin/data.h | 4 +- extlib/benz/include/picrin/error.h | 2 +- extlib/benz/include/picrin/macro.h | 2 +- extlib/benz/include/picrin/pair.h | 8 +- extlib/benz/include/picrin/port.h | 1 - extlib/benz/include/picrin/proc.h | 2 +- extlib/benz/include/picrin/record.h | 2 +- extlib/benz/include/picrin/symbol.h | 2 +- extlib/benz/include/picrin/type.h | 81 ++++++++--------- extlib/benz/lib.c | 12 +-- extlib/benz/load.c | 2 +- extlib/benz/macro.c | 24 +++--- extlib/benz/number.c | 70 +++++++-------- extlib/benz/pair.c | 88 +++++++++---------- extlib/benz/port.c | 71 +++++++-------- extlib/benz/proc.c | 62 +++++++------- extlib/benz/read.c | 90 +++++++++---------- extlib/benz/record.c | 2 +- extlib/benz/state.c | 6 +- extlib/benz/string.c | 58 ++++++------- extlib/benz/symbol.c | 28 +++--- extlib/benz/var.c | 6 +- extlib/benz/vector.c | 28 +++--- extlib/benz/weak.c | 10 +-- extlib/benz/write.c | 38 ++++---- 49 files changed, 644 insertions(+), 649 deletions(-) diff --git a/contrib/10.callcc/callcc.c b/contrib/10.callcc/callcc.c index 51327757..0d48b6d3 100644 --- a/contrib/10.callcc/callcc.c +++ b/contrib/10.callcc/callcc.c @@ -158,7 +158,7 @@ save_cont(pic_state *pic, struct pic_fullcont **c) cont->arena = pic_malloc(pic, sizeof(struct pic_object *) * pic->arena_size); memcpy(cont->arena, pic->arena, sizeof(struct pic_object *) * pic->arena_size); - cont->results = pic_undef_value(); + cont->results = pic_undef_value(pic); } static void diff --git a/contrib/10.math/math.c b/contrib/10.math/math.c index 81c04927..0fc2ff92 100644 --- a/contrib/10.math/math.c +++ b/contrib/10.math/math.c @@ -17,13 +17,13 @@ pic_number_floor2(pic_state *pic) ? i / j : (i / j) - 1; - return pic_values2(pic, pic_int_value(k), pic_int_value(i - k * j)); + return pic_values2(pic, pic_int_value(pic, k), pic_int_value(pic, i - k * j)); } else { double q, r; q = floor((double)i/j); r = i - j * q; - return pic_values2(pic, pic_float_value(q), pic_float_value(r)); + return pic_values2(pic, pic_float_value(pic, q), pic_float_value(pic, r)); } } @@ -36,14 +36,14 @@ pic_number_trunc2(pic_state *pic) pic_get_args(pic, "II", &i, &e1, &j, &e2); if (e1 && e2) { - return pic_values2(pic, pic_int_value(i/j), pic_int_value(i - (i/j) * j)); + return pic_values2(pic, pic_int_value(pic, i/j), pic_int_value(pic, i - (i/j) * j)); } else { double q, r; q = trunc((double)i/j); r = i - j * q; - return pic_values2(pic, pic_float_value(q), pic_float_value(r)); + return pic_values2(pic, pic_float_value(pic, q), pic_float_value(pic, r)); } } @@ -56,9 +56,9 @@ pic_number_floor(pic_state *pic) pic_get_args(pic, "F", &f, &e); if (e) { - return pic_int_value((int)f); + return pic_int_value(pic, (int)f); } else { - return pic_float_value(floor(f)); + return pic_float_value(pic, floor(f)); } } @@ -71,9 +71,9 @@ pic_number_ceil(pic_state *pic) pic_get_args(pic, "F", &f, &e); if (e) { - return pic_int_value((int)f); + return pic_int_value(pic, (int)f); } else { - return pic_float_value(ceil(f)); + return pic_float_value(pic, ceil(f)); } } @@ -86,9 +86,9 @@ pic_number_trunc(pic_state *pic) pic_get_args(pic, "F", &f, &e); if (e) { - return pic_int_value((int)f); + return pic_int_value(pic, (int)f); } else { - return pic_float_value(trunc(f)); + return pic_float_value(pic, trunc(f)); } } @@ -101,9 +101,9 @@ pic_number_round(pic_state *pic) pic_get_args(pic, "F", &f, &e); if (e) { - return pic_int_value((int)f); + return pic_int_value(pic, (int)f); } else { - return pic_float_value(round(f)); + return pic_float_value(pic, round(f)); } } @@ -114,12 +114,12 @@ pic_number_finite_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_int_p(v)) - return pic_true_value(); - if (pic_float_p(v) && ! (isinf(pic_float(v)) || isnan(pic_float(v)))) - return pic_true_value(); + if (pic_int_p(pic, v)) + return pic_true_value(pic); + if (pic_float_p(pic, v) && ! (isinf(pic_float(pic, v)) || isnan(pic_float(pic, v)))) + return pic_true_value(pic); else - return pic_false_value(); + return pic_false_value(pic); } static pic_value @@ -129,10 +129,10 @@ pic_number_infinite_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_float_p(v) && isinf(pic_float(v))) - return pic_true_value(); + if (pic_float_p(pic, v) && isinf(pic_float(pic, v))) + return pic_true_value(pic); else - return pic_false_value(); + return pic_false_value(pic); } static pic_value @@ -142,10 +142,10 @@ pic_number_nan_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_float_p(v) && isnan(pic_float(v))) - return pic_true_value(); + if (pic_float_p(pic, v) && isnan(pic_float(pic, v))) + return pic_true_value(pic); else - return pic_false_value(); + return pic_false_value(pic); } static pic_value @@ -154,7 +154,7 @@ pic_number_exp(pic_state *pic) double f; pic_get_args(pic, "f", &f); - return pic_float_value(exp(f)); + return pic_float_value(pic, exp(f)); } static pic_value @@ -165,10 +165,10 @@ pic_number_log(pic_state *pic) argc = pic_get_args(pic, "f|f", &f, &g); if (argc == 1) { - return pic_float_value(log(f)); + return pic_float_value(pic, log(f)); } else { - return pic_float_value(log(f) / log(g)); + return pic_float_value(pic, log(f) / log(g)); } } @@ -179,7 +179,7 @@ pic_number_sin(pic_state *pic) pic_get_args(pic, "f", &f); f = sin(f); - return pic_float_value(f); + return pic_float_value(pic, f); } static pic_value @@ -189,7 +189,7 @@ pic_number_cos(pic_state *pic) pic_get_args(pic, "f", &f); f = cos(f); - return pic_float_value(f); + return pic_float_value(pic, f); } static pic_value @@ -199,7 +199,7 @@ pic_number_tan(pic_state *pic) pic_get_args(pic, "f", &f); f = tan(f); - return pic_float_value(f); + return pic_float_value(pic, f); } static pic_value @@ -209,7 +209,7 @@ pic_number_acos(pic_state *pic) pic_get_args(pic, "f", &f); f = acos(f); - return pic_float_value(f); + return pic_float_value(pic, f); } static pic_value @@ -219,7 +219,7 @@ pic_number_asin(pic_state *pic) pic_get_args(pic, "f", &f); f = asin(f); - return pic_float_value(f); + return pic_float_value(pic, f); } static pic_value @@ -231,10 +231,10 @@ pic_number_atan(pic_state *pic) argc = pic_get_args(pic, "f|f", &f, &g); if (argc == 1) { f = atan(f); - return pic_float_value(f); + return pic_float_value(pic, f); } else { - return pic_float_value(atan2(f,g)); + return pic_float_value(pic, atan2(f,g)); } } @@ -245,7 +245,7 @@ pic_number_sqrt(pic_state *pic) pic_get_args(pic, "f", &f); - return pic_float_value(sqrt(f)); + return pic_float_value(pic, sqrt(f)); } static pic_value @@ -257,10 +257,10 @@ pic_number_abs(pic_state *pic) pic_get_args(pic, "F", &f, &e); if (e) { - return pic_int_value(f < 0 ? -f : f); + return pic_int_value(pic, f < 0 ? -f : f); } else { - return pic_float_value(fabs(f)); + return pic_float_value(pic, fabs(f)); } } @@ -275,10 +275,10 @@ pic_number_expt(pic_state *pic) h = pow(f, g); if (e1 && e2) { if (h <= INT_MAX) { - return pic_int_value((int)h); + return pic_int_value(pic, (int)h); } } - return pic_float_value(h); + return pic_float_value(pic, h); } void diff --git a/contrib/20.r7rs/src/file.c b/contrib/20.r7rs/src/file.c index d6a1135b..270260db 100644 --- a/contrib/20.r7rs/src/file.c +++ b/contrib/20.r7rs/src/file.c @@ -11,7 +11,7 @@ file_error(pic_state *pic, const char *msg) { struct pic_error *e; - e = pic_make_error(pic, pic_intern_lit(pic, "file"), msg, pic_nil_value()); + e = pic_make_error(pic, pic_intern_lit(pic, "file"), msg, pic_nil_value(pic)); pic_raise(pic, pic_obj_value(e)); } @@ -71,9 +71,9 @@ pic_file_exists_p(pic_state *pic) fp = fopen(fname, "r"); if (fp) { fclose(fp); - return pic_true_value(); + return pic_true_value(pic); } else { - return pic_false_value(); + return pic_false_value(pic); } } @@ -87,7 +87,7 @@ pic_file_delete(pic_state *pic) if (remove(fname) != 0) { file_error(pic, "file cannot be deleted"); } - return pic_undef_value(); + return pic_undef_value(pic); } void diff --git a/contrib/20.r7rs/src/load.c b/contrib/20.r7rs/src/load.c index aed45506..7b4c9e8a 100644 --- a/contrib/20.r7rs/src/load.c +++ b/contrib/20.r7rs/src/load.c @@ -19,7 +19,7 @@ pic_load_load(pic_state *pic) pic_close_port(pic, port); - return pic_undef_value(); + return pic_undef_value(pic); } void diff --git a/contrib/20.r7rs/src/mutable-string.c b/contrib/20.r7rs/src/mutable-string.c index 2d360c6c..db58687e 100644 --- a/contrib/20.r7rs/src/mutable-string.c +++ b/contrib/20.r7rs/src/mutable-string.c @@ -6,7 +6,7 @@ pic_str_set(pic_state *pic, struct pic_string *str, int i, char c) struct pic_string *x, *y, *z, *tmp; char buf[1]; - if (pic_str_len(str) <= i) { + if (pic_str_len(pic, str) <= i) { pic_errorf(pic, "index out of range %d", i); } @@ -14,7 +14,7 @@ pic_str_set(pic_state *pic, struct pic_string *str, int i, char c) x = pic_str_sub(pic, str, 0, i); y = pic_make_str(pic, buf, 1); - z = pic_str_sub(pic, str, i + 1, pic_str_len(str)); + z = pic_str_sub(pic, str, i + 1, pic_str_len(pic, str)); tmp = pic_str_cat(pic, x, pic_str_cat(pic, y, z)); @@ -33,7 +33,7 @@ pic_str_string_set(pic_state *pic) pic_get_args(pic, "sic", &str, &k, &c); pic_str_set(pic, str, k, c); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -48,7 +48,7 @@ pic_str_string_copy_ip(pic_state *pic) case 3: start = 0; case 4: - end = pic_str_len(from); + end = pic_str_len(pic, from); } if (to == from) { from = pic_str_sub(pic, from, 0, end); @@ -57,7 +57,7 @@ pic_str_string_copy_ip(pic_state *pic) while (start < end) { pic_str_set(pic, to, at++, pic_str_ref(pic, from, start++)); } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -73,13 +73,13 @@ pic_str_string_fill_ip(pic_state *pic) case 2: start = 0; case 3: - end = pic_str_len(str); + end = pic_str_len(pic, str); } while (start < end) { pic_str_set(pic, str, start++, c); } - return pic_undef_value(); + return pic_undef_value(pic); } void diff --git a/contrib/20.r7rs/src/system.c b/contrib/20.r7rs/src/system.c index 53acc81f..26ffbfe1 100644 --- a/contrib/20.r7rs/src/system.c +++ b/contrib/20.r7rs/src/system.c @@ -13,7 +13,7 @@ extern char **picrin_envp; static pic_value pic_system_cmdline(pic_state *pic) { - pic_value v = pic_nil_value(); + pic_value v = pic_nil_value(pic); int i; pic_get_args(pic, ""); @@ -36,12 +36,12 @@ pic_system_exit(pic_state *pic) argc = pic_get_args(pic, "|o", &v); if (argc == 1) { - switch (pic_type(v)) { + switch (pic_type(pic, v)) { case PIC_TT_FLOAT: - status = (int)pic_float(v); + status = (int)pic_float(pic, v); break; case PIC_TT_INT: - status = pic_int(v); + status = pic_int(pic, v); break; default: break; @@ -61,12 +61,12 @@ pic_system_emergency_exit(pic_state *pic) argc = pic_get_args(pic, "|o", &v); if (argc == 1) { - switch (pic_type(v)) { + switch (pic_type(pic, v)) { case PIC_TT_FLOAT: - status = (int)pic_float(v); + status = (int)pic_float(pic, v); break; case PIC_TT_INT: - status = pic_int(v); + status = pic_int(pic, v); break; default: break; @@ -86,7 +86,7 @@ pic_system_getenv(pic_state *pic) val = getenv(str); if (val == NULL) - return pic_nil_value(); + return pic_nil_value(pic); else return pic_obj_value(pic_make_cstr(pic, val)); } @@ -95,13 +95,13 @@ static pic_value pic_system_getenvs(pic_state *pic) { char **envp; - pic_value data = pic_nil_value(); + pic_value data = pic_nil_value(pic); size_t ai = pic_gc_arena_preserve(pic); pic_get_args(pic, ""); if (! picrin_envp) { - return pic_nil_value(); + return pic_nil_value(pic); } for (envp = picrin_envp; *envp; ++envp) { diff --git a/contrib/20.r7rs/src/time.c b/contrib/20.r7rs/src/time.c index ba34d4eb..ac8585d3 100644 --- a/contrib/20.r7rs/src/time.c +++ b/contrib/20.r7rs/src/time.c @@ -16,7 +16,7 @@ pic_current_second(pic_state *pic) pic_get_args(pic, ""); time(&t); - return pic_float_value((double)t + UTC_TAI_DIFF); + return pic_float_value(pic, (double)t + UTC_TAI_DIFF); } static pic_value @@ -27,7 +27,7 @@ pic_current_jiffy(pic_state *pic) pic_get_args(pic, ""); c = clock(); - return pic_int_value((int)c); /* The year 2038 problem :-| */ + return pic_int_value(pic, (int)c); /* The year 2038 problem :-| */ } static pic_value @@ -35,7 +35,7 @@ pic_jiffies_per_second(pic_state *pic) { pic_get_args(pic, ""); - return pic_int_value(CLOCKS_PER_SEC); + return pic_int_value(pic, CLOCKS_PER_SEC); } void diff --git a/contrib/30.random/src/random.c b/contrib/30.random/src/random.c index 6eb2ee11..95fb7a03 100644 --- a/contrib/30.random/src/random.c +++ b/contrib/30.random/src/random.c @@ -7,7 +7,7 @@ pic_random_real(pic_state *pic) { pic_get_args(pic, ""); - return pic_float_value(genrand_real3()); + return pic_float_value(pic, genrand_real3()); } void diff --git a/contrib/30.readline/src/readline.c b/contrib/30.readline/src/readline.c index 9b95e2ad..a7542af5 100644 --- a/contrib/30.readline/src/readline.c +++ b/contrib/30.readline/src/readline.c @@ -29,7 +29,7 @@ pic_rl_history_length(pic_state *pic) { pic_get_args(pic, ""); - return pic_int_value(history_get_history_state()->length); + return pic_int_value(pic, history_get_history_state()->length); } static pic_value @@ -41,7 +41,7 @@ pic_rl_add_history(pic_state *pic) add_history(line); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -53,7 +53,7 @@ pic_rl_stifle_history(pic_state *pic) stifle_history(i); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -63,7 +63,7 @@ pic_rl_unstifle_history(pic_state *pic) unstifle_history(); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -71,7 +71,7 @@ pic_rl_history_is_stifled(pic_state *pic) { pic_get_args(pic, ""); - return pic_bool_value(history_is_stifled()); + return pic_bool_value(pic, history_is_stifled()); } static pic_value @@ -79,7 +79,7 @@ pic_rl_where_history(pic_state *pic) { pic_get_args(pic, ""); - return pic_int_value(where_history()); + return pic_int_value(pic, where_history()); } static pic_value @@ -101,7 +101,7 @@ pic_rl_history_get(pic_state *pic) e = history_get(i); return e ? pic_obj_value(pic_make_cstr(pic, e->line)) - : pic_false_value(); + : pic_false_value(pic); } static pic_value @@ -115,7 +115,7 @@ pic_rl_remove_history(pic_state *pic) e = remove_history(i); return e ? pic_obj_value(pic_make_cstr(pic, e->line)) - : pic_false_value(); + : pic_false_value(pic); } static pic_value @@ -125,7 +125,7 @@ pic_rl_clear_history(pic_state *pic) clear_history(); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -136,7 +136,7 @@ pic_rl_history_set_pos(pic_state *pic) pic_get_args(pic, "i", &i); - return pic_int_value(history_set_pos(i)); + return pic_int_value(pic, history_set_pos(i)); } static pic_value @@ -149,7 +149,7 @@ pic_rl_previous_history(pic_state *pic) e = previous_history(); return e ? pic_obj_value(pic_make_cstr(pic, e->line)) - : pic_false_value(); + : pic_false_value(pic); } static pic_value @@ -162,7 +162,7 @@ pic_rl_next_history(pic_state *pic) e = next_history(); return e ? pic_obj_value(pic_make_cstr(pic, e->line)) - : pic_false_value(); + : pic_false_value(pic); } static pic_value @@ -173,9 +173,9 @@ pic_rl_history_search(pic_state *pic) argc = pic_get_args(pic, "zi|i", &key, &direction, &pos); if(argc == 2) - return pic_int_value(history_search(key, direction)); + return pic_int_value(pic, history_search(key, direction)); else - return pic_int_value(history_search_pos(key, direction, pos)); + return pic_int_value(pic, history_search_pos(key, direction, pos)); } static pic_value @@ -186,7 +186,7 @@ pic_rl_history_search_prefix(pic_state *pic) pic_get_args(pic, "zi", &key, &direction); - return pic_int_value(history_search_prefix(key, direction)); + return pic_int_value(pic, history_search_prefix(key, direction)); } static pic_value @@ -199,7 +199,7 @@ pic_rl_read_history(pic_state *pic) if(read_history(filename)) pic_errorf(pic, "cannot read history file : %s", filename); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -212,7 +212,7 @@ pic_rl_write_history(pic_state *pic) if(write_history(filename)) pic_errorf(pic, "cannot write history file: %s", filename); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -225,7 +225,7 @@ pic_rl_truncate_file(pic_state *pic) history_truncate_file(filename, i); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value diff --git a/contrib/30.regexp/src/regexp.c b/contrib/30.regexp/src/regexp.c index 5cfc1ccb..64740f8a 100644 --- a/contrib/30.regexp/src/regexp.c +++ b/contrib/30.regexp/src/regexp.c @@ -19,7 +19,7 @@ regexp_dtor(pic_state *pic, void *data) static const pic_data_type regexp_type = { "regexp", regexp_dtor, NULL }; -#define pic_regexp_p(o) (pic_data_type_p((o), ®exp_type)) +#define pic_regexp_p(pic, o) (pic_data_type_p(pic, (o), ®exp_type)) #define pic_regexp_data_ptr(o) ((struct pic_regexp_t *)pic_data_ptr(o)->data) static pic_value @@ -72,7 +72,7 @@ pic_regexp_regexp_p(pic_state *pic) pic_get_args(pic, "o", &obj); - return pic_bool_value(pic_regexp_p(obj)); + return pic_bool_value(pic, pic_regexp_p(pic, obj)); } static pic_value @@ -89,8 +89,8 @@ pic_regexp_regexp_match(pic_state *pic) pic_assert_type(pic, reg, regexp); - matches = pic_nil_value(); - positions = pic_nil_value(); + matches = pic_nil_value(pic); + positions = pic_nil_value(pic); if (strchr(pic_regexp_data_ptr(reg)->flags, 'g') != NULL) { /* global search */ @@ -98,7 +98,7 @@ pic_regexp_regexp_match(pic_state *pic) offset = 0; while (regexec(&pic_regexp_data_ptr(reg)->reg, input, 1, match, 0) != REG_NOMATCH) { pic_push(pic, pic_obj_value(pic_make_str(pic, input, match[0].rm_eo - match[0].rm_so)), matches); - pic_push(pic, pic_int_value(offset), positions); + pic_push(pic, pic_int_value(pic, offset), positions); offset += match[0].rm_eo; input += match[0].rm_eo; @@ -113,14 +113,14 @@ pic_regexp_regexp_match(pic_state *pic) } str = pic_make_str(pic, input + match[i].rm_so, match[i].rm_eo - match[i].rm_so); pic_push(pic, pic_obj_value(str), matches); - pic_push(pic, pic_int_value(match[i].rm_so), positions); + pic_push(pic, pic_int_value(pic, match[i].rm_so), positions); } } } - if (pic_nil_p(matches)) { - matches = pic_false_value(); - positions = pic_false_value(); + if (pic_nil_p(pic, matches)) { + matches = pic_false_value(pic); + positions = pic_false_value(pic); } else { matches = pic_reverse(pic, matches); positions = pic_reverse(pic, positions); @@ -134,7 +134,7 @@ pic_regexp_regexp_split(pic_state *pic) pic_value reg; const char *input; regmatch_t match; - pic_value output = pic_nil_value(); + pic_value output = pic_nil_value(pic); pic_get_args(pic, "oz", ®, &input); diff --git a/contrib/40.srfi/src/106.c b/contrib/40.srfi/src/106.c index d6598d9a..b1aac0ce 100644 --- a/contrib/40.srfi/src/106.c +++ b/contrib/40.srfi/src/106.c @@ -46,13 +46,13 @@ socket_dtor(pic_state *pic, void *data) static const pic_data_type socket_type = { "socket", socket_dtor, NULL }; -#define pic_socket_p(o) (pic_data_type_p((o), &socket_type)) +#define pic_socket_p(pic, o) (pic_data_type_p(pic, (o), &socket_type)) #define pic_socket_data_ptr(o) ((struct pic_socket_t *)pic_data_ptr(o)->data) PIC_INLINE void validate_socket_object(pic_state *pic, pic_value v) { - if (! pic_socket_p(v)) { + if (! pic_socket_p(pic, v)) { pic_errorf(pic, "~s is not a socket object", v); } } @@ -63,7 +63,7 @@ pic_socket_socket_p(pic_state *pic) pic_value obj; pic_get_args(pic, "o", &obj); - return pic_bool_value(pic_socket_p(obj)); + return pic_bool_value(pic, pic_socket_p(pic, obj)); } static pic_value @@ -79,10 +79,10 @@ pic_socket_make_socket(pic_state *pic) pic_get_args(pic, "ooiiii", &n, &s, &family, &socktype, &flags, &protocol); node = service = NULL; - if (pic_str_p(n)) { + if (pic_str_p(pic, n)) { node = pic_str_cstr(pic, pic_str_ptr(n)); } - if (pic_str_p(s)) { + if (pic_str_p(pic, s)) { service = pic_str_cstr(pic, pic_str_ptr(s)); } @@ -224,7 +224,7 @@ pic_socket_socket_send(pic_state *pic) written += len; } - return pic_int_value(written); + return pic_int_value(pic, written); } static pic_value @@ -286,7 +286,7 @@ pic_socket_socket_shutdown(pic_state *pic) sock->fd = -1; } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -299,7 +299,7 @@ pic_socket_socket_close(pic_state *pic) socket_close(pic_socket_data_ptr(obj)); - return pic_undef_value(); + return pic_undef_value(pic); } static int @@ -416,109 +416,109 @@ pic_init_srfi_106(pic_state *pic) pic_defun_(pic, "call-with-socket", pic_socket_call_with_socket); #ifdef AF_INET - pic_define_(pic, "*af-inet*", pic_int_value(AF_INET)); + pic_define_(pic, "*af-inet*", pic_int_value(pic, AF_INET)); #else - pic_define_(pic, "*af-inet*", pic_false_value()); + pic_define_(pic, "*af-inet*", pic_false_value(pic)); #endif #ifdef AF_INET6 - pic_define_(pic, "*af-inet6*", pic_int_value(AF_INET6)); + pic_define_(pic, "*af-inet6*", pic_int_value(pic, AF_INET6)); #else - pic_define_(pic, "*af-inet6*", pic_false_value()); + pic_define_(pic, "*af-inet6*", pic_false_value(pic)); #endif #ifdef AF_UNSPEC - pic_define_(pic, "*af-unspec*", pic_int_value(AF_UNSPEC)); + pic_define_(pic, "*af-unspec*", pic_int_value(pic, AF_UNSPEC)); #else - pic_define_(pic, "*af-unspec*", pic_false_value()); + pic_define_(pic, "*af-unspec*", pic_false_value(pic)); #endif #ifdef SOCK_STREAM - pic_define_(pic, "*sock-stream*", pic_int_value(SOCK_STREAM)); + pic_define_(pic, "*sock-stream*", pic_int_value(pic, SOCK_STREAM)); #else - pic_define_(pic, "*sock-stream*", pic_false_value()); + pic_define_(pic, "*sock-stream*", pic_false_value(pic)); #endif #ifdef SOCK_DGRAM - pic_define_(pic, "*sock-dgram*", pic_int_value(SOCK_DGRAM)); + pic_define_(pic, "*sock-dgram*", pic_int_value(pic, SOCK_DGRAM)); #else - pic_define_(pic, "*sock-dgram*", pic_false_value()); + pic_define_(pic, "*sock-dgram*", pic_false_value(pic)); #endif #ifdef AI_CANONNAME - pic_define_(pic, "*ai-canonname*", pic_int_value(AI_CANONNAME)); + pic_define_(pic, "*ai-canonname*", pic_int_value(pic, AI_CANONNAME)); #else - pic_define_(pic, "*ai-canonname*", pic_false_value()); + pic_define_(pic, "*ai-canonname*", pic_false_value(pic)); #endif #ifdef AI_NUMERICHOST - pic_define_(pic, "*ai-numerichost*", pic_int_value(AI_NUMERICHOST)); + pic_define_(pic, "*ai-numerichost*", pic_int_value(pic, AI_NUMERICHOST)); #else - pic_define_(pic, "*ai-numerichost*", pic_false_value()); + pic_define_(pic, "*ai-numerichost*", pic_false_value(pic)); #endif /* AI_V4MAPPED and AI_ALL are not supported by *BSDs, even though they are defined in netdb.h. */ #if defined(AI_V4MAPPED) && !defined(BSD) - pic_define_(pic, "*ai-v4mapped*", pic_int_value(AI_V4MAPPED)); + pic_define_(pic, "*ai-v4mapped*", pic_int_value(pic, AI_V4MAPPED)); #else - pic_define_(pic, "*ai-v4mapped*", pic_false_value()); + pic_define_(pic, "*ai-v4mapped*", pic_false_value(pic)); #endif #if defined(AI_ALL) && !defined(BSD) - pic_define_(pic, "*ai-all*", pic_int_value(AI_ALL)); + pic_define_(pic, "*ai-all*", pic_int_value(pic, AI_ALL)); #else - pic_define_(pic, "*ai-all*", pic_false_value()); + pic_define_(pic, "*ai-all*", pic_false_value(pic)); #endif #ifdef AI_ADDRCONFIG - pic_define_(pic, "*ai-addrconfig*", pic_int_value(AI_ADDRCONFIG)); + pic_define_(pic, "*ai-addrconfig*", pic_int_value(pic, AI_ADDRCONFIG)); #else - pic_define_(pic, "*ai-addrconfig*", pic_false_value()); + pic_define_(pic, "*ai-addrconfig*", pic_false_value(pic)); #endif #ifdef AI_PASSIVE - pic_define_(pic, "*ai-passive*", pic_int_value(AI_PASSIVE)); + pic_define_(pic, "*ai-passive*", pic_int_value(pic, AI_PASSIVE)); #else - pic_define_(pic, "*ai-passive*", pic_false_value()); + pic_define_(pic, "*ai-passive*", pic_false_value(pic)); #endif #ifdef IPPROTO_IP - pic_define_(pic, "*ipproto-ip*", pic_int_value(IPPROTO_IP)); + pic_define_(pic, "*ipproto-ip*", pic_int_value(pic, IPPROTO_IP)); #else - pic_define_(pic, "*ipproto-ip*", pic_false_value()); + pic_define_(pic, "*ipproto-ip*", pic_false_value(pic)); #endif #ifdef IPPROTO_TCP - pic_define_(pic, "*ipproto-tcp*", pic_int_value(IPPROTO_TCP)); + pic_define_(pic, "*ipproto-tcp*", pic_int_value(pic, IPPROTO_TCP)); #else - pic_define_(pic, "*ipproto-tcp*", pic_false_value()); + pic_define_(pic, "*ipproto-tcp*", pic_false_value(pic)); #endif #ifdef IPPROTO_UDP - pic_define_(pic, "*ipproto-udp*", pic_int_value(IPPROTO_UDP)); + pic_define_(pic, "*ipproto-udp*", pic_int_value(pic, IPPROTO_UDP)); #else - pic_define_(pic, "*ipproto-udp*", pic_false_value()); + pic_define_(pic, "*ipproto-udp*", pic_false_value(pic)); #endif #ifdef MSG_PEEK - pic_define_(pic, "*msg-peek*", pic_int_value(MSG_PEEK)); + pic_define_(pic, "*msg-peek*", pic_int_value(pic, MSG_PEEK)); #else - pic_define_(pic, "*msg-peek*", pic_false_value()); + pic_define_(pic, "*msg-peek*", pic_false_value(pic)); #endif #ifdef MSG_OOB - pic_define_(pic, "*msg-oob*", pic_int_value(MSG_OOB)); + pic_define_(pic, "*msg-oob*", pic_int_value(pic, MSG_OOB)); #else - pic_define_(pic, "*msg-oob*", pic_false_value()); + pic_define_(pic, "*msg-oob*", pic_false_value(pic)); #endif #ifdef MSG_WAITALL - pic_define_(pic, "*msg-waitall*", pic_int_value(MSG_WAITALL)); + pic_define_(pic, "*msg-waitall*", pic_int_value(pic, MSG_WAITALL)); #else - pic_define_(pic, "*msg-waitall*", pic_false_value()); + pic_define_(pic, "*msg-waitall*", pic_false_value(pic)); #endif #ifdef SHUT_RD - pic_define_(pic, "*shut-rd*", pic_int_value(SHUT_RD)); + pic_define_(pic, "*shut-rd*", pic_int_value(pic, SHUT_RD)); #else - pic_define_(pic, "*shut-rd*", pic_false_value()); + pic_define_(pic, "*shut-rd*", pic_false_value(pic)); #endif #ifdef SHUT_WR - pic_define_(pic, "*shut-wr*", pic_int_value(SHUT_WR)); + pic_define_(pic, "*shut-wr*", pic_int_value(pic, SHUT_WR)); #else - pic_define_(pic, "*shut-wr*", pic_false_value()); + pic_define_(pic, "*shut-wr*", pic_false_value(pic)); #endif #ifdef SHUT_RDWR - pic_define_(pic, "*shut-rdwr*", pic_int_value(SHUT_RDWR)); + pic_define_(pic, "*shut-rdwr*", pic_int_value(pic, SHUT_RDWR)); #else - pic_define_(pic, "*shut-rdwr*", pic_false_value()); + pic_define_(pic, "*shut-rdwr*", pic_false_value(pic)); #endif } diff --git a/contrib/60.repl/repl.c b/contrib/60.repl/repl.c index cea0ed22..e6e371de 100644 --- a/contrib/60.repl/repl.c +++ b/contrib/60.repl/repl.c @@ -9,7 +9,7 @@ pic_repl_tty_p(pic_state *pic) pic_get_args(pic, ""); - return pic_bool_value((isatty(STDIN_FILENO))); + return pic_bool_value(pic, (isatty(STDIN_FILENO))); } void diff --git a/docs/capi.rst b/docs/capi.rst index 9297989b..c427515e 100644 --- a/docs/capi.rst +++ b/docs/capi.rst @@ -28,7 +28,7 @@ If you want to create a contribution library with C, the only thing you need to pic_get_args(pic, "ff", &a, &b); - return pic_float_value(a + b); + return pic_float_value(pic, a + b); } void diff --git a/extlib/benz/README.md b/extlib/benz/README.md index 67c7a32d..71b1e62b 100644 --- a/extlib/benz/README.md +++ b/extlib/benz/README.md @@ -55,7 +55,7 @@ pic_value factorial(pic_state *pic) { pic_get_args(pic, "i", &i); - return pic_int_value(fact(i)); + return pic_int_value(pic, fact(i)); } int diff --git a/extlib/benz/blob.c b/extlib/benz/blob.c index c7cbff9f..fc464aa0 100644 --- a/extlib/benz/blob.c +++ b/extlib/benz/blob.c @@ -22,7 +22,7 @@ pic_blob_bytevector_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_blob_p(v)); + return pic_bool_value(pic, pic_blob_p(pic, v)); } static pic_value @@ -42,11 +42,11 @@ pic_blob_bytevector(pic_state *pic) for (i = 0; i < argc; ++i) { pic_assert_type(pic, argv[i], int); - if (pic_int(argv[i]) < 0 || pic_int(argv[i]) > 255) { + if (pic_int(pic, argv[i]) < 0 || pic_int(pic, argv[i]) > 255) { pic_errorf(pic, "byte out of range"); } - *data++ = (unsigned char)pic_int(argv[i]); + *data++ = (unsigned char)pic_int(pic, argv[i]); } return pic_obj_value(blob); @@ -78,7 +78,7 @@ pic_blob_bytevector_length(pic_state *pic) pic_get_args(pic, "b", &bv); - return pic_int_value(bv->len); + return pic_int_value(pic, bv->len); } static pic_value @@ -89,7 +89,7 @@ pic_blob_bytevector_u8_ref(pic_state *pic) pic_get_args(pic, "bi", &bv, &k); - return pic_int_value(bv->data[k]); + return pic_int_value(pic, bv->data[k]); } static pic_value @@ -104,7 +104,7 @@ pic_blob_bytevector_u8_set(pic_state *pic) pic_errorf(pic, "byte out of range"); bv->data[k] = (unsigned char)v; - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -128,14 +128,14 @@ pic_blob_bytevector_copy_i(pic_state *pic) while (start < end) { to->data[--at] = from->data[--end]; } - return pic_undef_value(); + return pic_undef_value(pic); } while (start < end) { to->data[at++] = from->data[start++]; } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -209,10 +209,10 @@ pic_blob_list_to_bytevector(pic_state *pic) pic_for_each (e, list, it) { pic_assert_type(pic, e, int); - if (pic_int(e) < 0 || pic_int(e) > 255) + if (pic_int(pic, e) < 0 || pic_int(pic, e) > 255) pic_errorf(pic, "byte out of range"); - *data++ = (unsigned char)pic_int(e); + *data++ = (unsigned char)pic_int(pic, e); } return pic_obj_value(blob); } @@ -233,10 +233,10 @@ pic_blob_bytevector_to_list(pic_state *pic) end = blob->len; } - list = pic_nil_value(); + list = pic_nil_value(pic); for (i = start; i < end; ++i) { - pic_push(pic, pic_int_value(blob->data[i]), list); + pic_push(pic, pic_int_value(pic, blob->data[i]), list); } return pic_reverse(pic, list); } diff --git a/extlib/benz/bool.c b/extlib/benz/bool.c index aa4a888f..cf72b27c 100644 --- a/extlib/benz/bool.c +++ b/extlib/benz/bool.c @@ -10,8 +10,8 @@ KHASH_DEFINE2(m, void *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal) static bool internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m) *h) { - pic_value localx = pic_nil_value(); - pic_value localy = pic_nil_value(); + pic_value localx = pic_nil_value(pic); + pic_value localy = pic_nil_value(pic); int cx = 0; int cy = 0; @@ -19,7 +19,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m) if (depth > 200) { pic_errorf(pic, "Stack overflow in equal\n"); } - if (pic_pair_p(x) || pic_vec_p(x)) { + if (pic_pair_p(pic, x) || pic_vec_p(pic, x)) { int ret; kh_put(m, h, pic_obj_ptr(x), &ret); if (ret != 0) { @@ -30,14 +30,14 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m) LOOP: - if (pic_eqv_p(x, y)) { + if (pic_eqv_p(pic, x, y)) { return true; } - if (pic_type(x) != pic_type(y)) { + if (pic_type(pic, x) != pic_type(pic, y)) { return false; } - switch (pic_type(x)) { + switch (pic_type(pic, x)) { case PIC_TT_ID: { struct pic_id *id1, *id2; pic_sym *s1, *s2; @@ -74,12 +74,12 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m) return false; /* Floyd's cycle-finding algorithm */ - if (pic_nil_p(localx)) { + if (pic_nil_p(pic, localx)) { localx = x; } x = pic_cdr(pic, x); cx++; - if (pic_nil_p(localy)) { + if (pic_nil_p(pic, localy)) { localy = y; } y = pic_cdr(pic, y); @@ -87,7 +87,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m) if (cx == 2) { cx = 0; localx = pic_cdr(pic, localx); - if (pic_eq_p(localx, x)) { + if (pic_eq_p(pic, localx, x)) { if (cy < 0 ) return true; /* both lists circular */ cx = INT_MIN; /* found a cycle on x */ } @@ -95,7 +95,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m) if (cy == 2) { cy = 0; localy = pic_cdr(pic, localy); - if (pic_eq_p(localy, y)) { + if (pic_eq_p(pic, localy, y)) { if (cx < 0 ) return true; /* both lists circular */ cy = INT_MIN; /* found a cycle on y */ } @@ -143,7 +143,7 @@ pic_bool_eq_p(pic_state *pic) pic_get_args(pic, "oo", &x, &y); - return pic_bool_value(pic_eq_p(x, y)); + return pic_bool_value(pic, pic_eq_p(pic, x, y)); } static pic_value @@ -153,7 +153,7 @@ pic_bool_eqv_p(pic_state *pic) pic_get_args(pic, "oo", &x, &y); - return pic_bool_value(pic_eqv_p(x, y)); + return pic_bool_value(pic, pic_eqv_p(pic, x, y)); } static pic_value @@ -163,7 +163,7 @@ pic_bool_equal_p(pic_state *pic) pic_get_args(pic, "oo", &x, &y); - return pic_bool_value(pic_equal_p(pic, x, y)); + return pic_bool_value(pic, pic_equal_p(pic, x, y)); } static pic_value @@ -173,7 +173,7 @@ pic_bool_not(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_false_p(v) ? pic_true_value() : pic_false_value(); + return pic_false_p(pic, v) ? pic_true_value(pic) : pic_false_value(pic); } static pic_value @@ -183,7 +183,7 @@ pic_bool_boolean_p(pic_state *pic) pic_get_args(pic, "o", &v); - return (pic_true_p(v) || pic_false_p(v)) ? pic_true_value() : pic_false_value(); + return (pic_true_p(pic, v) || pic_false_p(pic, v)) ? pic_true_value(pic) : pic_false_value(pic); } static pic_value @@ -195,14 +195,14 @@ pic_bool_boolean_eq_p(pic_state *pic) pic_get_args(pic, "*", &argc, &argv); for (i = 0; i < argc; ++i) { - if (! (pic_true_p(argv[i]) || pic_false_p(argv[i]))) { - return pic_false_value(); + if (! (pic_true_p(pic, argv[i]) || pic_false_p(pic, argv[i]))) { + return pic_false_value(pic); } - if (! pic_eq_p(argv[i], argv[0])) { - return pic_false_value(); + if (! pic_eq_p(pic, argv[i], argv[0])) { + return pic_false_value(pic); } } - return pic_true_value(); + return pic_true_value(pic); } void diff --git a/extlib/benz/char.c b/extlib/benz/char.c index 8db6f41a..709787fb 100644 --- a/extlib/benz/char.c +++ b/extlib/benz/char.c @@ -11,7 +11,7 @@ pic_char_char_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_char_p(v) ? pic_true_value() : pic_false_value(); + return pic_char_p(pic, v) ? pic_true_value(pic) : pic_false_value(pic); } static pic_value @@ -21,7 +21,7 @@ pic_char_char_to_integer(pic_state *pic) pic_get_args(pic, "c", &c); - return pic_int_value(c); + return pic_int_value(pic, c); } static pic_value @@ -35,7 +35,7 @@ pic_char_integer_to_char(pic_state *pic) pic_errorf(pic, "integer->char: integer out of char range: %d", i); } - return pic_char_value((char)i); + return pic_char_value(pic, (char)i); } #define DEFINE_CHAR_CMP(op, name) \ @@ -49,20 +49,20 @@ pic_char_integer_to_char(pic_state *pic) pic_get_args(pic, "cc*", &c, &d, &argc, &argv); \ \ if (! (c op d)) \ - return pic_false_value(); \ + return pic_false_value(pic); \ \ for (i = 0; i < argc; ++i) { \ c = d; \ - if (pic_char_p(argv[i])) \ - d = pic_char(argv[i]); \ + if (pic_char_p(pic, argv[i])) \ + d = pic_char(pic, argv[i]); \ else \ pic_errorf(pic, #op ": char required"); \ \ if (! (c op d)) \ - return pic_false_value(); \ + return pic_false_value(pic); \ } \ \ - return pic_true_value(); \ + return pic_true_value(pic); \ } DEFINE_CHAR_CMP(==, eq) diff --git a/extlib/benz/cont.c b/extlib/benz/cont.c index 6b54c11a..4ee65e09 100644 --- a/extlib/benz/cont.c +++ b/extlib/benz/cont.c @@ -60,7 +60,7 @@ pic_save_point(pic_state *pic, struct pic_cont *cont) cont->ip = pic->ip; cont->ptable = pic->ptable; cont->prev = pic->cc; - cont->results = pic_undef_value(); + cont->results = pic_undef_value(pic); cont->id = pic->ccnt++; pic->cc = cont; @@ -95,7 +95,7 @@ cont_call(pic_state *pic) pic_get_args(pic, "*", &argc, &argv); - id = pic_int(pic_closure_ref(pic, CV_ID)); + id = pic_int(pic, pic_closure_ref(pic, CV_ID)); /* check if continuation is alive */ for (cc = pic->cc; cc != NULL; cc = cc->prev) { @@ -124,7 +124,7 @@ pic_make_cont(pic_state *pic, struct pic_cont *cont) struct pic_proc *c; /* save the escape continuation in proc */ - c = pic_lambda(pic, cont_call, 2, pic_int_value(cont->id), pic_obj_value(pic_data_alloc(pic, &cont_type, cont))); + c = pic_lambda(pic, cont_call, 2, pic_int_value(pic, cont->id), pic_obj_value(pic_data_alloc(pic, &cont_type, cont))); return c; } @@ -214,7 +214,7 @@ pic_values(pic_state *pic, int argc, pic_value *argv) } pic->ci->retc = (int)argc; - return argc == 0 ? pic_undef_value() : pic->sp[0]; + return argc == 0 ? pic_undef_value(pic) : pic->sp[0]; } pic_value @@ -229,7 +229,7 @@ pic_values_by_list(pic_state *pic, pic_value list) } pic->ci->retc = i; - return pic_nil_p(list) ? pic_undef_value() : pic->sp[0]; + return pic_nil_p(pic, list) ? pic_undef_value(pic) : pic->sp[0]; } int diff --git a/extlib/benz/debug.c b/extlib/benz/debug.c index 106be269..6ef57678 100644 --- a/extlib/benz/debug.c +++ b/extlib/benz/debug.c @@ -35,9 +35,9 @@ pic_get_backtrace(pic_state *pic) void pic_print_backtrace(pic_state *pic, xFILE *file) { - assert(! pic_invalid_p(pic->err)); + assert(! pic_invalid_p(pic, pic->err)); - if (! pic_error_p(pic->err)) { + if (! pic_error_p(pic, pic->err)) { xfprintf(pic, file, "raise: "); pic_fwrite(pic, pic->err, file); } else { diff --git a/extlib/benz/dict.c b/extlib/benz/dict.c index 12cae194..3583d5e3 100644 --- a/extlib/benz/dict.c +++ b/extlib/benz/dict.c @@ -104,7 +104,7 @@ pic_dict_dictionary_p(pic_state *pic) pic_get_args(pic, "o", &obj); - return pic_bool_value(pic_dict_p(obj)); + return pic_bool_value(pic, pic_dict_p(pic, obj)); } static pic_value @@ -116,7 +116,7 @@ pic_dict_dictionary_ref(pic_state *pic) pic_get_args(pic, "dm", &dict, &key); if (! pic_dict_has(pic, dict, key)) { - return pic_false_value(); + return pic_false_value(pic); } return pic_cons(pic, pic_obj_value(key), pic_dict_ref(pic, dict, key)); } @@ -130,7 +130,7 @@ pic_dict_dictionary_set(pic_state *pic) pic_get_args(pic, "dmo", &dict, &key, &val); - if (pic_undef_p(val)) { + if (pic_undef_p(pic, val)) { if (pic_dict_has(pic, dict, key)) { pic_dict_del(pic, dict, key); } @@ -138,7 +138,7 @@ pic_dict_dictionary_set(pic_state *pic) else { pic_dict_set(pic, dict, key, val); } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -148,7 +148,7 @@ pic_dict_dictionary_size(pic_state *pic) pic_get_args(pic, "d", &dict); - return pic_int_value(pic_dict_size(pic, dict)); + return pic_int_value(pic, pic_dict_size(pic, dict)); } static pic_value @@ -158,7 +158,7 @@ pic_dict_dictionary_map(pic_state *pic) struct pic_dict *dict; khiter_t it; khash_t(dict) *kh; - pic_value ret = pic_nil_value(); + pic_value ret = pic_nil_value(pic); pic_get_args(pic, "ld", &proc, &dict); @@ -191,14 +191,14 @@ pic_dict_dictionary_for_each(pic_state *pic) } } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value pic_dict_dictionary_to_alist(pic_state *pic) { struct pic_dict *dict; - pic_value item, alist = pic_nil_value(); + pic_value item, alist = pic_nil_value(pic); pic_sym *sym; khiter_t it; @@ -234,7 +234,7 @@ static pic_value pic_dict_dictionary_to_plist(pic_state *pic) { struct pic_dict *dict; - pic_value plist = pic_nil_value(); + pic_value plist = pic_nil_value(pic); pic_sym *sym; khiter_t it; @@ -258,7 +258,7 @@ pic_dict_plist_to_dictionary(pic_state *pic) dict = pic_make_dict(pic); - for (e = pic_reverse(pic, plist); ! pic_nil_p(e); e = pic_cddr(pic, e)) { + 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)); } diff --git a/extlib/benz/error.c b/extlib/benz/error.c index 3a3af27e..306b69c2 100644 --- a/extlib/benz/error.c +++ b/extlib/benz/error.c @@ -43,7 +43,7 @@ pic_errorf(pic_state *pic, const char *fmt, ...) msg = pic_str_cstr(pic, err); - pic_error(pic, msg, pic_nil_value()); + pic_error(pic, msg, pic_nil_value(pic)); } pic_value @@ -58,7 +58,7 @@ pic_native_exception_handler(pic_state *pic) cont = pic_proc_ptr(pic_closure_ref(pic, 0)); - pic_call(pic, cont, 1, pic_false_value()); + pic_call(pic, cont, 1, pic_false_value(pic)); PIC_UNREACHABLE(); } @@ -202,7 +202,7 @@ pic_error_error_object_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_error_p(v)); + return pic_bool_value(pic, pic_error_p(pic, v)); } static pic_value diff --git a/extlib/benz/eval.c b/extlib/benz/eval.c index 80799d47..a87c8f75 100644 --- a/extlib/benz/eval.c +++ b/extlib/benz/eval.c @@ -11,13 +11,13 @@ optimize_beta(pic_state *pic, pic_value expr) size_t ai = pic_gc_arena_preserve(pic); pic_value functor, formals, args, tmp, val, it, defs; - if (! pic_list_p(expr)) + if (! pic_list_p(pic, expr)) return expr; - if (pic_nil_p(expr)) + if (pic_nil_p(pic, expr)) return expr; - if (pic_sym_p(pic_list_ref(pic, expr, 0))) { + if (pic_sym_p(pic, pic_list_ref(pic, expr, 0))) { pic_sym *sym = pic_sym_ptr(pic_list_ref(pic, expr, 0)); if (sym == pic->sQUOTE) { @@ -27,7 +27,7 @@ optimize_beta(pic_state *pic, pic_value expr) } } - tmp = pic_nil_value(); + tmp = pic_nil_value(pic); pic_for_each (val, expr, it) { pic_push(pic, optimize_beta(pic, val), tmp); } @@ -37,14 +37,14 @@ optimize_beta(pic_state *pic, pic_value expr) pic_gc_protect(pic, expr); functor = pic_list_ref(pic, expr, 0); - if (pic_pair_p(functor) && pic_eq_p(pic_car(pic, functor), pic_obj_value(pic->sLAMBDA))) { + if (pic_pair_p(pic, functor) && pic_eq_p(pic, pic_car(pic, functor), pic_obj_value(pic->sLAMBDA))) { formals = pic_list_ref(pic, functor, 1); - if (! pic_list_p(formals)) + if (! pic_list_p(pic, formals)) goto exit; /* TODO: support ((lambda args x) 1 2) */ args = pic_cdr(pic, expr); if (pic_length(pic, formals) != pic_length(pic, args)) goto exit; - defs = pic_nil_value(); + defs = pic_nil_value(pic); pic_for_each (val, args, it) { pic_push(pic, pic_list3(pic, pic_obj_value(pic->sDEFINE), pic_car(pic, formals), val), defs); formals = pic_cdr(pic, formals); @@ -92,10 +92,10 @@ analyzer_scope_init(pic_state *pic, analyze_scope *scope, pic_value formal, anal kh_init(a, &scope->captures); /* analyze formal */ - for (; pic_pair_p(formal); formal = pic_cdr(pic, 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); } - if (pic_nil_p(formal)) { + if (pic_nil_p(pic, formal)) { scope->rest = NULL; } else { @@ -105,7 +105,7 @@ analyzer_scope_init(pic_state *pic, analyze_scope *scope, pic_value formal, anal scope->up = up; scope->depth = up ? up->depth + 1 : 0; - scope->defer = pic_list1(pic, pic_nil_value()); + scope->defer = pic_list1(pic, pic_nil_value(pic)); } static void @@ -177,7 +177,7 @@ analyze_var(pic_state *pic, analyze_scope *scope, pic_sym *sym) } else if (depth == 0) { return pic_list2(pic, pic_obj_value(LREF), pic_obj_value(sym)); } else { - return pic_list3(pic, pic_obj_value(CREF), pic_int_value(depth), pic_obj_value(sym)); + return pic_list3(pic, pic_obj_value(CREF), pic_int_value(pic, depth), pic_obj_value(sym)); } } @@ -215,7 +215,7 @@ 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_value rest = pic_undef_value(pic); pic_vec *args, *locals, *captures; int i, j; khiter_t it; @@ -230,7 +230,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form) analyze_deferred(pic, scope); args = pic_make_vec(pic, kh_size(&scope->args)); - for (i = 0; pic_pair_p(formals); formals = pic_cdr(pic, formals), i++) { + for (i = 0; pic_pair_p(pic, formals); formals = pic_cdr(pic, formals), i++) { args->data[i] = pic_car(pic, formals); } @@ -266,7 +266,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form) static pic_value analyze_list(pic_state *pic, analyze_scope *scope, pic_value obj) { - pic_value seq = pic_nil_value(), val, it; + pic_value seq = pic_nil_value(pic), val, it; pic_for_each (val, obj, it) { pic_push(pic, analyze(pic, scope, val), seq); @@ -292,19 +292,19 @@ analyze_call(pic_state *pic, analyze_scope *scope, pic_value obj) static pic_value analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj) { - switch (pic_type(obj)) { + switch (pic_type(pic, obj)) { case PIC_TT_SYMBOL: { return analyze_var(pic, scope, pic_sym_ptr(obj)); } case PIC_TT_PAIR: { pic_value proc; - if (! pic_list_p(obj)) { + if (! pic_list_p(pic, obj)) { pic_errorf(pic, "invalid expression given: ~s", obj); } proc = pic_list_ref(pic, obj, 0); - if (pic_sym_p(proc)) { + if (pic_sym_p(pic, proc)) { pic_sym *sym = pic_sym_ptr(proc); if (sym == pic->sDEFINE) { @@ -346,7 +346,7 @@ pic_analyze(pic_state *pic, pic_value obj) { analyze_scope s, *scope = &s; - analyzer_scope_init(pic, scope, pic_nil_value(), NULL); + analyzer_scope_init(pic, scope, pic_nil_value(pic), NULL); obj = analyze(pic, scope, obj); @@ -562,7 +562,7 @@ codegen_ref(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos) pic_sym *name; int depth; - depth = pic_int(pic_list_ref(pic, obj, 1)); + depth = pic_int(pic, pic_list_ref(pic, obj, 1)); name = pic_sym_ptr(pic_list_ref(pic, obj, 2)); emit_r(pic, cxt, OP_CREF, depth, index_capture(cxt, name, depth)); emit_ret(pic, cxt, tailpos); @@ -604,7 +604,7 @@ codegen_set(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos) pic_sym *name; int depth; - depth = pic_int(pic_list_ref(pic, var, 1)); + depth = pic_int(pic, pic_list_ref(pic, var, 1)); name = pic_sym_ptr(pic_list_ref(pic, var, 2)); emit_r(pic, cxt, OP_CSET, depth, index_capture(cxt, name, depth)); emit_ret(pic, cxt, tailpos); @@ -636,7 +636,7 @@ codegen_lambda(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos /* extract arguments */ rest_opt = pic_list_ref(pic, obj, 1); - if (pic_sym_p(rest_opt)) { + if (pic_sym_p(pic, rest_opt)) { rest = pic_sym_ptr(rest_opt); } args = pic_vec_ptr(pic_list_ref(pic, obj, 2)); @@ -693,23 +693,23 @@ codegen_quote(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos) int pidx; obj = pic_list_ref(pic, obj, 1); - switch (pic_type(obj)) { + switch (pic_type(pic, obj)) { case PIC_TT_UNDEF: emit_n(pic, cxt, OP_PUSHUNDEF); break; case PIC_TT_BOOL: - emit_n(pic, cxt, (pic_true_p(obj) ? OP_PUSHTRUE : OP_PUSHFALSE)); + emit_n(pic, cxt, (pic_true_p(pic, obj) ? OP_PUSHTRUE : OP_PUSHFALSE)); break; case PIC_TT_INT: check_ints_size(pic, cxt); pidx = (int)cxt->klen++; - cxt->ints[pidx] = pic_int(obj); + cxt->ints[pidx] = pic_int(pic, obj); emit_i(pic, cxt, OP_PUSHINT, pidx); break; case PIC_TT_FLOAT: check_nums_size(pic, cxt); pidx = (int)cxt->flen++; - cxt->nums[pidx] = pic_float(obj); + cxt->nums[pidx] = pic_float(pic, obj); emit_i(pic, cxt, OP_PUSHFLOAT, pidx); break; case PIC_TT_NIL: @@ -721,7 +721,7 @@ codegen_quote(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos) case PIC_TT_CHAR: check_ints_size(pic, cxt); pidx = (int)cxt->klen++; - cxt->ints[pidx] = pic_char(obj); + cxt->ints[pidx] = pic_char(pic, obj); emit_i(pic, cxt, OP_PUSHCHAR, pidx); break; default: diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c index 558bcf82..d91f6d31 100644 --- a/extlib/benz/gc.c +++ b/extlib/benz/gc.c @@ -143,7 +143,7 @@ gc_protect(pic_state *pic, struct pic_object *obj) pic_value pic_gc_protect(pic_state *pic, pic_value v) { - if (! pic_obj_p(v)) + if (! pic_obj_p(pic, v)) return v; gc_protect(pic, pic_obj_ptr(v)); @@ -258,7 +258,7 @@ static void gc_mark_object(pic_state *, struct pic_object *); static void gc_mark(pic_state *pic, pic_value v) { - if (! pic_obj_p(v)) + if (! pic_obj_p(pic, v)) return; gc_mark_object(pic, pic_obj_ptr(v)); @@ -279,7 +279,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) switch (obj->u.basic.tt) { case PIC_TT_PAIR: { gc_mark(pic, obj->u.pair.car); - if (pic_obj_p(obj->u.pair.cdr)) { + if (pic_obj_p(pic, obj->u.pair.cdr)) { LOOP(pic_obj_ptr(obj->u.pair.cdr)); } break; @@ -369,7 +369,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) } case PIC_TT_RECORD: { gc_mark(pic, obj->u.rec.type); - if (pic_obj_p(obj->u.rec.datum)) { + if (pic_obj_p(pic, obj->u.rec.datum)) { LOOP(pic_obj_ptr(obj->u.rec.datum)); } break; @@ -515,7 +515,7 @@ gc_mark_phase(pic_state *pic) key = kh_key(h, it); val = kh_val(h, it); if (key->u.basic.gc_mark == PIC_GC_MARK) { - if (pic_obj_p(val) && pic_obj_ptr(val)->u.basic.gc_mark == PIC_GC_UNMARK) { + if (pic_obj_p(pic, val) && pic_obj_ptr(val)->u.basic.gc_mark == PIC_GC_UNMARK) { gc_mark(pic, val); ++j; } diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index b9931736..bdd3649b 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -38,12 +38,12 @@ typedef struct pic_state pic_state; #include "picrin/type.h" -typedef void *(*pic_allocf)(void *, void *, size_t); +typedef void *(*pic_allocf)(void *userdata, void *ptr, size_t n); -pic_state *pic_open(pic_allocf, void *); +pic_state *pic_open(pic_allocf f, void *userdata); void pic_close(pic_state *); -int pic_get_args(pic_state *, const char *, ...); +int pic_get_args(pic_state *, const char *fmt, ...); void *pic_malloc(pic_state *, size_t); void *pic_realloc(pic_state *, void *, size_t); @@ -58,83 +58,84 @@ size_t pic_gc_arena_preserve(pic_state *); void pic_gc_arena_restore(pic_state *, size_t); void pic_gc(pic_state *); -void pic_add_feature(pic_state *, const char *); +void pic_add_feature(pic_state *, const char *feature); -void pic_defun(pic_state *, const char *, pic_func_t); -void pic_defvar(pic_state *, const char *, pic_value, struct pic_proc *); +void pic_defun(pic_state *, const char *name, pic_func_t f); +void pic_defvar(pic_state *, const char *name, pic_value v, struct pic_proc *conv); -void pic_define(pic_state *, const char *, const char *, pic_value); -pic_value pic_ref(pic_state *, const char *, const char *); -void pic_set(pic_state *, const char *, const char *, pic_value); -pic_value pic_closure_ref(pic_state *, int); -void pic_closure_set(pic_state *, int, pic_value); -pic_value pic_funcall(pic_state *pic, const char *, const char *, int, ...); +void pic_define(pic_state *, const char *lib, const char *name, pic_value v); +pic_value pic_ref(pic_state *, const char *lib, const char *name); +void pic_set(pic_state *, const char *lib, const char *name, pic_value v); +pic_value pic_closure_ref(pic_state *, int i); +void pic_closure_set(pic_state *, int i, pic_value v); +pic_value pic_funcall(pic_state *, const char *lib, const char *name, int n, ...); -void pic_make_library(pic_state *, const char *); -void pic_in_library(pic_state *, const char *); -bool pic_find_library(pic_state *, const char *); +void pic_make_library(pic_state *, const char *lib); +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 *); -void pic_export(pic_state *, pic_sym *); +void pic_import(pic_state *, const char *lib); +void pic_export(pic_state *, pic_sym *sym); -PIC_NORETURN void pic_panic(pic_state *, const char *); -PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); +PIC_NORETURN void pic_panic(pic_state *, const char *msg); +PIC_NORETURN void pic_errorf(pic_state *, const char *fmt, ...); -struct pic_proc *pic_lambda(pic_state *, pic_func_t, int, ...); -struct pic_proc *pic_vlambda(pic_state *, pic_func_t, int, va_list); -pic_value pic_call(pic_state *, struct pic_proc *, int, ...); -pic_value pic_vcall(pic_state *, struct pic_proc *, int, va_list); -pic_value pic_apply(pic_state *, struct pic_proc *, int, pic_value *); -pic_value pic_applyk(pic_state *, struct pic_proc *, int, pic_value *); +struct pic_proc *pic_lambda(pic_state *, pic_func_t f, int n, ...); +struct pic_proc *pic_vlambda(pic_state *, pic_func_t f, int n, va_list); +pic_value pic_call(pic_state *, struct pic_proc *proc, int, ...); +pic_value pic_vcall(pic_state *, struct pic_proc *proc, int, va_list); +pic_value pic_apply(pic_state *, struct pic_proc *proc, int n, pic_value *argv); +pic_value pic_applyk(pic_state *, struct pic_proc *proc, int n, pic_value *argv); -int pic_int(pic_value); -double pic_float(pic_value); -char pic_char(pic_value); -bool pic_bool(pic_value); +int pic_int(pic_state *, pic_value); +double pic_float(pic_state *, pic_value); +char pic_char(pic_state *, pic_value); +bool pic_bool(pic_state *, pic_value); /* const char *pic_str(pic_state *, pic_value); */ /* unsigned char *pic_blob(pic_state *, pic_value, int *len); */ /* void *pic_data(pic_state *, pic_value); */ -pic_value pic_undef_value(); -pic_value pic_int_value(int); -pic_value pic_float_value(double); -pic_value pic_char_value(char c); -pic_value pic_true_value(); -pic_value pic_false_value(); -pic_value pic_bool_value(bool); +pic_value pic_undef_value(pic_state *); +pic_value pic_int_value(pic_state *, int); +pic_value pic_float_value(pic_state *, double); +pic_value pic_char_value(pic_state *, char); +pic_value pic_true_value(pic_state *); +pic_value pic_false_value(pic_state *); +pic_value pic_bool_value(pic_state *, bool); -#define pic_undef_p(v) (pic_vtype(v) == PIC_VTYPE_UNDEF) -#define pic_int_p(v) (pic_vtype(v) == PIC_VTYPE_INT) -#define pic_float_p(v) (pic_vtype(v) == PIC_VTYPE_FLOAT) -#define pic_char_p(v) (pic_vtype(v) == PIC_VTYPE_CHAR) -#define pic_true_p(v) (pic_vtype(v) == PIC_VTYPE_TRUE) -#define pic_false_p(v) (pic_vtype(v) == PIC_VTYPE_FALSE) -#define pic_str_p(v) (pic_type(v) == PIC_TT_STRING) -#define pic_blob_p(v) (pic_type(v) == PIC_TT_BLOB) -#define pic_proc_p(o) (pic_type(o) == PIC_TT_PROC) -#define pic_data_p(o) (pic_type(o) == PIC_TT_DATA) -#define pic_nil_p(v) (pic_vtype(v) == PIC_VTYPE_NIL) -#define pic_pair_p(v) (pic_type(v) == PIC_TT_PAIR) -#define pic_vec_p(v) (pic_type(v) == PIC_TT_VECTOR) -#define pic_dict_p(v) (pic_type(v) == PIC_TT_DICT) -#define pic_weak_p(v) (pic_type(v) == PIC_TT_WEAK) -#define pic_sym_p(v) (pic_type(v) == PIC_TT_SYMBOL) +#define pic_undef_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_UNDEF) +#define pic_int_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_INT) +#define pic_float_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_FLOAT) +#define pic_char_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_CHAR) +#define pic_true_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_TRUE) +#define pic_false_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_FALSE) +#define pic_str_p(pic,v) (pic_type(pic,v) == PIC_TT_STRING) +#define pic_blob_p(pic,v) (pic_type(pic,v) == PIC_TT_BLOB) +#define pic_proc_p(pic,v) (pic_type(pic,v) == PIC_TT_PROC) +#define pic_data_p(pic,v) (pic_type(pic,v) == PIC_TT_DATA) +#define pic_nil_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_NIL) +#define pic_pair_p(pic,v) (pic_type(pic,v) == PIC_TT_PAIR) +#define pic_vec_p(pic,v) (pic_type(pic,v) == PIC_TT_VECTOR) +#define pic_dict_p(pic,v) (pic_type(pic,v) == PIC_TT_DICT) +#define pic_weak_p(pic,v) (pic_type(pic,v) == PIC_TT_WEAK) +#define pic_port_p(pic, v) (pic_type(pic, v) == PIC_TT_PORT) +#define pic_sym_p(pic,v) (pic_type(pic,v) == PIC_TT_SYMBOL) -enum pic_tt pic_type(pic_value); -const char *pic_type_repr(enum pic_tt); +enum pic_tt pic_type(pic_state *, pic_value); +const char *pic_type_repr(pic_state *, enum pic_tt); -bool pic_eq_p(pic_value, pic_value); -bool pic_eqv_p(pic_value, pic_value); +bool pic_eq_p(pic_state *, pic_value, pic_value); +bool pic_eqv_p(pic_state *, pic_value, pic_value); bool pic_equal_p(pic_state *, pic_value, pic_value); /* list */ -pic_value pic_nil_value(); +pic_value pic_nil_value(pic_state *); pic_value pic_cons(pic_state *, pic_value, pic_value); PIC_INLINE pic_value pic_car(pic_state *, pic_value); PIC_INLINE pic_value pic_cdr(pic_state *, pic_value); void pic_set_car(pic_state *, pic_value, pic_value); void pic_set_cdr(pic_state *, pic_value, pic_value); -bool pic_list_p(pic_value); +bool pic_list_p(pic_state *, pic_value); pic_value pic_list(pic_state *, int n, ...); pic_value pic_vlist(pic_state *, int n, va_list); pic_value pic_list_ref(pic_state *, pic_value, int); @@ -171,7 +172,7 @@ pic_sym *pic_intern(pic_state *, struct pic_string *); const char *pic_symbol_name(pic_state *, pic_sym *); /* string */ -int pic_str_len(struct pic_string *); +int pic_str_len(pic_state *, struct pic_string *); char pic_str_ref(pic_state *, struct pic_string *, int); struct pic_string *pic_str_cat(pic_state *, struct pic_string *, struct pic_string *); struct pic_string *pic_str_sub(pic_state *, struct pic_string *, int, int); @@ -199,6 +200,11 @@ int pic_str_hash(pic_state *, struct pic_string *); void *pic_default_allocf(void *, void *, size_t); +#define pic_assert_type(pic, v, type) \ + if (! pic_##type##_p(pic, v)) { \ + pic_errorf(pic, "expected " #type ", but got ~s", v); \ + } + struct pic_object *pic_obj_alloc(pic_state *, size_t, enum pic_tt); #define pic_void(exec) \ diff --git a/extlib/benz/include/picrin/data.h b/extlib/benz/include/picrin/data.h index a7f03580..fdd88008 100644 --- a/extlib/benz/include/picrin/data.h +++ b/extlib/benz/include/picrin/data.h @@ -23,8 +23,8 @@ struct pic_data { #define pic_data_ptr(o) ((struct pic_data *)pic_ptr(o)) -PIC_INLINE bool pic_data_type_p(const pic_value obj, const pic_data_type *type) { - return pic_data_p(obj) && pic_data_ptr(obj)->type == type; +PIC_INLINE bool pic_data_type_p(pic_state *pic, const pic_value obj, const pic_data_type *type) { + return pic_data_p(pic, obj) && pic_data_ptr(obj)->type == type; } struct pic_data *pic_data_alloc(pic_state *, const pic_data_type *, void *); diff --git a/extlib/benz/include/picrin/error.h b/extlib/benz/include/picrin/error.h index 36e35409..235a9d87 100644 --- a/extlib/benz/include/picrin/error.h +++ b/extlib/benz/include/picrin/error.h @@ -17,7 +17,7 @@ struct pic_error { struct pic_string *stack; }; -#define pic_error_p(v) (pic_type(v) == PIC_TT_ERROR) +#define pic_error_p(pic, v) (pic_type(pic, v) == PIC_TT_ERROR) #define pic_error_ptr(v) ((struct pic_error *)pic_ptr(v)) struct pic_error *pic_make_error(pic_state *, pic_sym *, const char *, pic_value); diff --git a/extlib/benz/include/picrin/macro.h b/extlib/benz/include/picrin/macro.h index 0d4c6a40..a8fab6ea 100644 --- a/extlib/benz/include/picrin/macro.h +++ b/extlib/benz/include/picrin/macro.h @@ -18,7 +18,7 @@ struct pic_env { struct pic_string *lib; }; -#define pic_env_p(v) (pic_type(v) == PIC_TT_ENV) +#define pic_env_p(pic, v) (pic_type(pic, v) == PIC_TT_ENV) #define pic_env_ptr(v) ((struct pic_env *)pic_ptr(v)) struct pic_env *pic_make_topenv(pic_state *, struct pic_string *); diff --git a/extlib/benz/include/picrin/pair.h b/extlib/benz/include/picrin/pair.h index ff6538ed..ddd5a706 100644 --- a/extlib/benz/include/picrin/pair.h +++ b/extlib/benz/include/picrin/pair.h @@ -22,7 +22,7 @@ pic_car(pic_state *pic, pic_value obj) { struct pic_pair *pair; - if (! pic_pair_p(obj)) { + if (! pic_pair_p(pic, obj)) { pic_errorf(pic, "car: pair required, but got ~s", obj); } pair = pic_pair_ptr(obj); @@ -35,7 +35,7 @@ pic_cdr(pic_state *pic, pic_value obj) { struct pic_pair *pair; - if (! pic_pair_p(obj)) { + if (! pic_pair_p(pic, obj)) { pic_errorf(pic, "cdr: pair required, but got ~s", obj); } pair = pic_pair_ptr(obj); @@ -53,8 +53,8 @@ pic_value pic_list7(pic_state *, pic_value, pic_value, pic_value, pic_value, pic pic_value pic_list_by_array(pic_state *, int, pic_value *); pic_value pic_make_list(pic_state *, int, pic_value); -#define pic_for_each(var, list, it) \ - for (it = (list); ! pic_nil_p(it); it = pic_cdr(pic, it)) \ +#define pic_for_each(var, list, it) \ + for (it = (list); ! pic_nil_p(pic, it); it = pic_cdr(pic, it)) \ if ((var = pic_car(pic, it)), true) #define pic_push(pic, item, place) (place = pic_cons(pic, item, place)) diff --git a/extlib/benz/include/picrin/port.h b/extlib/benz/include/picrin/port.h index c806ba8e..22674b33 100644 --- a/extlib/benz/include/picrin/port.h +++ b/extlib/benz/include/picrin/port.h @@ -23,7 +23,6 @@ struct pic_port { int flags; }; -#define pic_port_p(v) (pic_type(v) == PIC_TT_PORT) #define pic_port_ptr(v) ((struct pic_port *)pic_ptr(v)) pic_value pic_eof_object(); diff --git a/extlib/benz/include/picrin/proc.h b/extlib/benz/include/picrin/proc.h index 36baeba1..b536868e 100644 --- a/extlib/benz/include/picrin/proc.h +++ b/extlib/benz/include/picrin/proc.h @@ -41,7 +41,7 @@ struct pic_proc { #define pic_proc_ptr(o) ((struct pic_proc *)pic_ptr(o)) -#define pic_context_p(o) (pic_type(o) == PIC_TT_CXT) +#define pic_context_p(o) (pic_type(pic, o) == PIC_TT_CXT) #define pic_context_ptr(o) ((struct pic_context *)pic_ptr(o)) struct pic_proc *pic_make_proc(pic_state *, pic_func_t, int, pic_value *); diff --git a/extlib/benz/include/picrin/record.h b/extlib/benz/include/picrin/record.h index 2ccf2669..d45cef27 100644 --- a/extlib/benz/include/picrin/record.h +++ b/extlib/benz/include/picrin/record.h @@ -15,7 +15,7 @@ struct pic_record { pic_value datum; }; -#define pic_rec_p(v) (pic_type(v) == PIC_TT_RECORD) +#define pic_rec_p(pic, v) (pic_type(pic, v) == PIC_TT_RECORD) #define pic_rec_ptr(v) ((struct pic_record *)pic_ptr(v)) struct pic_record *pic_make_rec(pic_state *, pic_value, pic_value); diff --git a/extlib/benz/include/picrin/symbol.h b/extlib/benz/include/picrin/symbol.h index 3c905cd9..0d1ff11c 100644 --- a/extlib/benz/include/picrin/symbol.h +++ b/extlib/benz/include/picrin/symbol.h @@ -25,7 +25,7 @@ struct pic_id { #define pic_sym_ptr(v) ((pic_sym *)pic_ptr(v)) -#define pic_id_p(v) (pic_type(v) == PIC_TT_ID || pic_type(v) == PIC_TT_SYMBOL) +#define pic_id_p(pic, v) (pic_type(pic, v) == PIC_TT_ID || pic_type(pic, v) == PIC_TT_SYMBOL) #define pic_id_ptr(v) ((pic_id *)pic_ptr(v)) pic_id *pic_make_identifier(pic_state *, pic_id *, struct pic_env *); diff --git a/extlib/benz/include/picrin/type.h b/extlib/benz/include/picrin/type.h index 1e93c372..5e6f92d6 100644 --- a/extlib/benz/include/picrin/type.h +++ b/extlib/benz/include/picrin/type.h @@ -45,13 +45,13 @@ typedef uint64_t pic_value; #define pic_init_value(v,vtype) (v = (0xfff0000000000000ul | ((uint64_t)(vtype) << 48))) static inline enum pic_vtype -pic_vtype(pic_value v) +pic_vtype(pic_state PIC_UNUSED(*pic), pic_value v) { return 0xfff0 >= (v >> 48) ? PIC_VTYPE_FLOAT : ((v >> 48) & 0xf); } static inline double -pic_float(pic_value v) +pic_float(pic_state PIC_UNUSED(*pic), pic_value v) { union { double f; uint64_t i; } u; u.i = v; @@ -59,7 +59,7 @@ pic_float(pic_value v) } static inline int -pic_int(pic_value v) +pic_int(pic_state PIC_UNUSED(*pic), pic_value v) { union { int i; unsigned u; } u; u.u = v & 0xfffffffful; @@ -67,7 +67,7 @@ pic_int(pic_value v) } static inline char -pic_char(pic_value v) +pic_char(pic_state PIC_UNUSED(*pic), pic_value v) { return v & 0xfffffffful; } @@ -85,23 +85,23 @@ typedef struct { } pic_value; #define pic_ptr(v) ((v).u.data) -#define pic_vtype(v) ((v).type) +#define pic_vtype(pic,v) ((v).type) #define pic_init_value(v,vtype) ((v).type = (vtype), (v).u.data = NULL) PIC_INLINE double -pic_float(pic_value v) +pic_float(pic_state PIC_UNUSED(*pic), pic_value v) { return v.u.f; } PIC_INLINE int -pic_int(pic_value v) +pic_int(pic_state PIC_UNUSED(*pic), pic_value v) { return v.u.i; } PIC_INLINE char -pic_char(pic_value v) +pic_char(pic_state PIC_UNUSED(*pic), pic_value v) { return v.u.c; } @@ -163,18 +163,13 @@ typedef struct pic_id pic_id; typedef struct pic_pair pic_pair; typedef struct pic_vector pic_vec; -#define pic_obj_p(v) (pic_vtype(v) == PIC_VTYPE_HEAP) +#define pic_obj_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_HEAP) #define pic_obj_ptr(v) ((struct pic_object *)pic_ptr(v)) -#define pic_invalid_p(v) (pic_vtype(v) == PIC_VTYPE_INVALID) -#define pic_eof_p(v) (pic_vtype(v) == PIC_VTYPE_EOF) +#define pic_invalid_p(pic, v) (pic_vtype(pic, v) == PIC_VTYPE_INVALID) +#define pic_eof_p(pic, v) (pic_vtype(pic, v) == PIC_VTYPE_EOF) -#define pic_test(v) (! pic_false_p(v)) - -#define pic_assert_type(pic, v, type) \ - if (! pic_##type##_p(v)) { \ - pic_errorf(pic, "expected " #type ", but got ~s", v); \ - } +#define pic_test(pic, v) (! pic_false_p(pic, v)) PIC_INLINE bool pic_valid_int(double v) @@ -186,9 +181,9 @@ PIC_INLINE pic_value pic_invalid_value(); PIC_INLINE pic_value pic_obj_value(void *); PIC_INLINE enum pic_tt -pic_type(pic_value v) +pic_type(pic_state PIC_UNUSED(*pic), pic_value v) { - switch (pic_vtype(v)) { + switch (pic_vtype(pic, v)) { case PIC_VTYPE_NIL: return PIC_TT_NIL; case PIC_VTYPE_TRUE: @@ -215,7 +210,7 @@ pic_type(pic_value v) } PIC_INLINE const char * -pic_type_repr(enum pic_tt tt) +pic_type_repr(pic_state PIC_UNUSED(*pic), enum pic_tt tt) { switch (tt) { case PIC_TT_NIL: @@ -271,7 +266,7 @@ pic_type_repr(enum pic_tt tt) } PIC_INLINE pic_value -pic_nil_value() +pic_nil_value(pic_state PIC_UNUSED(*pic)) { pic_value v; @@ -280,7 +275,7 @@ pic_nil_value() } PIC_INLINE pic_value -pic_true_value() +pic_true_value(pic_state PIC_UNUSED(*pic)) { pic_value v; @@ -289,7 +284,7 @@ pic_true_value() } PIC_INLINE pic_value -pic_false_value() +pic_false_value(pic_state PIC_UNUSED(*pic)) { pic_value v; @@ -298,7 +293,7 @@ pic_false_value() } PIC_INLINE pic_value -pic_bool_value(bool b) +pic_bool_value(pic_state PIC_UNUSED(*pic), bool b) { pic_value v; @@ -319,7 +314,7 @@ pic_obj_value(void *ptr) } PIC_INLINE pic_value -pic_float_value(double f) +pic_float_value(pic_state PIC_UNUSED(*pic), double f) { union { double f; uint64_t i; } u; @@ -332,7 +327,7 @@ pic_float_value(double f) } PIC_INLINE pic_value -pic_int_value(int i) +pic_int_value(pic_state PIC_UNUSED(*pic), int i) { union { int i; unsigned u; } u; pic_value v; @@ -345,7 +340,7 @@ pic_int_value(int i) } PIC_INLINE pic_value -pic_char_value(char c) +pic_char_value(pic_state PIC_UNUSED(*pic), char c) { pic_value v; @@ -367,7 +362,7 @@ pic_obj_value(void *ptr) } PIC_INLINE pic_value -pic_float_value(double f) +pic_float_value(pic_state PIC_UNUSED(*pic), double f) { pic_value v; @@ -377,7 +372,7 @@ pic_float_value(double f) } PIC_INLINE pic_value -pic_int_value(int i) +pic_int_value(pic_state PIC_UNUSED(*pic), int i) { pic_value v; @@ -387,7 +382,7 @@ pic_int_value(int i) } PIC_INLINE pic_value -pic_char_value(char c) +pic_char_value(pic_state PIC_UNUSED(*pic), char c) { pic_value v; @@ -399,7 +394,7 @@ pic_char_value(char c) #endif PIC_INLINE pic_value -pic_undef_value() +pic_undef_value(pic_state PIC_UNUSED(*pic)) { pic_value v; @@ -419,13 +414,13 @@ pic_invalid_value() #if PIC_NAN_BOXING PIC_INLINE bool -pic_eq_p(pic_value x, pic_value y) +pic_eq_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y) { return x == y; } PIC_INLINE bool -pic_eqv_p(pic_value x, pic_value y) +pic_eqv_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y) { return x == y; } @@ -433,36 +428,36 @@ pic_eqv_p(pic_value x, pic_value y) #else PIC_INLINE bool -pic_eq_p(pic_value x, pic_value y) +pic_eq_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y) { - if (pic_type(x) != pic_type(y)) + if (pic_type(pic, x) != pic_type(pic, y)) return false; - switch (pic_type(x)) { + switch (pic_type(pic, x)) { case PIC_TT_NIL: return true; case PIC_TT_BOOL: - return pic_vtype(x) == pic_vtype(y); + return pic_vtype(pic, x) == pic_vtype(pic, y); default: return pic_ptr(x) == pic_ptr(y); } } PIC_INLINE bool -pic_eqv_p(pic_value x, pic_value y) +pic_eqv_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y) { - if (pic_type(x) != pic_type(y)) + if (pic_type(pic, x) != pic_type(pic, y)) return false; - switch (pic_type(x)) { + switch (pic_type(pic, x)) { case PIC_TT_NIL: return true; case PIC_TT_BOOL: - return pic_vtype(x) == pic_vtype(y); + return pic_vtype(pic, x) == pic_vtype(pic, y); case PIC_TT_FLOAT: - return pic_float(x) == pic_float(y); + return pic_float(pic, x) == pic_float(pic, y); case PIC_TT_INT: - return pic_int(x) == pic_int(y); + return pic_int(pic, x) == pic_int(pic, y); default: return pic_ptr(x) == pic_ptr(y); } diff --git a/extlib/benz/lib.c b/extlib/benz/lib.c index ffccffd0..d47051f5 100644 --- a/extlib/benz/lib.c +++ b/extlib/benz/lib.c @@ -137,7 +137,7 @@ pic_lib_make_library(pic_state *pic) pic_make_library(pic, lib); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -147,7 +147,7 @@ pic_lib_find_library(pic_state *pic) pic_get_args(pic, "z", &lib); - return pic_bool_value(pic_find_library(pic, lib)); + return pic_bool_value(pic, pic_find_library(pic, lib)); } static pic_value @@ -164,7 +164,7 @@ pic_lib_current_library(pic_state *pic) else { pic_in_library(pic, lib); - return pic_undef_value(); + return pic_undef_value(pic); } } @@ -195,7 +195,7 @@ pic_lib_library_import(pic_state *pic) pic_put_identifier(pic, (pic_id *)alias, uid, pic->lib->env); } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -211,14 +211,14 @@ pic_lib_library_export(pic_state *pic) pic_dict_set(pic, pic->lib->exports, alias, pic_obj_value(name)); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value pic_lib_library_exports(pic_state *pic) { const char *lib; - pic_value exports = pic_nil_value(); + pic_value exports = pic_nil_value(pic); pic_sym *sym; khiter_t it; struct pic_lib *libp; diff --git a/extlib/benz/load.c b/extlib/benz/load.c index f58ce1be..f1a8f26c 100644 --- a/extlib/benz/load.c +++ b/extlib/benz/load.c @@ -10,7 +10,7 @@ pic_load(pic_state *pic, struct pic_port *port) pic_value form; size_t ai = pic_gc_arena_preserve(pic); - while (! pic_eof_p(form = pic_read(pic, port))) { + while (! pic_eof_p(pic, form = pic_read(pic, port))) { pic_eval(pic, form, pic_current_library(pic)); pic_gc_arena_restore(pic, ai); diff --git a/extlib/benz/macro.c b/extlib/benz/macro.c index 50a6b9ac..176c39bf 100644 --- a/extlib/benz/macro.c +++ b/extlib/benz/macro.c @@ -41,7 +41,7 @@ pic_add_identifier(pic_state *pic, pic_id *id, struct pic_env *env) name = pic_identifier_name(pic, id); - if (env->up == NULL && pic_sym_p(pic_obj_value(id))) { /* toplevel & public */ + if (env->up == NULL && pic_sym_p(pic, pic_obj_value(id))) { /* toplevel & public */ str = pic_format(pic, "%s/%s", pic_str_cstr(pic, env->lib), name); } else { str = pic_format(pic, ".%s.%d", name, pic->ucnt++); @@ -96,7 +96,7 @@ pic_find_identifier(pic_state *pic, pic_id *id, struct pic_env *env) pic_sym *uid; while ((uid = search(pic, id, env)) == NULL) { - if (pic_sym_p(pic_obj_value(id))) { + if (pic_sym_p(pic, pic_obj_value(id))) { break; } env = id->u.id.env; /* do not overwrite id first */ @@ -172,7 +172,7 @@ expand_list(pic_state *pic, pic_value obj, struct pic_env *env, pic_value deferr size_t ai = pic_gc_arena_preserve(pic); pic_value x, head, tail; - if (pic_pair_p(obj)) { + if (pic_pair_p(pic, obj)) { head = expand(pic, pic_car(pic, obj), env, deferred); tail = expand_list(pic, pic_cdr(pic, obj), env, deferred); x = pic_cons(pic, head, tail); @@ -223,14 +223,14 @@ expand_lambda(pic_state *pic, pic_value expr, struct pic_env *env) in = pic_make_env(pic, env); - for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) { + for (a = pic_cadr(pic, expr); pic_pair_p(pic, a); a = pic_cdr(pic, a)) { pic_add_identifier(pic, pic_id_ptr(pic_car(pic, a)), in); } - if (pic_id_p(a)) { + if (pic_id_p(pic, a)) { pic_add_identifier(pic, pic_id_ptr(a), in); } - deferred = pic_list1(pic, pic_nil_value()); + deferred = pic_list1(pic, pic_nil_value(pic)); formal = expand_list(pic, pic_list_ref(pic, expr, 1), in, deferred); body = expand(pic, pic_list_ref(pic, expr, 2), in, deferred); @@ -272,19 +272,19 @@ expand_defmacro(pic_state *pic, pic_value expr, struct pic_env *env) } val = pic_call(pic, pic_compile(pic, pic_expand(pic, pic_list_ref(pic, expr, 2), env)), 0); - if (! pic_proc_p(val)) { + if (! pic_proc_p(pic, val)) { pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", pic_identifier_name(pic, id)); } define_macro(pic, uid, pic_proc_ptr(val)); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value deferred) { - switch (pic_type(expr)) { + switch (pic_type(pic, expr)) { case PIC_TT_ID: case PIC_TT_SYMBOL: { return expand_var(pic, pic_id_ptr(expr), env, deferred); @@ -292,11 +292,11 @@ expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value defer case PIC_TT_PAIR: { struct pic_proc *mac; - if (! pic_list_p(expr)) { + if (! pic_list_p(pic, expr)) { pic_errorf(pic, "cannot expand improper list: ~s", expr); } - if (pic_id_p(pic_car(pic, expr))) { + if (pic_id_p(pic, pic_car(pic, expr))) { pic_sym *functor; functor = pic_find_identifier(pic, pic_id_ptr(pic_car(pic, expr)), env); @@ -349,7 +349,7 @@ pic_expand(pic_state *pic, pic_value expr, struct pic_env *env) puts(""); #endif - deferred = pic_list1(pic, pic_nil_value()); + deferred = pic_list1(pic, pic_nil_value(pic)); v = expand(pic, expr, env, deferred); diff --git a/extlib/benz/number.c b/extlib/benz/number.c index 32f86608..580e481e 100644 --- a/extlib/benz/number.c +++ b/extlib/benz/number.c @@ -11,7 +11,7 @@ pic_number_number_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_float_p(v) || pic_int_p(v)); + return pic_bool_value(pic, pic_float_p(pic, v) || pic_int_p(pic, v)); } static pic_value @@ -21,7 +21,7 @@ pic_number_exact_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_int_p(v)); + return pic_bool_value(pic, pic_int_p(pic, v)); } static pic_value @@ -31,7 +31,7 @@ pic_number_inexact_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_float_p(v)); + return pic_bool_value(pic, pic_float_p(pic, v)); } static pic_value @@ -41,7 +41,7 @@ pic_number_inexact(pic_state *pic) pic_get_args(pic, "f", &f); - return pic_float_value(f); + return pic_float_value(pic, f); } static pic_value @@ -51,7 +51,7 @@ pic_number_exact(pic_state *pic) pic_get_args(pic, "f", &f); - return pic_int_value((int)f); + return pic_int_value(pic, (int)f); } #define pic_define_aop(name, op, guard) \ @@ -60,17 +60,17 @@ pic_number_exact(pic_state *pic) { \ PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); \ double f; \ - if (pic_int_p(a) && pic_int_p(b)) { \ - f = (double)pic_int(a) op (double)pic_int(b); \ + if (pic_int_p(pic, a) && pic_int_p(pic, b)) { \ + f = (double)pic_int(pic, a) op (double)pic_int(pic, b); \ return (INT_MIN <= f && f <= INT_MAX && guard) \ - ? pic_int_value((int)f) \ - : pic_float_value(f); \ - } else if (pic_float_p(a) && pic_float_p(b)) { \ - return pic_float_value(pic_float(a) op pic_float(b)); \ - } else if (pic_int_p(a) && pic_float_p(b)) { \ - return pic_float_value(pic_int(a) op pic_float(b)); \ - } else if (pic_float_p(a) && pic_int_p(b)) { \ - return pic_float_value(pic_float(a) op pic_int(b)); \ + ? pic_int_value(pic, (int)f) \ + : pic_float_value(pic, f); \ + } else if (pic_float_p(pic, a) && pic_float_p(pic, b)) { \ + return pic_float_value(pic, pic_float(pic, a) op pic_float(pic, b)); \ + } else if (pic_int_p(pic, a) && pic_float_p(pic, b)) { \ + return pic_float_value(pic, pic_int(pic, a) op pic_float(pic, b)); \ + } else if (pic_float_p(pic, a) && pic_int_p(pic, b)) { \ + return pic_float_value(pic, pic_float(pic, a) op pic_int(pic, b)); \ } else { \ pic_errorf(pic, #name ": non-number operand given"); \ } \ @@ -87,14 +87,14 @@ pic_define_aop(pic_div, /, f == (int)f) name(pic_state *pic, pic_value a, pic_value b) \ { \ PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); \ - if (pic_int_p(a) && pic_int_p(b)) { \ - return pic_int(a) op pic_int(b); \ - } else if (pic_float_p(a) && pic_float_p(b)) { \ - return pic_float(a) op pic_float(b); \ - } else if (pic_int_p(a) && pic_float_p(b)) { \ - return pic_int(a) op pic_float(b); \ - } else if (pic_float_p(a) && pic_int_p(b)) { \ - return pic_float(a) op pic_int(b); \ + if (pic_int_p(pic, a) && pic_int_p(pic, b)) { \ + return pic_int(pic, a) op pic_int(pic, b); \ + } else if (pic_float_p(pic, a) && pic_float_p(pic, b)) { \ + return pic_float(pic, a) op pic_float(pic, b); \ + } else if (pic_int_p(pic, a) && pic_float_p(pic, b)) { \ + return pic_int(pic, a) op pic_float(pic, b); \ + } else if (pic_float_p(pic, a) && pic_int_p(pic, b)) { \ + return pic_float(pic, a) op pic_int(pic, b); \ } else { \ pic_errorf(pic, #name ": non-number operand given"); \ } \ @@ -117,15 +117,15 @@ pic_define_cmp(pic_ge, >=) pic_get_args(pic, "*", &argc, &argv); \ \ if (argc < 2) { \ - return pic_true_value(); \ + return pic_true_value(pic); \ } \ \ for (i = 1; i < argc; ++i) { \ if (! pic_##op(pic, argv[i - 1], argv[i])) { \ - return pic_false_value(); \ + return pic_false_value(pic); \ } \ } \ - return pic_true_value(); \ + return pic_true_value(pic); \ } DEFINE_CMP(eq) @@ -158,15 +158,15 @@ DEFINE_CMP(ge) } DEFINE_AOP(add, argv[0], do { - return pic_int_value(0); + return pic_int_value(pic, 0); } while (0)) DEFINE_AOP(mul, argv[0], do { - return pic_int_value(1); + return pic_int_value(pic, 1); } while (0)) -DEFINE_AOP(sub, pic_sub(pic, pic_int_value(0), argv[0]), do { +DEFINE_AOP(sub, pic_sub(pic, pic_int_value(pic, 0), argv[0]), do { pic_errorf(pic, "-: at least one argument required"); } while (0)) -DEFINE_AOP(div, pic_div(pic, pic_int_value(1), argv[0]), do { +DEFINE_AOP(div, pic_div(pic, pic_int_value(pic, 1), argv[0]), do { pic_errorf(pic, "/: at least one argument required"); } while (0)) @@ -265,8 +265,8 @@ pic_number_string_to_number(pic_state *pic) num = strtol(str, &eptr, radix); if (*eptr == '\0') { return pic_valid_int(num) - ? pic_int_value((int)num) - : pic_float_value(num); + ? pic_int_value(pic, (int)num) + : pic_float_value(pic, num); } pic_try { @@ -274,14 +274,14 @@ pic_number_string_to_number(pic_state *pic) } pic_catch { /* swallow error */ - flo = pic_false_value(); + flo = pic_false_value(pic); } - if (pic_int_p(flo) || pic_float_p(flo)) { + if (pic_int_p(pic, flo) || pic_float_p(pic, flo)) { return flo; } - return pic_false_value(); + return pic_false_value(pic); } void diff --git a/extlib/benz/pair.c b/extlib/benz/pair.c index 09138a80..80c95121 100644 --- a/extlib/benz/pair.c +++ b/extlib/benz/pair.c @@ -21,7 +21,7 @@ pic_set_car(pic_state *pic, pic_value obj, pic_value val) { struct pic_pair *pair; - if (! pic_pair_p(obj)) { + if (! pic_pair_p(pic, obj)) { pic_errorf(pic, "pair required"); } pair = pic_pair_ptr(obj); @@ -34,7 +34,7 @@ pic_set_cdr(pic_state *pic, pic_value obj, pic_value val) { struct pic_pair *pair; - if (! pic_pair_p(obj)) { + if (! pic_pair_p(pic, obj)) { pic_errorf(pic, "pair required"); } pair = pic_pair_ptr(obj); @@ -43,7 +43,7 @@ pic_set_cdr(pic_state *pic, pic_value obj, pic_value val) } bool -pic_list_p(pic_value obj) +pic_list_p(pic_state *pic, pic_value obj) { pic_value local, rapid; int i; @@ -55,18 +55,18 @@ pic_list_p(pic_value obj) /* advance rapid fast-forward; runs 2x faster than local */ for (i = 0; i < 2; ++i) { - if (pic_pair_p(rapid)) { + if (pic_pair_p(pic, rapid)) { rapid = pic_pair_ptr(rapid)->cdr; } else { - return pic_nil_p(rapid); + return pic_nil_p(pic, rapid); } } /* advance local */ local = pic_pair_ptr(local)->cdr; - if (pic_eq_p(local, rapid)) { + if (pic_eq_p(pic, local, rapid)) { return false; } } @@ -75,7 +75,7 @@ pic_list_p(pic_value obj) pic_value pic_list1(pic_state *pic, pic_value obj1) { - return pic_cons(pic, obj1, pic_nil_value()); + return pic_cons(pic, obj1, pic_nil_value(pic)); } pic_value @@ -161,7 +161,7 @@ pic_list_by_array(pic_state *pic, int c, pic_value *vs) { pic_value v; - v = pic_nil_value(); + v = pic_nil_value(pic); while (c--) { v = pic_cons(pic, vs[c], v); } @@ -174,7 +174,7 @@ pic_make_list(pic_state *pic, int k, pic_value fill) pic_value list; int i; - list = pic_nil_value(); + list = pic_nil_value(pic); for (i = 0; i < k; ++i) { list = pic_cons(pic, fill, list); } @@ -187,11 +187,11 @@ pic_length(pic_state *pic, pic_value obj) { int c = 0; - if (! pic_list_p(obj)) { + if (! pic_list_p(pic, obj)) { pic_errorf(pic, "length: expected list, but got ~s", obj); } - while (! pic_nil_p(obj)) { + while (! pic_nil_p(pic, obj)) { obj = pic_cdr(pic, obj); ++c; } @@ -205,7 +205,7 @@ pic_reverse(pic_state *pic, pic_value list) size_t ai = pic_gc_arena_preserve(pic); pic_value v, acc, it; - acc = pic_nil_value(); + acc = pic_nil_value(pic); pic_for_each(v, list, it) { acc = pic_cons(pic, v, acc); @@ -237,10 +237,10 @@ pic_memq(pic_state *pic, pic_value key, pic_value list) { enter: - if (pic_nil_p(list)) - return pic_false_value(); + if (pic_nil_p(pic, list)) + return pic_false_value(pic); - if (pic_eq_p(key, pic_car(pic, list))) + if (pic_eq_p(pic, key, pic_car(pic, list))) return list; list = pic_cdr(pic, list); @@ -252,10 +252,10 @@ pic_memv(pic_state *pic, pic_value key, pic_value list) { enter: - if (pic_nil_p(list)) - return pic_false_value(); + if (pic_nil_p(pic, list)) + return pic_false_value(pic); - if (pic_eqv_p(key, pic_car(pic, list))) + if (pic_eqv_p(pic, key, pic_car(pic, list))) return list; list = pic_cdr(pic, list); @@ -267,14 +267,14 @@ pic_member(pic_state *pic, pic_value key, pic_value list, struct pic_proc *compa { enter: - if (pic_nil_p(list)) - return pic_false_value(); + if (pic_nil_p(pic, list)) + return pic_false_value(pic); if (compar == NULL) { if (pic_equal_p(pic, key, pic_car(pic, list))) return list; } else { - if (pic_test(pic_call(pic, compar, 2, key, pic_car(pic, list)))) + if (pic_test(pic, pic_call(pic, compar, 2, key, pic_car(pic, list)))) return list; } @@ -289,11 +289,11 @@ pic_assq(pic_state *pic, pic_value key, pic_value assoc) enter: - if (pic_nil_p(assoc)) - return pic_false_value(); + if (pic_nil_p(pic, assoc)) + return pic_false_value(pic); cell = pic_car(pic, assoc); - if (pic_eq_p(key, pic_car(pic, cell))) + if (pic_eq_p(pic, key, pic_car(pic, cell))) return cell; assoc = pic_cdr(pic, assoc); @@ -307,11 +307,11 @@ pic_assv(pic_state *pic, pic_value key, pic_value assoc) enter: - if (pic_nil_p(assoc)) - return pic_false_value(); + if (pic_nil_p(pic, assoc)) + return pic_false_value(pic); cell = pic_car(pic, assoc); - if (pic_eqv_p(key, pic_car(pic, cell))) + if (pic_eqv_p(pic, key, pic_car(pic, cell))) return cell; assoc = pic_cdr(pic, assoc); @@ -325,15 +325,15 @@ pic_assoc(pic_state *pic, pic_value key, pic_value assoc, struct pic_proc *compa enter: - if (pic_nil_p(assoc)) - return pic_false_value(); + if (pic_nil_p(pic, assoc)) + return pic_false_value(pic); cell = pic_car(pic, assoc); if (compar == NULL) { if (pic_equal_p(pic, key, pic_car(pic, cell))) return cell; } else { - if (pic_test(pic_call(pic, compar, 2, key, pic_car(pic, cell)))) + if (pic_test(pic, pic_call(pic, compar, 2, key, pic_car(pic, cell)))) return cell; } @@ -395,7 +395,7 @@ pic_list_set(pic_state *pic, pic_value list, int i, pic_value obj) pic_value pic_list_copy(pic_state *pic, pic_value obj) { - if (pic_pair_p(obj)) { + if (pic_pair_p(pic, obj)) { return pic_cons(pic, pic_car(pic, obj), pic_list_copy(pic, pic_cdr(pic, obj))); } else { @@ -410,7 +410,7 @@ pic_pair_pair_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_pair_p(v)); + return pic_bool_value(pic, pic_pair_p(pic, v)); } static pic_value @@ -492,7 +492,7 @@ pic_pair_set_car(pic_state *pic) pic_set_car(pic, v, w); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -504,7 +504,7 @@ pic_pair_set_cdr(pic_state *pic) pic_set_cdr(pic, v, w); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -514,7 +514,7 @@ pic_pair_null_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_nil_p(v)); + return pic_bool_value(pic, pic_nil_p(pic, v)); } static pic_value @@ -524,14 +524,14 @@ pic_pair_list_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_list_p(v)); + return pic_bool_value(pic, pic_list_p(pic, v)); } static pic_value pic_pair_make_list(pic_state *pic) { int i; - pic_value fill = pic_undef_value(); + pic_value fill = pic_undef_value(pic); pic_get_args(pic, "i|o", &i, &fill); @@ -556,7 +556,7 @@ pic_pair_length(pic_state *pic) pic_get_args(pic, "o", &list); - return pic_int_value(pic_length(pic, list)); + return pic_int_value(pic, pic_length(pic, list)); } static pic_value @@ -568,7 +568,7 @@ pic_pair_append(pic_state *pic) pic_get_args(pic, "*", &argc, &args); if (argc == 0) { - return pic_nil_value(); + return pic_nil_value(pic); } list = args[--argc]; @@ -621,7 +621,7 @@ pic_pair_list_set(pic_state *pic) pic_list_set(pic, list, i, obj); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -648,10 +648,10 @@ pic_pair_map(pic_state *pic) arg_list = pic_alloca(pic, sizeof(pic_value) * argc); - ret = pic_nil_value(); + ret = pic_nil_value(pic); do { for (i = 0; i < argc; ++i) { - if (! pic_pair_p(args[i])) { + if (! pic_pair_p(pic, args[i])) { break; } arg_list[i] = pic_car(pic, args[i]); @@ -680,7 +680,7 @@ pic_pair_for_each(pic_state *pic) do { for (i = 0; i < argc; ++i) { - if (! pic_pair_p(args[i])) { + if (! pic_pair_p(pic, args[i])) { break; } arg_list[i] = pic_car(pic, args[i]); @@ -692,7 +692,7 @@ pic_pair_for_each(pic_state *pic) pic_apply(pic, proc, i, arg_list); } while (1); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value diff --git a/extlib/benz/port.c b/extlib/benz/port.c index ed92381b..84b27e40 100644 --- a/extlib/benz/port.c +++ b/extlib/benz/port.c @@ -103,7 +103,7 @@ file_error(pic_state *pic, const char *msg) { struct pic_error *e; - e = pic_make_error(pic, pic_intern_lit(pic, "file"), msg, pic_nil_value()); + e = pic_make_error(pic, pic_intern_lit(pic, "file"), msg, pic_nil_value(pic)); pic_raise(pic, pic_obj_value(e)); } @@ -266,7 +266,7 @@ string_open(pic_state *pic, const char *data, size_t size) if (file == NULL) { string_close(pic, m); - pic_error(pic, "could not open new output string/bytevector port", pic_nil_value()); + pic_error(pic, "could not open new output string/bytevector port", pic_nil_value(pic)); } return file; } @@ -346,11 +346,11 @@ pic_port_input_port_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_IN) != 0) { - return pic_true_value(); + if (pic_port_p(pic, v) && (pic_port_ptr(v)->flags & PIC_PORT_IN) != 0) { + return pic_true_value(pic); } else { - return pic_false_value(); + return pic_false_value(pic); } } @@ -361,11 +361,11 @@ pic_port_output_port_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_OUT) != 0) { - return pic_true_value(); + if (pic_port_p(pic, v) && (pic_port_ptr(v)->flags & PIC_PORT_OUT) != 0) { + return pic_true_value(pic); } else { - return pic_false_value(); + return pic_false_value(pic); } } @@ -376,11 +376,11 @@ pic_port_textual_port_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_TEXT) != 0) { - return pic_true_value(); + if (pic_port_p(pic, v) && (pic_port_ptr(v)->flags & PIC_PORT_TEXT) != 0) { + return pic_true_value(pic); } else { - return pic_false_value(); + return pic_false_value(pic); } } @@ -391,11 +391,11 @@ pic_port_binary_port_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_BINARY) != 0) { - return pic_true_value(); + if (pic_port_p(pic, v) && (pic_port_ptr(v)->flags & PIC_PORT_BINARY) != 0) { + return pic_true_value(pic); } else { - return pic_false_value(); + return pic_false_value(pic); } } @@ -406,7 +406,7 @@ pic_port_port_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_port_p(v)); + return pic_bool_value(pic, pic_port_p(pic, v)); } static pic_value @@ -416,12 +416,7 @@ pic_port_eof_object_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_vtype(v) == PIC_VTYPE_EOF) { - return pic_true_value(); - } - else { - return pic_false_value(); - } + return pic_bool_value(pic, pic_eof_p(pic, v)); } static pic_value @@ -439,7 +434,7 @@ pic_port_port_open_p(pic_state *pic) pic_get_args(pic, "p", &port); - return pic_bool_value(port->flags & PIC_PORT_OPEN); + return pic_bool_value(pic, port->flags & PIC_PORT_OPEN); } static pic_value @@ -451,7 +446,7 @@ pic_port_close_port(pic_state *pic) pic_close_port(pic, port); - return pic_undef_value(); + return pic_undef_value(pic); } #define assert_port_profile(port, flgs, caller) do { \ @@ -581,7 +576,7 @@ pic_port_read_char(pic_state *pic) return pic_eof_object(); } else { - return pic_char_value((char)c); + return pic_char_value(pic, (char)c); } } @@ -600,7 +595,7 @@ pic_port_peek_char(pic_state *pic) } else { xungetc(c, port->file); - return pic_char_value((char)c); + return pic_char_value(pic, (char)c); } } @@ -622,7 +617,7 @@ pic_port_read_line(pic_state *pic) } str = pic_get_output_string(pic, buf); - if (pic_str_len(str) == 0 && c == EOF) { + if (pic_str_len(pic, str) == 0 && c == EOF) { /* EOF */ } else { res = pic_obj_value(str); @@ -640,7 +635,7 @@ pic_port_char_ready_p(pic_state *pic) pic_get_args(pic, "|p", &port); - return pic_true_value(); /* FIXME: always returns #t */ + return pic_true_value(pic); /* FIXME: always returns #t */ } static pic_value @@ -665,7 +660,7 @@ pic_port_read_string(pic_state *pic){ } str = pic_get_output_string(pic, buf); - if (pic_str_len(str) == 0 && c == EOF) { + if (pic_str_len(pic, str) == 0 && c == EOF) { /* EOF */ } else { res = pic_obj_value(str); @@ -685,7 +680,7 @@ pic_port_read_byte(pic_state *pic){ return pic_eof_object(); } - return pic_int_value(c); + return pic_int_value(pic, c); } static pic_value @@ -704,7 +699,7 @@ pic_port_peek_byte(pic_state *pic) } else { xungetc(c, port->file); - return pic_int_value(c); + return pic_int_value(pic, c); } } @@ -717,7 +712,7 @@ pic_port_byte_ready_p(pic_state *pic) assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "u8-ready?"); - return pic_true_value(); /* FIXME: always returns #t */ + return pic_true_value(pic); /* FIXME: always returns #t */ } @@ -780,7 +775,7 @@ pic_port_read_blob_ip(pic_state *pic) return pic_eof_object(); } else { - return pic_int_value(i); + return pic_int_value(pic, i); } } @@ -794,7 +789,7 @@ pic_port_newline(pic_state *pic) assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "newline"); xfputs(pic, "\n", port->file); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -808,7 +803,7 @@ pic_port_write_char(pic_state *pic) assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "write-char"); xfputc(pic, c, port->file); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -833,7 +828,7 @@ pic_port_write_string(pic_state *pic) for (i = start; i < end && str[i] != '\0'; ++i) { xfputc(pic, str[i], port->file); } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -847,7 +842,7 @@ pic_port_write_byte(pic_state *pic) assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "write-u8"); xfputc(pic, i, port->file); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -872,7 +867,7 @@ pic_port_write_blob(pic_state *pic) for (i = start; i < end; ++i) { xfputc(pic, blob->data[i], port->file); } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -885,7 +880,7 @@ pic_port_flush(pic_state *pic) assert_port_profile(port, PIC_PORT_OUT, "flush-output-port"); xfflush(pic, port->file); - return pic_undef_value(); + return pic_undef_value(pic); } void diff --git a/extlib/benz/proc.c b/extlib/benz/proc.c index 4fc209ca..699474d4 100644 --- a/extlib/benz/proc.c +++ b/extlib/benz/proc.c @@ -106,13 +106,13 @@ pic_get_args(pic_state *pic, const char *format, ...) e = (c == c2 ? va_arg(ap, bool *) : &dummy); \ \ v = GET_OPERAND(pic, i); \ - switch (pic_type(v)) { \ + switch (pic_type(pic, v)) { \ case PIC_TT_FLOAT: \ - *n = pic_float(v); \ + *n = pic_float(pic, v); \ *e = false; \ break; \ case PIC_TT_INT: \ - *n = pic_int(v); \ + *n = pic_int(pic, v); \ *e = true; \ break; \ default: \ @@ -131,7 +131,7 @@ pic_get_args(pic_state *pic, const char *format, ...) \ ptr = va_arg(ap, ctype *); \ v = GET_OPERAND(pic, i); \ - if (pic_## type ##_p(v)) { \ + if (pic_## type ##_p(pic, v)) { \ *ptr = conv; \ } \ else { \ @@ -140,7 +140,7 @@ pic_get_args(pic_state *pic, const char *format, ...) break; \ } - VAL_CASE('c', char, char, pic_char(v)) + VAL_CASE('c', char, char, pic_char(pic, v)) VAL_CASE('z', str, const char *, pic_str_cstr(pic, pic_str_ptr(v))) #define PTR_CASE(c, type, ctype) \ @@ -371,31 +371,31 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) NEXT; } CASE(OP_PUSHUNDEF) { - PUSH(pic_undef_value()); + PUSH(pic_undef_value(pic)); NEXT; } CASE(OP_PUSHNIL) { - PUSH(pic_nil_value()); + PUSH(pic_nil_value(pic)); NEXT; } CASE(OP_PUSHTRUE) { - PUSH(pic_true_value()); + PUSH(pic_true_value(pic)); NEXT; } CASE(OP_PUSHFALSE) { - PUSH(pic_false_value()); + PUSH(pic_false_value(pic)); NEXT; } CASE(OP_PUSHINT) { - PUSH(pic_int_value(pic->ci->irep->ints[c.a])); + PUSH(pic_int_value(pic, pic->ci->irep->ints[c.a])); NEXT; } CASE(OP_PUSHFLOAT) { - PUSH(pic_float_value(pic->ci->irep->nums[c.a])); + PUSH(pic_float_value(pic, pic->ci->irep->nums[c.a])); NEXT; } CASE(OP_PUSHCHAR) { - PUSH(pic_char_value(pic->ci->irep->ints[c.a])); + PUSH(pic_char_value(pic, pic->ci->irep->ints[c.a])); NEXT; } CASE(OP_PUSHEOF) { @@ -412,7 +412,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) } CASE(OP_GSET) { vm_gset(pic, (pic_sym *)pic->ci->irep->pool[c.a], POP()); - PUSH(pic_undef_value()); + PUSH(pic_undef_value(pic)); NEXT; } CASE(OP_LREF) { @@ -435,12 +435,12 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) if (ci->cxt != NULL && ci->cxt->regs == ci->cxt->storage) { if (c.a >= irep->argc + irep->localc) { ci->cxt->regs[c.a - (ci->regs - ci->fp)] = POP(); - PUSH(pic_undef_value()); + PUSH(pic_undef_value(pic)); NEXT; } } pic->ci->fp[c.a] = POP(); - PUSH(pic_undef_value()); + PUSH(pic_undef_value(pic)); NEXT; } CASE(OP_CREF) { @@ -463,7 +463,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) cxt = cxt->up; } cxt->regs[c.b] = POP(); - PUSH(pic_undef_value()); + PUSH(pic_undef_value(pic)); NEXT; } CASE(OP_JMP) { @@ -474,7 +474,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) pic_value v; v = POP(); - if (! pic_false_p(v)) { + if (! pic_false_p(pic, v)) { pic->ip += c.a; JUMP; } @@ -491,7 +491,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) L_CALL: x = pic->sp[-c.a]; - if (! pic_proc_p(x)) { + if (! pic_proc_p(pic, x)) { pic_errorf(pic, "invalid application: ~s", x); } proc = pic_proc_ptr(x); @@ -532,7 +532,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) } /* prepare rest args */ if (irep->varg) { - rest = pic_nil_value(); + rest = pic_nil_value(pic); for (i = 0; i < ci->argc - irep->argc; ++i) { pic_gc_protect(pic, v = POP()); rest = pic_cons(pic, v, rest); @@ -546,7 +546,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) --l; } for (i = 0; i < l; ++i) { - PUSH(pic_undef_value()); + PUSH(pic_undef_value(pic)); } } @@ -659,7 +659,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) check_condition(NILP, 1); p = POP(); (void)POP(); - PUSH(pic_bool_value(pic_nil_p(p))); + PUSH(pic_bool_value(pic, pic_nil_p(pic, p))); NEXT; } CASE(OP_SYMBOLP) { @@ -667,7 +667,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) check_condition(SYMBOLP, 1); p = POP(); (void)POP(); - PUSH(pic_bool_value(pic_sym_p(p))); + PUSH(pic_bool_value(pic, pic_sym_p(pic, p))); NEXT; } CASE(OP_PAIRP) { @@ -675,13 +675,13 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) check_condition(PAIRP, 1); p = POP(); (void)POP(); - PUSH(pic_bool_value(pic_pair_p(p))); + PUSH(pic_bool_value(pic, pic_pair_p(pic, p))); NEXT; } CASE(OP_NOT) { pic_value v; check_condition(NOT, 1); - v = pic_false_p(POP()) ? pic_true_value() : pic_false_value(); + v = pic_false_p(pic, POP()) ? pic_true_value(pic) : pic_false_value(pic); (void)POP(); PUSH(v); NEXT; @@ -729,7 +729,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) b = POP(); a = POP(); (void)POP(); - PUSH(pic_bool_value(pic_eq(pic, a, b))); + PUSH(pic_bool_value(pic, pic_eq(pic, a, b))); NEXT; } CASE(OP_LE) { @@ -738,7 +738,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) b = POP(); a = POP(); (void)POP(); - PUSH(pic_bool_value(pic_le(pic, a, b))); + PUSH(pic_bool_value(pic, pic_le(pic, a, b))); NEXT; } CASE(OP_LT) { @@ -747,7 +747,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) b = POP(); a = POP(); (void)POP(); - PUSH(pic_bool_value(pic_lt(pic, a, b))); + PUSH(pic_bool_value(pic, pic_lt(pic, a, b))); NEXT; } CASE(OP_GE) { @@ -756,7 +756,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) b = POP(); a = POP(); (void)POP(); - PUSH(pic_bool_value(pic_ge(pic, a, b))); + PUSH(pic_bool_value(pic, pic_ge(pic, a, b))); NEXT; } CASE(OP_GT) { @@ -765,7 +765,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) b = POP(); a = POP(); (void)POP(); - PUSH(pic_bool_value(pic_gt(pic, a, b))); + PUSH(pic_bool_value(pic, pic_gt(pic, a, b))); NEXT; } @@ -801,7 +801,7 @@ pic_applyk(pic_state *pic, struct pic_proc *proc, int argc, pic_value *args) ci->retc = (int)argc; if (ci->retc == 0) { - return pic_undef_value(); + return pic_undef_value(pic); } else { return args[0]; } @@ -1033,7 +1033,7 @@ pic_proc_proc_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_proc_p(v)); + return pic_bool_value(pic, pic_proc_p(pic, v)); } static pic_value diff --git a/extlib/benz/read.c b/extlib/benz/read.c index 84522faa..3819d9e5 100644 --- a/extlib/benz/read.c +++ b/extlib/benz/read.c @@ -226,7 +226,7 @@ read_uinteger(pic_state *pic, struct pic_port *port, int c) unsigned u = 0; if (! isdigit(c)) { - read_error(pic, "expected one or more digits", pic_list1(pic, pic_char_value(c))); + read_error(pic, "expected one or more digits", pic_list1(pic, pic_char_value(pic, c))); } u = c - '0'; @@ -247,7 +247,7 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c) int dpe = 0; /* the number of '.' or 'e' characters seen */ if (! isdigit(c)) { - read_error(pic, "expected one or more digits", pic_list1(pic, pic_char_value(c))); + read_error(pic, "expected one or more digits", pic_list1(pic, pic_char_value(pic, c))); } buf[idx++] = (char )c; while (isdigit(c = peek(pic, port)) && idx < ATOF_BUF_SIZE) { @@ -274,7 +274,7 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c) break; } if (! isdigit(peek(pic, port))) { - read_error(pic, "expected one or more digits", pic_list1(pic, pic_char_value(c))); + read_error(pic, "expected one or more digits", pic_list1(pic, pic_char_value(pic, c))); } while (isdigit(c = peek(pic, port)) && idx < ATOF_BUF_SIZE) { buf[idx++] = (char )next(pic, port); @@ -285,14 +285,14 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c) pic_obj_value(pic_make_str(pic, (const char *)buf, ATOF_BUF_SIZE))); if (! isdelim(c)) - read_error(pic, "non-delimiter character given after number", pic_list1(pic, pic_char_value(c))); + read_error(pic, "non-delimiter character given after number", pic_list1(pic, pic_char_value(pic, c))); buf[idx] = 0; flt = PIC_CSTRING_TO_DOUBLE(buf); if (dpe == 0 && pic_valid_int(flt)) - return pic_int_value((int )flt); - return pic_float_value(flt); + return pic_int_value(pic, (int )flt); + return pic_float_value(pic, flt); } static pic_value @@ -302,12 +302,12 @@ read_number(pic_state *pic, struct pic_port *port, int c) } static pic_value -negate(pic_value n) +negate(pic_state *pic, pic_value n) { - if (pic_int_p(n) && (INT_MIN != pic_int(n))) { - return pic_int_value(-pic_int(n)); + if (pic_int_p(pic, n) && (INT_MIN != pic_int(pic, n))) { + return pic_int_value(pic, -pic_int(pic, n)); } else { - return pic_float_value(-pic_float(n)); + return pic_float_value(pic, -pic_float(pic, n)); } } @@ -317,15 +317,15 @@ read_minus(pic_state *pic, struct pic_port *port, int c) pic_value sym; if (isdigit(peek(pic, port))) { - return negate(read_unsigned(pic, port, next(pic, port))); + return negate(pic, read_unsigned(pic, port, next(pic, port))); } else { sym = read_symbol(pic, port, c); if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "-inf.0")) { - return pic_float_value(-(1.0 / 0.0)); + return pic_float_value(pic, -(1.0 / 0.0)); } if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "-nan.0")) { - return pic_float_value(-(0.0 / 0.0)); + return pic_float_value(pic, -(0.0 / 0.0)); } return sym; } @@ -342,10 +342,10 @@ read_plus(pic_state *pic, struct pic_port *port, int c) else { sym = read_symbol(pic, port, c); if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "+inf.0")) { - return pic_float_value(1.0 / 0.0); + return pic_float_value(pic, 1.0 / 0.0); } if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "+nan.0")) { - return pic_float_value(0.0 / 0.0); + return pic_float_value(pic, 0.0 / 0.0); } return sym; } @@ -356,13 +356,13 @@ read_true(pic_state *pic, struct pic_port *port, int c) { if ((c = peek(pic, port)) == 'r') { if (! expect(pic, port, "rue")) { - read_error(pic, "unexpected character while reading #true", pic_nil_value()); + read_error(pic, "unexpected character while reading #true", pic_nil_value(pic)); } } else if (! isdelim(c)) { - read_error(pic, "non-delimiter character given after #t", pic_list1(pic, pic_char_value(c))); + read_error(pic, "non-delimiter character given after #t", pic_list1(pic, pic_char_value(pic, c))); } - return pic_true_value(); + return pic_true_value(pic); } static pic_value @@ -370,13 +370,13 @@ read_false(pic_state *pic, struct pic_port *port, int c) { if ((c = peek(pic, port)) == 'a') { if (! expect(pic, port, "alse")) { - read_error(pic, "unexpected character while reading #false", pic_nil_value()); + read_error(pic, "unexpected character while reading #false", pic_nil_value(pic)); } } else if (! isdelim(c)) { - read_error(pic, "non-delimiter character given after #f", pic_list1(pic, pic_char_value(c))); + read_error(pic, "non-delimiter character given after #f", pic_list1(pic, pic_char_value(pic, c))); } - return pic_false_value(); + return pic_false_value(pic); } static pic_value @@ -386,7 +386,7 @@ read_char(pic_state *pic, struct pic_port *port, int c) if (! isdelim(peek(pic, port))) { switch (c) { - default: read_error(pic, "unexpected character after char literal", pic_list1(pic, pic_char_value(c))); + default: read_error(pic, "unexpected character after char literal", pic_list1(pic, pic_char_value(pic, c))); case 'a': c = '\a'; if (! expect(pic, port, "larm")) goto fail; break; case 'b': c = '\b'; if (! expect(pic, port, "ackspace")) goto fail; break; case 'd': c = 0x7F; if (! expect(pic, port, "elete")) goto fail; break; @@ -408,10 +408,10 @@ read_char(pic_state *pic, struct pic_port *port, int c) } } - return pic_char_value((char)c); + return pic_char_value(pic, (char)c); fail: - read_error(pic, "unexpected character while reading character literal", pic_list1(pic, pic_char_value(c))); + read_error(pic, "unexpected character while reading character literal", pic_list1(pic, pic_char_value(pic, c))); } static pic_value @@ -474,7 +474,7 @@ read_pipe(pic_state *pic, struct pic_port *port, int c) i = 0; while ((HEX_BUF[i++] = (char)next(pic, port)) != ';') { if (i >= sizeof HEX_BUF) - read_error(pic, "expected ';'", pic_list1(pic, pic_char_value(HEX_BUF[sizeof(HEX_BUF) - 1]))); + read_error(pic, "expected ';'", pic_list1(pic, pic_char_value(pic, HEX_BUF[sizeof(HEX_BUF) - 1]))); } c = (char)strtol(HEX_BUF, NULL, 16); break; @@ -508,11 +508,11 @@ read_blob(pic_state *pic, struct pic_port *port, int c) } if (nbits != 8) { - read_error(pic, "unsupported bytevector bit width", pic_list1(pic, pic_int_value(nbits))); + read_error(pic, "unsupported bytevector bit width", pic_list1(pic, pic_int_value(pic, nbits))); } if (c != '(') { - read_error(pic, "expected '(' character", pic_list1(pic, pic_char_value(c))); + read_error(pic, "expected '(' character", pic_list1(pic, pic_char_value(pic, c))); } len = 0; @@ -521,7 +521,7 @@ read_blob(pic_state *pic, struct pic_port *port, int c) while ((c = skip(pic, port, c)) != ')') { n = read_uinteger(pic, port, c); if (n < 0 || (1 << nbits) <= n) { - read_error(pic, "invalid element in bytevector literal", pic_list1(pic, pic_int_value(n))); + read_error(pic, "invalid element in bytevector literal", pic_list1(pic, pic_int_value(pic, n))); } len += 1; dat = pic_realloc(pic, dat, len); @@ -543,12 +543,12 @@ read_undef_or_blob(pic_state *pic, struct pic_port *port, int c) { if ((c = peek(pic, port)) == 'n') { if (! expect(pic, port, "ndefined")) { - read_error(pic, "unexpected character while reading #undefined", pic_nil_value()); + read_error(pic, "unexpected character while reading #undefined", pic_nil_value(pic)); } - return pic_undef_value(); + return pic_undef_value(pic); } if (! isdigit(c)) { - read_error(pic, "expect #undefined or #u8(...), but illegal character given", pic_list1(pic, pic_char_value(c))); + read_error(pic, "expect #undefined or #u8(...), but illegal character given", pic_list1(pic, pic_char_value(pic, c))); } return read_blob(pic, port, 'u'); } @@ -564,24 +564,24 @@ read_pair(pic_state *pic, struct pic_port *port, int c) c = skip(pic, port, ' '); if (c == tCLOSE) { - return pic_nil_value(); + return pic_nil_value(pic); } if (c == '.' && isdelim(peek(pic, port))) { cdr = read(pic, port, next(pic, port)); closing: if ((c = skip(pic, port, ' ')) != tCLOSE) { - if (pic_invalid_p(read_nullable(pic, port, c))) { + if (pic_invalid_p(pic, read_nullable(pic, port, c))) { goto closing; } - read_error(pic, "unmatched parenthesis", pic_nil_value()); + read_error(pic, "unmatched parenthesis", pic_nil_value(pic)); } return cdr; } else { car = read_nullable(pic, port, c); - if (pic_invalid_p(car)) { + if (pic_invalid_p(pic, car)) { goto retry; } @@ -623,7 +623,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i) { pic_value tmp; - kh_val(h, it) = val = pic_cons(pic, pic_undef_value(), pic_undef_value()); + kh_val(h, it) = val = pic_cons(pic, pic_undef_value(pic), pic_undef_value(pic)); tmp = read(pic, port, c); pic_pair_ptr(val)->car = pic_car(pic, tmp); @@ -672,7 +672,7 @@ read_label_ref(pic_state *pic, struct pic_port PIC_UNUSED(*port), int i) it = kh_get(read, h, i); if (it == kh_end(h)) { - read_error(pic, "label of given index not defined", pic_list1(pic, pic_int_value(i))); + read_error(pic, "label of given index not defined", pic_list1(pic, pic_int_value(pic, i))); } return kh_val(h, it); } @@ -693,13 +693,13 @@ read_label(pic_state *pic, struct pic_port *port, int c) if (c == '#') { return read_label_ref(pic, port, i); } - read_error(pic, "broken label expression", pic_nil_value()); + read_error(pic, "broken label expression", pic_nil_value(pic)); } static pic_value read_unmatch(pic_state *pic, struct pic_port PIC_UNUSED(*port), int PIC_UNUSED(c)) { - read_error(pic, "unmatched parenthesis", pic_nil_value()); + read_error(pic, "unmatched parenthesis", pic_nil_value(pic)); } static pic_value @@ -708,11 +708,11 @@ read_dispatch(pic_state *pic, struct pic_port *port, int c) c = next(pic, port); if (c == EOF) { - read_error(pic, "unexpected EOF", pic_nil_value()); + read_error(pic, "unexpected EOF", pic_nil_value(pic)); } if (pic->reader.dispatch[c] == NULL) { - read_error(pic, "invalid character at the seeker head", pic_list1(pic, pic_char_value(c))); + read_error(pic, "invalid character at the seeker head", pic_list1(pic, pic_char_value(pic, c))); } return pic->reader.dispatch[c](pic, port, c); @@ -724,11 +724,11 @@ read_nullable(pic_state *pic, struct pic_port *port, int c) c = skip(pic, port, c); if (c == EOF) { - read_error(pic, "unexpected EOF", pic_nil_value()); + read_error(pic, "unexpected EOF", pic_nil_value(pic)); } if (pic->reader.table[c] == NULL) { - read_error(pic, "invalid character at the seeker head", pic_list1(pic, pic_char_value(c))); + read_error(pic, "invalid character at the seeker head", pic_list1(pic, pic_char_value(pic, c))); } return pic->reader.table[c](pic, port, c); @@ -742,7 +742,7 @@ read(pic_state *pic, struct pic_port *port, int c) retry: val = read_nullable(pic, port, c); - if (pic_invalid_p(val)) { + if (pic_invalid_p(pic, val)) { c = next(pic, port); goto retry; } @@ -832,7 +832,7 @@ pic_read(pic_state *pic, struct pic_port *port) while ((c = skip(pic, port, next(pic, port))) != EOF) { val = read_nullable(pic, port, c); - if (! pic_invalid_p(val)) { + if (! pic_invalid_p(pic, val)) { break; } pic_gc_arena_restore(pic, ai); diff --git a/extlib/benz/record.c b/extlib/benz/record.c index 301b9a12..ded83ab2 100644 --- a/extlib/benz/record.c +++ b/extlib/benz/record.c @@ -45,7 +45,7 @@ pic_rec_record_p(pic_state *pic) pic_get_args(pic, "o", &rec); - return pic_bool_value(pic_rec_p(rec)); + return pic_bool_value(pic, pic_rec_p(pic, rec)); } static pic_value diff --git a/extlib/benz/state.c b/extlib/benz/state.c index 72c0604c..917bd59f 100644 --- a/extlib/benz/state.c +++ b/extlib/benz/state.c @@ -265,7 +265,7 @@ pic_open(pic_allocf allocf, void *userdata) pic->macros = NULL; /* features */ - pic->features = pic_nil_value(); + pic->features = pic_nil_value(pic); /* libraries */ kh_init(ltable, &pic->ltable); @@ -282,7 +282,7 @@ pic_open(pic_allocf allocf, void *userdata) memset(pic->files, 0, sizeof pic->files); /* parameter table */ - pic->ptable = pic_nil_value(); + pic->ptable = pic_nil_value(pic); /* native stack marker */ pic->native_stack_start = &t; @@ -385,7 +385,7 @@ pic_close(pic_state *pic) pic->err = pic_invalid_value(); pic->globals = NULL; pic->macros = NULL; - pic->features = pic_nil_value(); + pic->features = pic_nil_value(pic); /* free all libraries */ kh_clear(ltable, &pic->ltable); diff --git a/extlib/benz/string.c b/extlib/benz/string.c index 0a836f24..bd0ac8b4 100644 --- a/extlib/benz/string.c +++ b/extlib/benz/string.c @@ -253,7 +253,7 @@ pic_make_str(pic_state *pic, const char *str, int len) } int -pic_str_len(struct pic_string *str) +pic_str_len(pic_state PIC_UNUSED(*pic), struct pic_string *str) { return rope_len(str->rope); } @@ -408,7 +408,7 @@ pic_str_string_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_str_p(v)); + return pic_bool_value(pic, pic_str_p(pic, v)); } static pic_value @@ -425,7 +425,7 @@ pic_str_string(pic_state *pic) for (i = 0; i < argc; ++i) { pic_assert_type(pic, argv[i], char); - buf[i] = pic_char(argv[i]); + buf[i] = pic_char(pic, argv[i]); } str = pic_make_str(pic, buf, argc); @@ -460,7 +460,7 @@ pic_str_string_length(pic_state *pic) pic_get_args(pic, "s", &str); - return pic_int_value(pic_str_len(str)); + return pic_int_value(pic, pic_str_len(pic, str)); } static pic_value @@ -471,7 +471,7 @@ pic_str_string_ref(pic_state *pic) pic_get_args(pic, "si", &str, &k); - return pic_char_value(pic_str_ref(pic, str, k)); + return pic_char_value(pic, pic_str_ref(pic, str, k)); } #define DEFINE_STRING_CMP(name, op) \ @@ -483,19 +483,19 @@ pic_str_string_ref(pic_state *pic) \ pic_get_args(pic, "*", &argc, &argv); \ \ - if (argc < 1 || ! pic_str_p(argv[0])) { \ - return pic_false_value(); \ + if (argc < 1 || ! pic_str_p(pic, argv[0])) { \ + return pic_false_value(pic); \ } \ \ for (i = 1; i < argc; ++i) { \ - if (! pic_str_p(argv[i])) { \ - return pic_false_value(); \ + if (! pic_str_p(pic, argv[i])) { \ + return pic_false_value(pic); \ } \ if (! (pic_str_cmp(pic, pic_str_ptr(argv[i-1]), pic_str_ptr(argv[i])) op 0)) { \ - return pic_false_value(); \ + return pic_false_value(pic); \ } \ } \ - return pic_true_value(); \ + return pic_true_value(pic); \ } DEFINE_STRING_CMP(eq, ==) @@ -512,7 +512,7 @@ pic_str_string_copy(pic_state *pic) n = pic_get_args(pic, "s|ii", &str, &start, &end); - len = pic_str_len(str); + len = pic_str_len(pic, str); switch (n) { case 1: @@ -538,7 +538,7 @@ pic_str_string_append(pic_state *pic) str = pic_make_lit(pic, ""); for (i = 0; i < argc; ++i) { - if (! pic_str_p(argv[i])) { + if (! pic_str_p(pic, argv[i])) { pic_errorf(pic, "type error"); } str = pic_str_cat(pic, str, pic_str_ptr(argv[i])); @@ -561,27 +561,27 @@ pic_str_string_map(pic_state *pic) pic_errorf(pic, "string-map: one or more strings expected, but got zero"); } else { pic_assert_type(pic, argv[0], str); - len = pic_str_len(pic_str_ptr(argv[0])); + len = pic_str_len(pic, pic_str_ptr(argv[0])); } for (i = 1; i < argc; ++i) { pic_assert_type(pic, argv[i], str); - len = len < pic_str_len(pic_str_ptr(argv[i])) + len = len < pic_str_len(pic, pic_str_ptr(argv[i])) ? len - : pic_str_len(pic_str_ptr(argv[i])); + : pic_str_len(pic, pic_str_ptr(argv[i])); } buf = pic_malloc(pic, len); pic_try { for (i = 0; i < len; ++i) { - vals = pic_nil_value(); + vals = pic_nil_value(pic); for (j = 0; j < argc; ++j) { - pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); + pic_push(pic, pic_char_value(pic, pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); } val = pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals); pic_assert_type(pic, val, char); - buf[i] = pic_char(val); + buf[i] = pic_char(pic, val); } str = pic_make_str(pic, buf, len); } @@ -608,25 +608,25 @@ pic_str_string_for_each(pic_state *pic) pic_errorf(pic, "string-map: one or more strings expected, but got zero"); } else { pic_assert_type(pic, argv[0], str); - len = pic_str_len(pic_str_ptr(argv[0])); + len = pic_str_len(pic, pic_str_ptr(argv[0])); } for (i = 1; i < argc; ++i) { pic_assert_type(pic, argv[i], str); - len = len < pic_str_len(pic_str_ptr(argv[i])) + len = len < pic_str_len(pic, pic_str_ptr(argv[i])) ? len - : pic_str_len(pic_str_ptr(argv[i])); + : pic_str_len(pic, pic_str_ptr(argv[i])); } for (i = 0; i < len; ++i) { - vals = pic_nil_value(); + vals = pic_nil_value(pic); for (j = 0; j < argc; ++j) { - pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); + pic_push(pic, pic_char_value(pic, pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); } pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals); } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -650,7 +650,7 @@ pic_str_list_to_string(pic_state *pic) pic_for_each (e, list, it) { pic_assert_type(pic, e, char); - buf[i++] = pic_char(e); + buf[i++] = pic_char(pic, e); } str = pic_make_str(pic, buf, i); @@ -677,13 +677,13 @@ pic_str_string_to_list(pic_state *pic) case 1: start = 0; case 2: - end = pic_str_len(str); + end = pic_str_len(pic, str); } - list = pic_nil_value(); + list = pic_nil_value(pic); for (i = start; i < end; ++i) { - pic_push(pic, pic_char_value(pic_str_ref(pic, str, i)), list); + pic_push(pic, pic_char_value(pic, pic_str_ref(pic, str, i)), list); } return pic_reverse(pic, list); } diff --git a/extlib/benz/symbol.c b/extlib/benz/symbol.c index c7ee0969..0e185dec 100644 --- a/extlib/benz/symbol.c +++ b/extlib/benz/symbol.c @@ -53,7 +53,7 @@ pic_symbol_name(pic_state *pic, pic_sym *sym) const char * pic_identifier_name(pic_state *pic, pic_id *id) { - while (! pic_sym_p(pic_obj_value(id))) { + while (! pic_sym_p(pic, pic_obj_value(id))) { id = id->u.id.id; } @@ -67,7 +67,7 @@ pic_symbol_symbol_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_sym_p(v)); + return pic_bool_value(pic, pic_sym_p(pic, v)); } static pic_value @@ -79,14 +79,14 @@ pic_symbol_symbol_eq_p(pic_state *pic) pic_get_args(pic, "*", &argc, &argv); for (i = 0; i < argc; ++i) { - if (! pic_sym_p(argv[i])) { - return pic_false_value(); + if (! pic_sym_p(pic, argv[i])) { + return pic_false_value(pic); } - if (! pic_eq_p(argv[i], argv[0])) { - return pic_false_value(); + if (! pic_eq_p(pic, argv[i], argv[0])) { + return pic_false_value(pic); } } - return pic_true_value(); + return pic_true_value(pic); } static pic_value @@ -116,7 +116,7 @@ pic_symbol_identifier_p(pic_state *pic) pic_get_args(pic, "o", &obj); - return pic_bool_value(pic_id_p(obj)); + return pic_bool_value(pic, pic_id_p(pic, obj)); } static pic_value @@ -141,7 +141,7 @@ pic_symbol_identifier_variable(pic_state *pic) pic_assert_type(pic, id, id); - if (pic_sym_p(id)) { + if (pic_sym_p(pic, id)) { pic_errorf(pic, "expected non-symbol identifier, but got symbol ~s", id); } @@ -157,7 +157,7 @@ pic_symbol_identifier_environment(pic_state *pic) pic_assert_type(pic, id, id); - if (pic_sym_p(id)) { + if (pic_sym_p(pic, id)) { pic_errorf(pic, "expected non-symbol identifier, but got symbol ~s", id); } @@ -173,14 +173,14 @@ pic_symbol_identifier_eq_p(pic_state *pic) pic_get_args(pic, "*", &argc, &argv); for (i = 0; i < argc; ++i) { - if (! pic_id_p(argv[i])) { - return pic_false_value(); + if (! pic_id_p(pic, argv[i])) { + return pic_false_value(pic); } if (! pic_equal_p(pic, argv[i], argv[0])) { - return pic_false_value(); + return pic_false_value(pic); } } - return pic_true_value(); + return pic_true_value(pic); } void diff --git a/extlib/benz/var.c b/extlib/benz/var.c index 77e6c233..1965db92 100644 --- a/extlib/benz/var.c +++ b/extlib/benz/var.c @@ -28,7 +28,7 @@ var_set(pic_state *pic, struct pic_proc *var, pic_value val) pic_weak_set(pic, weak, var, val); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -46,7 +46,7 @@ var_call(pic_state *pic) pic_value conv; conv = pic_closure_ref(pic, 0); - if (! pic_false_p(conv)) { + if (! pic_false_p(pic, conv)) { val = pic_call(pic, pic_proc_ptr(conv), 1, val); } return var_set(pic, self, val); @@ -57,7 +57,7 @@ struct pic_proc * pic_make_var(pic_state *pic, pic_value init, struct pic_proc *conv) { struct pic_proc *var; - pic_value c = pic_false_value(); + pic_value c = pic_false_value(pic); if (conv != NULL) { c = pic_obj_value(conv); diff --git a/extlib/benz/vector.c b/extlib/benz/vector.c index 4e986ae3..af273b9b 100644 --- a/extlib/benz/vector.c +++ b/extlib/benz/vector.c @@ -14,7 +14,7 @@ pic_make_vec(pic_state *pic, int len) vec->len = len; vec->data = (pic_value *)pic_malloc(pic, sizeof(pic_value) * len); for (i = 0; i < len; ++i) { - vec->data[i] = pic_undef_value(); + vec->data[i] = pic_undef_value(pic); } return vec; } @@ -26,7 +26,7 @@ pic_vec_vector_p(pic_state *pic) pic_get_args(pic, "o", &v); - return pic_bool_value(pic_vec_p(v)); + return pic_bool_value(pic, pic_vec_p(pic, v)); } static pic_value @@ -72,7 +72,7 @@ pic_vec_vector_length(pic_state *pic) pic_get_args(pic, "v", &v); - return pic_int_value(v->len); + return pic_int_value(pic, v->len); } static pic_value @@ -102,7 +102,7 @@ pic_vec_vector_set(pic_state *pic) pic_errorf(pic, "vector-set!: index out of range"); } v->data[k] = o; - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -126,14 +126,14 @@ pic_vec_vector_copy_i(pic_state *pic) while (start < end) { to->data[--at] = from->data[--end]; } - return pic_undef_value(); + return pic_undef_value(pic); } while (start < end) { to->data[at++] = from->data[start++]; } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -211,7 +211,7 @@ pic_vec_vector_fill_i(pic_state *pic) vec->data[start++] = obj; } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -236,7 +236,7 @@ pic_vec_vector_map(pic_state *pic) vec = pic_make_vec(pic, len); for (i = 0; i < len; ++i) { - vals = pic_nil_value(); + vals = pic_nil_value(pic); for (j = 0; j < argc; ++j) { pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals); } @@ -265,14 +265,14 @@ pic_vec_vector_for_each(pic_state *pic) } for (i = 0; i < len; ++i) { - vals = pic_nil_value(); + vals = pic_nil_value(pic); for (j = 0; j < argc; ++j) { pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals); } pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals); } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -309,7 +309,7 @@ pic_vec_vector_to_list(pic_state *pic) end = vec->len; } - list = pic_nil_value(); + list = pic_nil_value(pic); for (i = start; i < end; ++i) { pic_push(pic, vec->data[i], list); @@ -343,7 +343,7 @@ pic_vec_vector_to_string(pic_state *pic) for (i = start; i < end; ++i) { pic_assert_type(pic, vec->data[i], char); - buf[i - start] = pic_char(vec->data[i]); + buf[i - start] = pic_char(pic, vec->data[i]); } str = pic_make_str(pic, buf, end - start); @@ -365,7 +365,7 @@ pic_vec_string_to_vector(pic_state *pic) case 1: start = 0; case 2: - end = pic_str_len(str); + end = pic_str_len(pic, str); } if (end < start) { @@ -375,7 +375,7 @@ pic_vec_string_to_vector(pic_state *pic) vec = pic_make_vec(pic, end - start); for (i = 0; i < end - start; ++i) { - vec->data[i] = pic_char_value(pic_str_ref(pic, str, i + start)); + vec->data[i] = pic_char_value(pic, pic_str_ref(pic, str, i + start)); } return pic_obj_value(vec); } diff --git a/extlib/benz/weak.c b/extlib/benz/weak.c index 635bd260..6dda9cd8 100644 --- a/extlib/benz/weak.c +++ b/extlib/benz/weak.c @@ -38,7 +38,7 @@ pic_weak_rev_ref(pic_state *pic, struct pic_weak *weak, pic_value val) if (h->n_buckets) { khint_t i = 0; - while ((i < h->n_buckets) && (ac_iseither(h->flags, i) || !pic_eq_p(h->vals[i], val))) { + while ((i < h->n_buckets) && (ac_iseither(h->flags, i) || !pic_eq_p(pic, h->vals[i], val))) { i += 1; } if (i < h->n_buckets) return kh_key(h, i); @@ -82,7 +82,7 @@ static pic_value weak_get(pic_state *pic, struct pic_weak *weak, void *key) { if (! pic_weak_has(pic, weak, key)) { - return pic_false_value(); + return pic_false_value(pic); } return pic_cons(pic, pic_obj_value(key), pic_weak_ref(pic, weak, key)); } @@ -90,7 +90,7 @@ weak_get(pic_state *pic, struct pic_weak *weak, void *key) static pic_value weak_set(pic_state *pic, struct pic_weak *weak, void *key, pic_value val) { - if (pic_undef_p(val)) { + if (pic_undef_p(pic, val)) { if (pic_weak_has(pic, weak, key)) { pic_weak_del(pic, weak, key); } @@ -98,7 +98,7 @@ weak_set(pic_state *pic, struct pic_weak *weak, void *key, pic_value val) pic_weak_set(pic, weak, key, val); } - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -111,7 +111,7 @@ weak_call(pic_state *pic) n = pic_get_args(pic, "&o|o", &self, &key, &val); - if (! pic_obj_p(key)) { + if (! pic_obj_p(pic, key)) { pic_errorf(pic, "attempted to set a non-object key '~s' in an ephemeron", key); } diff --git a/extlib/benz/write.c b/extlib/benz/write.c index 0c86fcb8..4cd4da89 100644 --- a/extlib/benz/write.c +++ b/extlib/benz/write.c @@ -92,7 +92,7 @@ write_str(pic_state *pic, struct pic_string *str, xFILE *file, int mode) return; } xfprintf(pic, file, "\""); - for (i = 0; i < pic_str_len(str); ++i) { + for (i = 0; i < pic_str_len(pic, str); ++i) { if (cstr[i] == '"' || cstr[i] == '\\') { xfputc(pic, '\\', file); } @@ -128,10 +128,10 @@ write_pair_help(struct writer_control *p, struct pic_pair *pair) write_core(p, pair->car); - if (pic_nil_p(pair->cdr)) { + if (pic_nil_p(pic, pair->cdr)) { return; } - else if (pic_pair_p(pair->cdr)) { + else if (pic_pair_p(pic, pair->cdr)) { /* shared objects */ if ((it = kh_get(l, lh, pic_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) { @@ -171,7 +171,7 @@ write_pair(struct writer_control *p, struct pic_pair *pair) xFILE *file = p->file; pic_sym *tag; - if (pic_pair_p(pair->cdr) && pic_nil_p(pic_cdr(pic, pair->cdr)) && pic_sym_p(pair->car)) { + if (pic_pair_p(pic, pair->cdr) && pic_nil_p(pic, pic_cdr(pic, pair->cdr)) && pic_sym_p(pic, pair->car)) { tag = pic_sym_ptr(pair->car); if (tag == pic->sQUOTE) { xfprintf(pic, file, "'"); @@ -263,7 +263,7 @@ write_core(struct writer_control *p, pic_value obj) int ret; /* shared objects */ - if (pic_vtype(obj) == PIC_VTYPE_HEAP && ((it = kh_get(l, lh, pic_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) { + if (pic_obj_p(pic, obj) && ((it = kh_get(l, lh, pic_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) { kh_put(v, vh, pic_ptr(obj), &ret); if (ret == 0) { /* if exists */ xfprintf(pic, file, "#%d#", kh_val(lh, it)); @@ -272,7 +272,7 @@ write_core(struct writer_control *p, pic_value obj) xfprintf(pic, file, "#%d=", kh_val(lh, it)); } - switch (pic_type(obj)) { + switch (pic_type(pic, obj)) { case PIC_TT_UNDEF: xfprintf(pic, file, "#undefined"); break; @@ -280,7 +280,7 @@ write_core(struct writer_control *p, pic_value obj) xfprintf(pic, file, "()"); break; case PIC_TT_BOOL: - xfprintf(pic, file, pic_true_p(obj) ? "#t" : "#f"); + xfprintf(pic, file, pic_true_p(pic, obj) ? "#t" : "#f"); break; case PIC_TT_ID: xfprintf(pic, file, "#", pic_identifier_name(pic, pic_id_ptr(obj))); @@ -289,10 +289,10 @@ write_core(struct writer_control *p, pic_value obj) xfprintf(pic, file, "#.(eof-object)"); break; case PIC_TT_INT: - xfprintf(pic, file, "%d", pic_int(obj)); + xfprintf(pic, file, "%d", pic_int(pic, obj)); break; case PIC_TT_FLOAT: - write_float(pic, pic_float(obj), file); + write_float(pic, pic_float(pic, obj), file); break; case PIC_TT_SYMBOL: xfprintf(pic, file, "%s", pic_symbol_name(pic, pic_sym_ptr(obj))); @@ -301,7 +301,7 @@ write_core(struct writer_control *p, pic_value obj) write_blob(pic, pic_blob_ptr(obj), file); break; case PIC_TT_CHAR: - write_char(pic, pic_char(obj), file, p->mode); + write_char(pic, pic_char(pic, obj), file, p->mode); break; case PIC_TT_STRING: write_str(pic, pic_str_ptr(obj), file, p->mode); @@ -316,12 +316,12 @@ write_core(struct writer_control *p, pic_value obj) write_dict(p, pic_dict_ptr(obj)); break; default: - xfprintf(pic, file, "#<%s %p>", pic_type_repr(pic_type(obj)), pic_ptr(obj)); + xfprintf(pic, file, "#<%s %p>", pic_type_repr(pic, pic_type(pic, obj)), pic_ptr(obj)); break; } if (p->op == OP_WRITE) { - if (pic_obj_p(obj) && ((it = kh_get(l, lh, pic_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) { + if (pic_obj_p(pic, obj) && ((it = kh_get(l, lh, pic_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) { it = kh_get(v, vh, pic_ptr(obj)); kh_del(v, vh, it); } @@ -337,7 +337,7 @@ traverse(struct writer_control *p, pic_value obj) return; } - switch (pic_type(obj)) { + switch (pic_type(pic, obj)) { case PIC_TT_PAIR: case PIC_TT_VECTOR: case PIC_TT_DICT: { @@ -350,11 +350,11 @@ traverse(struct writer_control *p, pic_value obj) /* first time */ kh_val(h, it) = -1; - if (pic_pair_p(obj)) { + if (pic_pair_p(pic, obj)) { /* pair */ traverse(p, pic_car(pic, obj)); traverse(p, pic_cdr(pic, obj)); - } else if (pic_vec_p(obj)) { + } else if (pic_vec_p(pic, obj)) { /* vector */ int i; for (i = 0; i < pic_vec_ptr(obj)->len; ++i) { @@ -453,7 +453,7 @@ pic_write_write(pic_state *pic) pic_get_args(pic, "o|p", &v, &port); write(pic, v, port->file, WRITE_MODE, OP_WRITE); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -464,7 +464,7 @@ pic_write_write_simple(pic_state *pic) pic_get_args(pic, "o|p", &v, &port); write(pic, v, port->file, WRITE_MODE, OP_WRITE_SIMPLE); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -475,7 +475,7 @@ pic_write_write_shared(pic_state *pic) pic_get_args(pic, "o|p", &v, &port); write(pic, v, port->file, WRITE_MODE, OP_WRITE_SHARED); - return pic_undef_value(); + return pic_undef_value(pic); } static pic_value @@ -486,7 +486,7 @@ pic_write_display(pic_state *pic) pic_get_args(pic, "o|p", &v, &port); write(pic, v, port->file, DISPLAY_MODE, OP_WRITE); - return pic_undef_value(); + return pic_undef_value(pic); } void