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

fixing parameter separation between environments

Browse source
This commit is contained in:
Alex Shinn 2009-04-03 19:02:29 +09:00
parent 55841679e8
commit d33c766823
3 changed files with 18 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
eval.c
View file

@ -721,6 +721,7 @@ static void generate_opcode_app (sexp app, sexp context) {
case OPC_PARAMETER:
emit_push(sexp_opcode_default(op), context);
emit((num_args == 0 ? OP_CDR : OP_SET_CDR), context);
break;
default:
emit(sexp_opcode_code(op), context);
}
@ -1515,6 +1516,7 @@ sexp sexp_close_port (sexp port) {
sexp sexp_load (sexp source, sexp env) {
sexp obj, res, in, context = sexp_make_context(NULL, env);
sexp_context_tailp(context) = 0;
in = sexp_open_input_file(source);
while ((obj=sexp_read(in)) != (sexp) SEXP_EOF) {
res = eval_in_context(obj, context);
@ -1648,8 +1650,6 @@ static struct sexp_struct core_forms[] = {
#include "opcodes.c"
static int standard_env_syms_interned_p = 0;
static sexp sexp_make_null_env (sexp version) {
sexp_uint_t i;
sexp e = sexp_alloc_type(env, SEXP_ENV);
@ -1660,14 +1660,19 @@ static sexp sexp_make_null_env (sexp version) {
return e;
}
static sexp sexp_copy_opcode (sexp op) {
sexp res = sexp_alloc_type(opcode, SEXP_OPCODE);
memcpy(res, op, sexp_sizeof(opcode));
return res;
}
static sexp sexp_make_standard_env (sexp version) {
sexp_uint_t i;
sexp e = sexp_make_null_env(version), op, cell, sym;
for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) {
op = &opcodes[i];
if ((! standard_env_syms_interned_p)
&& sexp_opcode_opt_param_p(op)
&& sexp_opcode_default(op)) {
if (sexp_opcode_opt_param_p(op) && sexp_opcode_default(op)) {
op = sexp_copy_opcode(op);
sym = sexp_intern((char*)sexp_opcode_default(op));
cell = env_cell_create(e, sym, SEXP_VOID);
sexp_opcode_default(op) = cell;
@ -1678,7 +1683,6 @@ static sexp sexp_make_standard_env (sexp version) {
env_define(e, the_cur_out_symbol, sexp_make_output_port(stdout));
env_define(e, the_cur_err_symbol, sexp_make_output_port(stderr));
env_define(e, the_interaction_env_symbol, e);
standard_env_syms_interned_p = 1;
return e;
}

10
main.c
View file

@ -30,6 +30,7 @@ void run_main (int argc, char **argv) {
sexp_uint_t i, quit=0, init_loaded=0;
env = sexp_make_standard_env(sexp_make_integer(5));
env_define(env, the_interaction_env_symbol, env);
context = sexp_make_context(NULL, env);
sexp_context_tailp(context) = 0;
emit_push(SEXP_VOID, context);
@ -46,10 +47,8 @@ void run_main (int argc, char **argv) {
#if USE_STRING_STREAMS
case 'e':
case 'p':
if (! init_loaded) {
if (! init_loaded++)
sexp_load(sexp_c_string(sexp_init_file), env);
init_loaded = 1;
}
obj = sexp_read_from_string(argv[i+1]);
res = eval_in_context(obj, context);
if (argv[i][1] == 'p') {
@ -62,6 +61,11 @@ void run_main (int argc, char **argv) {
i++;
break;
#endif
case 'l':
if (! init_loaded++)
sexp_load(sexp_c_string(sexp_init_file), env);
sexp_load(sexp_c_string(argv[++i]), env);
break;
case 'q':
init_loaded = 1;
break;

2
sexp.c
View file

@ -599,7 +599,7 @@ void sexp_write (sexp obj, sexp out) {
case SEXP_BYTECODE:
sexp_write_string("#<bytecode>", out); break;
case SEXP_ENV:
sexp_write_string("#<env>", out); break;
sexp_printf(out, "#<env %p>", obj); break;
case SEXP_EXCEPTION:
sexp_write_string("#<exception>", out); break;
case SEXP_MACRO: