Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 06:39:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

supporting parameter converters on mutation, not just parameterize.

Browse source 
also fixing bug in interaction-environment parameter from default repl.
This commit is contained in:
Alex Shinn 2010-09-24 22:46:01 +09:00
parent 2144164793
commit 83e91a20c7
3 changed files with 40 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
eval.c
View file

@ -1373,7 +1373,6 @@ sexp sexp_make_opcode (sexp ctx, sexp self, sexp name, sexp op_class, sexp code,
sexp num_args, sexp flags, sexp arg1t, sexp arg2t,
sexp invp, sexp data, sexp data2, sexp_proc1 func) {
sexp res;
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, name);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, num_args);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, flags);
if ((! sexp_fixnump(op_class)) || (sexp_unbox_fixnum(op_class) <= 0)
@ -1394,7 +1393,7 @@ sexp sexp_make_opcode (sexp ctx, sexp self, sexp name, sexp op_class, sexp code,
sexp_opcode_data(res) = data;
sexp_opcode_data2(res) = data2;
sexp_opcode_func(res) = func;
sexp_opcode_name(res) = strdup(sexp_string_data(name));
sexp_opcode_name(res) = sexp_stringp(name) ? strdup(sexp_string_data(name)) : "";
}
return res;
}

2
main.c
View file

@ -33,8 +33,6 @@ static void repl (sexp ctx) {
sexp_gc_preserve4(ctx, obj, tmp, res, env);
env = sexp_make_env(ctx);
sexp_env_parent(env) = sexp_context_env(ctx);
sexp_env_define(ctx, sexp_context_env(ctx),
sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), env);
sexp_context_tracep(ctx) = 1;
in = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
out = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL));

67
vm.c
View file

@ -197,34 +197,36 @@ static void generate_opcode_app (sexp ctx, sexp app) {
num_args = sexp_unbox_fixnum(sexp_length(ctx, sexp_cdr(app)));
sexp_context_tailp(ctx) = 0;
/* maybe push the default for an optional argument */
if ((num_args == sexp_opcode_num_args(op))
&& sexp_opcode_variadic_p(op)
&& sexp_opcode_data(op)
&& (sexp_opcode_class(op) != SEXP_OPC_PARAMETER)) {
if (sexp_opcode_inverse(op)) {
inv_default = 1;
} else {
emit_push(ctx, sexp_opcode_data(op));
if (sexp_opcode_opt_param_p(op)) {
#if SEXP_USE_GREEN_THREADS
emit(ctx, SEXP_OP_PARAMETER_REF);
emit_word(ctx, (sexp_uint_t)sexp_opcode_data(op));
sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), sexp_opcode_data(op));
#endif
emit(ctx, SEXP_OP_CDR);
}
sexp_context_depth(ctx)++;
num_args++;
}
}
if (sexp_opcode_class(op) != SEXP_OPC_PARAMETER) {
/* push the arguments onto the stack in reverse order */
ls = ((sexp_opcode_inverse(op)
&& (sexp_opcode_class(op) != SEXP_OPC_ARITHMETIC))
? sexp_cdr(app) : sexp_reverse(ctx, sexp_cdr(app)));
for ( ; sexp_pairp(ls); ls = sexp_cdr(ls))
generate(ctx, sexp_car(ls));
/* maybe push the default for an optional argument */
if ((num_args == sexp_opcode_num_args(op))
&& sexp_opcode_variadic_p(op) && sexp_opcode_data(op)) {
if (sexp_opcode_inverse(op)) {
inv_default = 1;
} else {
emit_push(ctx, sexp_opcode_data(op));
if (sexp_opcode_opt_param_p(op)) {
#if SEXP_USE_GREEN_THREADS
emit(ctx, SEXP_OP_PARAMETER_REF);
emit_word(ctx, (sexp_uint_t)sexp_opcode_data(op));
sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), sexp_opcode_data(op));
#endif
emit(ctx, SEXP_OP_CDR);
}
sexp_context_depth(ctx)++;
num_args++;
}
}
/* push the arguments onto the stack in reverse order */
ls = ((sexp_opcode_inverse(op)
&& (sexp_opcode_class(op) != SEXP_OPC_ARITHMETIC))
? sexp_cdr(app) : sexp_reverse(ctx, sexp_cdr(app)));
for ( ; sexp_pairp(ls); ls = sexp_cdr(ls))
generate(ctx, sexp_car(ls));
}
/* push the default for inverse opcodes */
if (inv_default) {
@ -280,10 +282,19 @@ static void generate_opcode_app (sexp ctx, sexp app) {
break;
case SEXP_OPC_PARAMETER:
#if SEXP_USE_GREEN_THREADS
if (num_args > 0) {
if (sexp_opcode_data2(op) && sexp_applicablep(sexp_opcode_data2(op))) {
ls = sexp_list2(ctx, sexp_opcode_data2(op), sexp_cadr(app));
generate(ctx, ls);
} else {
generate(ctx, sexp_cadr(app));
}
}
emit(ctx, SEXP_OP_PARAMETER_REF);
emit_word(ctx, (sexp_uint_t)op);
sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), op);
#else
if (num_args > 0) generate(ctx, sexp_cadr(app));
emit_push(ctx, sexp_opcode_data(op));
#endif
emit(ctx, ((num_args == 0) ? SEXP_OP_CDR : SEXP_OP_SET_CDR));
@ -801,7 +812,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
tmp2 = _WORD0;
ip += sizeof(sexp);
for (tmp1=sexp_context_params(ctx); sexp_pairp(tmp1); tmp1=sexp_cdr(tmp1))
if (sexp_car(tmp1) == tmp2) {
if (sexp_caar(tmp1) == tmp2) {
_PUSH(sexp_car(tmp1));
goto loop;
}