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

add pic_state parameter (to be used by copy gc)

This commit is contained in:
Yuichi Nishiwaki 2016-02-18 20:15:42 +09:00
parent a3f9a3be68
commit 615bdff61a
49 changed files with 644 additions and 649 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
contrib/10.callcc/callcc.c
View File

@ -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

76
contrib/10.math/math.c
View File

@ -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

8
contrib/20.r7rs/src/file.c
View File

@ -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

2
contrib/20.r7rs/src/load.c
View File

@ -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

14
contrib/20.r7rs/src/mutable-string.c
View File

@ -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

20
contrib/20.r7rs/src/system.c
View File

@ -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) {

6
contrib/20.r7rs/src/time.c
View File

@ -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

2
contrib/30.random/src/random.c
View File

@ -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

36
contrib/30.readline/src/readline.c
View File

@ -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

20
contrib/30.regexp/src/regexp.c
View File

@ -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), &regexp_type))
#define pic_regexp_p(pic, o) (pic_data_type_p(pic, (o), &regexp_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", &reg, &input);

96
contrib/40.srfi/src/106.c
View File

@ -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
}

2
contrib/60.repl/repl.c
View File

@ -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

2
docs/capi.rst
View File

@ -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

2
extlib/benz/README.md
View File

@ -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

24
extlib/benz/blob.c
View File

@ -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);
}

40
extlib/benz/bool.c
View File

@ -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

16
extlib/benz/char.c
View File

@ -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)

10
extlib/benz/cont.c
View File

@ -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

4
extlib/benz/debug.c
View File

@ -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 {

20
extlib/benz/dict.c
View File

@ -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));
}

6
extlib/benz/error.c
View File

@ -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

52
extlib/benz/eval.c
View File

@ -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:

10
extlib/benz/gc.c
View File

@ -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;
}

124
extlib/benz/include/picrin.h
View File

@ -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) \

4
extlib/benz/include/picrin/data.h
View File

@ -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 *);

2
extlib/benz/include/picrin/error.h
View File

@ -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);

2
extlib/benz/include/picrin/macro.h
View File

@ -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 *);

6
extlib/benz/include/picrin/pair.h
View File

@ -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);
@ -54,7 +54,7 @@ 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)) \
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))

1
extlib/benz/include/picrin/port.h
View File

@ -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();

2
extlib/benz/include/picrin/proc.h
View File

@ -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 *);

2
extlib/benz/include/picrin/record.h
View File

@ -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);

2
extlib/benz/include/picrin/symbol.h
View File

@ -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 *);

81
extlib/benz/include/picrin/type.h
View File

@ -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);
}

12
extlib/benz/lib.c
View File

@ -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;

2
extlib/benz/load.c
View File

@ -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);

24
extlib/benz/macro.c
View File

@ -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);

70
extlib/benz/number.c
View File

@ -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

88
extlib/benz/pair.c
View File

@ -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

71
extlib/benz/port.c
View File

@ -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

62
extlib/benz/proc.c
View File

@ -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

90
extlib/benz/read.c
View File

@ -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);

2
extlib/benz/record.c
View File

@ -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

6
extlib/benz/state.c
View File

@ -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);

58
extlib/benz/string.c
View File

@ -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);
}

28
extlib/benz/symbol.c
View File

@ -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

6
extlib/benz/var.c
View File

@ -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);

28
extlib/benz/vector.c
View File

@ -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);
}

10
extlib/benz/weak.c
View File

@ -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);
}

38
extlib/benz/write.c
View File

@ -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, "#<identifier %s>", 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