mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 22:29:16 +02:00
Hygiene change. Removing syntactic closure flattening to
support unhygienic insertion. Breaks the previous assumption that syntactic closures were never nested.
This commit is contained in:
Alex Shinn
parent
8e32a64426
commit
b638b9f1b4
9 changed files with 111 additions and 90 deletions
151
eval.c
151
eval.c
|
|
@ -80,17 +80,21 @@ sexp sexp_maybe_wrap_error (sexp ctx, sexp obj) {
|
|||
|
||||
/* Look for the first defined instance of the variable. If not found, */
|
||||
/* return the first undefined instance. */
|
||||
static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) {
|
||||
sexp ls, undefined = NULL, undefined_env = NULL;
|
||||
static sexp sexp_env_cell_loc1 (sexp env, sexp key, int localp, sexp *varenv,
|
||||
sexp *undefined, sexp *undefined_env) {
|
||||
sexp ls;
|
||||
|
||||
do {
|
||||
#if SEXP_USE_RENAME_BINDINGS
|
||||
for (ls=sexp_env_renames(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
|
||||
if (sexp_car(ls) == key) {
|
||||
/* export-all hack - if this cell is undefined, only use it if */
|
||||
/* there is no other defined cell that matches. */
|
||||
/* TODO: order the environments properly and remove this */
|
||||
if (sexp_pairp(sexp_cdr(ls)) && sexp_cdr(sexp_cdr(ls)) == SEXP_UNDEF) {
|
||||
if (!undefined) {
|
||||
undefined_env = env;
|
||||
undefined = sexp_cdr(ls);
|
||||
*undefined_env = env;
|
||||
*undefined = sexp_cdr(ls);
|
||||
}
|
||||
} else {
|
||||
if (varenv) *varenv = env;
|
||||
|
|
@ -102,8 +106,8 @@ static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) {
|
|||
if (sexp_car(ls) == key) {
|
||||
if (sexp_cdr(ls) == SEXP_UNDEF) {
|
||||
if (!undefined) {
|
||||
undefined_env = env;
|
||||
undefined = ls;
|
||||
*undefined_env = env;
|
||||
*undefined = ls;
|
||||
}
|
||||
} else {
|
||||
if (varenv) *varenv = env;
|
||||
|
|
@ -113,16 +117,28 @@ static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) {
|
|||
env = (localp ? NULL : sexp_env_parent(env));
|
||||
} while (env && sexp_envp(env));
|
||||
|
||||
if (undefined) {
|
||||
if (varenv) *varenv = undefined_env;
|
||||
return undefined;
|
||||
}
|
||||
|
||||
return NULL;
|
||||
}
|
||||
|
||||
sexp sexp_env_cell (sexp env, sexp key, int localp) {
|
||||
return sexp_env_cell_loc(env, key, localp, NULL);
|
||||
static sexp sexp_env_cell_loc (sexp ctx, sexp env, sexp key, int localp, sexp *varenv) {
|
||||
sexp cell, undefined = NULL, undefined_env = NULL;
|
||||
cell = sexp_env_cell_loc1(env, key, localp, varenv, &undefined, &undefined_env);
|
||||
while (!cell && sexp_synclop(key)) {
|
||||
if (sexp_not(sexp_memq(ctx, sexp_synclo_expr(key), sexp_context_fv(ctx)))
|
||||
&& sexp_not(sexp_memq(ctx, sexp_synclo_expr(key), sexp_synclo_free_vars(key))))
|
||||
env = sexp_synclo_env(key);
|
||||
key = sexp_synclo_expr(key);
|
||||
cell = sexp_env_cell_loc1(env, key, 0, varenv, &undefined, &undefined_env);
|
||||
}
|
||||
if (!cell && undefined) {
|
||||
if (varenv) *varenv = undefined_env;
|
||||
return undefined;
|
||||
}
|
||||
return cell;
|
||||
}
|
||||
|
||||
sexp sexp_env_cell (sexp ctx, sexp env, sexp key, int localp) {
|
||||
return sexp_env_cell_loc(ctx, env, key, localp, NULL);
|
||||
}
|
||||
|
||||
static sexp sexp_env_undefine (sexp ctx, sexp env, sexp key) {
|
||||
|
|
@ -164,13 +180,13 @@ sexp sexp_env_cell_define (sexp ctx, sexp env, sexp key,
|
|||
|
||||
static sexp sexp_env_cell_create (sexp ctx, sexp env, sexp key,
|
||||
sexp value, sexp *varenv) {
|
||||
sexp cell = sexp_env_cell_loc(env, key, 0, varenv);
|
||||
sexp cell = sexp_env_cell_loc(ctx, env, key, 0, varenv);
|
||||
if (!cell) cell = sexp_env_cell_define(ctx, env, key, value, varenv);
|
||||
return cell;
|
||||
}
|
||||
|
||||
sexp sexp_env_ref (sexp env, sexp key, sexp dflt) {
|
||||
sexp cell = sexp_env_cell(env, key, 0);
|
||||
sexp sexp_env_ref (sexp ctx, sexp env, sexp key, sexp dflt) {
|
||||
sexp cell = sexp_env_cell(ctx, env, key, 0);
|
||||
return (cell ? sexp_cdr(cell) : dflt);
|
||||
}
|
||||
|
||||
|
|
@ -178,7 +194,7 @@ sexp sexp_env_define (sexp ctx, sexp env, sexp key, sexp value) {
|
|||
sexp cell, tmp, res = SEXP_VOID;
|
||||
if (sexp_immutablep(env))
|
||||
return sexp_user_exception(ctx, NULL, "immutable binding", key);
|
||||
cell = sexp_env_cell(env, key, 1);
|
||||
cell = sexp_env_cell(ctx, env, key, 1);
|
||||
if (!cell) {
|
||||
sexp_env_push(ctx, env, tmp, key, value);
|
||||
} else if (sexp_immutablep(cell)) {
|
||||
|
|
@ -267,18 +283,27 @@ static sexp sexp_flatten_dot (sexp ctx, sexp ls) {
|
|||
return sexp_nreverse(ctx, sexp_reverse_flatten_dot(ctx, ls));
|
||||
}
|
||||
|
||||
int sexp_param_index (sexp lambda, sexp name) {
|
||||
sexp ls = sexp_lambda_params(lambda);
|
||||
int i = 0;
|
||||
for (i=0; sexp_pairp(ls); ls=sexp_cdr(ls), i++)
|
||||
if (sexp_car(ls) == name)
|
||||
int sexp_param_index (sexp ctx, sexp lambda, sexp name) {
|
||||
sexp ls;
|
||||
int i;
|
||||
while (1) {
|
||||
i = 0;
|
||||
ls = sexp_lambda_params(lambda);
|
||||
for (i=0; sexp_pairp(ls); ls=sexp_cdr(ls), i++)
|
||||
if (sexp_car(ls) == name)
|
||||
return i;
|
||||
if (ls == name)
|
||||
return i;
|
||||
if (ls == name)
|
||||
return i;
|
||||
ls = sexp_lambda_locals(lambda);
|
||||
for (i=-1; sexp_pairp(ls); ls=sexp_cdr(ls), i--)
|
||||
if (sexp_car(ls) == name)
|
||||
return i-4;
|
||||
ls = sexp_lambda_locals(lambda);
|
||||
for (i=-1; sexp_pairp(ls); ls=sexp_cdr(ls), i--)
|
||||
if (sexp_car(ls) == name)
|
||||
return i-4;
|
||||
if (sexp_synclop(name))
|
||||
name = sexp_synclo_expr(name);
|
||||
else
|
||||
break;
|
||||
}
|
||||
sexp_warn(ctx, "can't happen: no argument: ", name);
|
||||
return -10000;
|
||||
}
|
||||
|
||||
|
|
@ -384,7 +409,7 @@ sexp sexp_make_synclo_op (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp fv,
|
|||
if (! (sexp_symbolp(expr) || sexp_pairp(expr) || sexp_synclop(expr)))
|
||||
return expr;
|
||||
res = sexp_alloc_type(ctx, synclo, SEXP_SYNCLO);
|
||||
if (sexp_synclop(expr)) {
|
||||
if (SEXP_USE_FLAT_SYNTACTIC_CLOSURES && sexp_synclop(expr)) {
|
||||
sexp_synclo_env(res) = sexp_synclo_env(expr);
|
||||
sexp_synclo_free_vars(res) = sexp_synclo_free_vars(expr);
|
||||
sexp_synclo_expr(res) = sexp_synclo_expr(expr);
|
||||
|
|
@ -566,6 +591,11 @@ sexp sexp_make_child_context (sexp ctx, sexp lambda) {
|
|||
|
||||
/**************************** identifiers *****************************/
|
||||
|
||||
int sexp_idp (sexp x) {
|
||||
while (sexp_synclop(x)) x = sexp_synclo_expr(x);
|
||||
return sexp_symbolp(x);
|
||||
}
|
||||
|
||||
sexp sexp_identifierp_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
|
||||
return sexp_make_boolean(sexp_idp(x));
|
||||
}
|
||||
|
|
@ -596,18 +626,8 @@ sexp sexp_strip_synclos (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
|
|||
|
||||
sexp sexp_identifier_eq_op (sexp ctx, sexp self, sexp_sint_t n, sexp e1, sexp id1, sexp e2, sexp id2) {
|
||||
sexp cell1, cell2;
|
||||
cell1 = sexp_env_cell(e1, id1, 0);
|
||||
if (!cell1 && sexp_synclop(id1)) {
|
||||
e1 = sexp_synclo_env(id1);
|
||||
id1 = sexp_synclo_expr(id1);
|
||||
cell1 = sexp_env_cell(e1, id1, 0);
|
||||
}
|
||||
cell2 = sexp_env_cell(e2, id2, 0);
|
||||
if (!cell2 && sexp_synclop(id2)) {
|
||||
e2 = sexp_synclo_env(id2);
|
||||
id2 = sexp_synclo_expr(id2);
|
||||
cell2 = sexp_env_cell(e2, id2, 0);
|
||||
}
|
||||
cell1 = sexp_env_cell(ctx, e1, id1, 0);
|
||||
cell2 = sexp_env_cell(ctx, e2, id2, 0);
|
||||
if (cell1 && (cell1 == cell2))
|
||||
return SEXP_TRUE;
|
||||
else if (!cell1 && !cell2 && (id1 == id2))
|
||||
|
|
@ -616,10 +636,16 @@ sexp sexp_identifier_eq_op (sexp ctx, sexp self, sexp_sint_t n, sexp e1, sexp id
|
|||
/* If the identifiers are the same and the cells are either unbound *
|
||||
* or bound to top-level variables, consider them the same. Local *
|
||||
* (non-toplevel) bindings must still match exactly. */
|
||||
else if ((id1 == id2)
|
||||
&& (!cell1 || !sexp_lambdap(sexp_cdr(cell1)))
|
||||
&& (!cell2 || !sexp_lambdap(sexp_cdr(cell2))))
|
||||
return SEXP_TRUE;
|
||||
else {
|
||||
while (sexp_synclop(id1))
|
||||
id1 = sexp_synclo_expr(id1);
|
||||
while (sexp_synclop(id2))
|
||||
id2 = sexp_synclo_expr(id2);
|
||||
if ((id1 == id2)
|
||||
&& (!cell1 || !sexp_lambdap(sexp_cdr(cell1)))
|
||||
&& (!cell2 || !sexp_lambdap(sexp_cdr(cell2))))
|
||||
return SEXP_TRUE;
|
||||
}
|
||||
#endif
|
||||
return SEXP_FALSE;
|
||||
}
|
||||
|
|
@ -681,20 +707,15 @@ static sexp analyze_var_ref (sexp ctx, sexp x, sexp *varenv) {
|
|||
sexp env = sexp_context_env(ctx), res;
|
||||
sexp_gc_var1(cell);
|
||||
sexp_gc_preserve1(ctx, cell);
|
||||
cell = sexp_env_cell_loc(env, x, 0, varenv);
|
||||
cell = sexp_env_cell_loc(ctx, env, x, 0, varenv);
|
||||
if (! cell) {
|
||||
if (sexp_synclop(x)) {
|
||||
if (sexp_not(sexp_memq(ctx, sexp_synclo_expr(x), sexp_context_fv(ctx)))
|
||||
&& sexp_not(sexp_memq(ctx, sexp_synclo_expr(x), sexp_synclo_free_vars(x))))
|
||||
env = sexp_synclo_env(x);
|
||||
x = sexp_synclo_expr(x);
|
||||
}
|
||||
while (sexp_synclop(x)) x = sexp_synclo_expr(x);
|
||||
cell = sexp_env_cell_create(ctx, env, x, SEXP_UNDEF, varenv);
|
||||
}
|
||||
if (sexp_macrop(sexp_cdr(cell)) || sexp_corep(sexp_cdr(cell))) {
|
||||
res = sexp_compile_error(ctx, "invalid use of syntax as value", x);
|
||||
} else {
|
||||
res = sexp_make_ref(ctx, x, cell);
|
||||
res = sexp_make_ref(ctx, sexp_car(cell), cell);
|
||||
}
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
|
|
@ -853,7 +874,7 @@ static sexp analyze_define (sexp ctx, sexp x, int depth) {
|
|||
value = analyze_lambda(ctx, tmp, depth);
|
||||
} else
|
||||
value = analyze(ctx, sexp_caddr(x), depth);
|
||||
tmp = sexp_env_cell_loc(env, name, 0, &varenv);
|
||||
tmp = sexp_env_cell_loc(ctx, env, name, 0, &varenv);
|
||||
ref = sexp_make_ref(ctx, name, tmp);
|
||||
if (sexp_exceptionp(ref)) {
|
||||
res = ref;
|
||||
|
|
@ -883,7 +904,7 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
|
|||
break;
|
||||
} else {
|
||||
if (sexp_idp(sexp_cadar(ls)))
|
||||
mac = sexp_env_ref(sexp_context_env(eval_ctx), sexp_cadar(ls), SEXP_FALSE);
|
||||
mac = sexp_env_ref(eval_ctx, sexp_context_env(eval_ctx), sexp_cadar(ls), SEXP_FALSE);
|
||||
else
|
||||
mac = sexp_eval(eval_ctx, sexp_cadar(ls), NULL);
|
||||
if (sexp_procedurep(mac))
|
||||
|
|
@ -962,11 +983,7 @@ static sexp analyze (sexp ctx, sexp object, int depth) {
|
|||
if (sexp_not(sexp_listp(ctx, x))) {
|
||||
res = sexp_compile_error(ctx, "dotted list in source", x);
|
||||
} else if (sexp_idp(sexp_car(x))) {
|
||||
cell = sexp_env_cell(sexp_context_env(ctx), sexp_car(x), 0);
|
||||
if (! cell && sexp_synclop(sexp_car(x)))
|
||||
cell = sexp_env_cell(sexp_synclo_env(sexp_car(x)),
|
||||
sexp_synclo_expr(sexp_car(x)),
|
||||
0);
|
||||
cell = sexp_env_cell(ctx, sexp_context_env(ctx), sexp_car(x), 0);
|
||||
if (! cell) {
|
||||
res = analyze_app(ctx, x, depth);
|
||||
if (sexp_exceptionp(res))
|
||||
|
|
@ -1951,7 +1968,7 @@ sexp sexp_define_foreign_param (sexp ctx, sexp env, const char *name,
|
|||
sexp_gc_var1(tmp);
|
||||
sexp_gc_preserve1(ctx, tmp);
|
||||
tmp = sexp_intern(ctx, param, -1);
|
||||
tmp = sexp_env_ref(env, tmp, SEXP_FALSE);
|
||||
tmp = sexp_env_ref(ctx, env, tmp, SEXP_FALSE);
|
||||
if (sexp_opcodep(tmp))
|
||||
res = sexp_define_foreign_aux(ctx, env, name, num_args, 3, f, tmp);
|
||||
sexp_gc_release1(ctx);
|
||||
|
|
@ -2017,7 +2034,7 @@ sexp sexp_make_primitive_env_op (sexp ctx, sexp self, sexp_sint_t n, sexp versio
|
|||
sexp_opcode_name(op) = sexp_c_string(ctx, (char*)sexp_opcode_name(op), -1);
|
||||
if (sexp_opcode_opt_param_p(op) && sexp_opcode_data(op)) {
|
||||
sym = sexp_intern(ctx, (char*)sexp_opcode_data(op), -1);
|
||||
sexp_opcode_data(op) = sexp_env_ref(e, sym, SEXP_FALSE);
|
||||
sexp_opcode_data(op) = sexp_env_ref(ctx, e, sym, SEXP_FALSE);
|
||||
} else if (sexp_opcode_class(op) == SEXP_OPC_PARAMETER) {
|
||||
sexp_opcode_data(op) = sexp_cons(ctx, name, SEXP_FALSE);
|
||||
}
|
||||
|
|
@ -2160,7 +2177,7 @@ sexp sexp_thread_parameters_set (sexp ctx, sexp self, sexp_sint_t n, sexp new) {
|
|||
}
|
||||
|
||||
void sexp_set_parameter (sexp ctx, sexp env, sexp name, sexp value) {
|
||||
sexp param = sexp_env_ref(env, name, SEXP_FALSE);
|
||||
sexp param = sexp_env_ref(ctx, env, name, SEXP_FALSE);
|
||||
if (sexp_opcodep(param)) {
|
||||
if (! sexp_pairp(sexp_opcode_data(param)))
|
||||
sexp_opcode_data(param) = sexp_cons(ctx, name, value);
|
||||
|
|
@ -2264,7 +2281,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
|
|||
sexp_push(ctx, sexp_global(ctx, SEXP_G_OPTIMIZATIONS), tmp);
|
||||
#endif
|
||||
sexp_global(ctx, SEXP_G_ERR_HANDLER)
|
||||
= sexp_env_ref(e, sym=sexp_intern(ctx, "current-exception-handler", -1), SEXP_FALSE);
|
||||
= sexp_env_ref(ctx, e, sym=sexp_intern(ctx, "current-exception-handler", -1), SEXP_FALSE);
|
||||
/* load init.scm */
|
||||
len = strlen(sexp_init_file);
|
||||
strncpy(init_file, sexp_init_file, len);
|
||||
|
|
@ -2288,7 +2305,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
|
|||
}
|
||||
if (!sexp_exceptionp(tmp)) {
|
||||
sym = sexp_intern(ctx, "repl-import", -1);
|
||||
tmp = sexp_env_ref(tmp, sym, SEXP_VOID);
|
||||
tmp = sexp_env_ref(ctx, tmp, sym, SEXP_VOID);
|
||||
sym = sexp_intern(ctx, "import", -1);
|
||||
sexp_env_define(ctx, e, sym, tmp);
|
||||
}
|
||||
|
|
@ -2335,8 +2352,8 @@ sexp sexp_env_import_op (sexp ctx, sexp self, sexp_sint_t n, sexp to, sexp from,
|
|||
} else {
|
||||
newname = oldname = sexp_car(ls);
|
||||
}
|
||||
oldcell = sexp_env_cell(to, newname, 0);
|
||||
value = sexp_env_cell(from, oldname, 0);
|
||||
oldcell = sexp_env_cell(ctx, to, newname, 0);
|
||||
value = sexp_env_cell(ctx, from, oldname, 0);
|
||||
if (value) {
|
||||
#if SEXP_USE_RENAME_BINDINGS
|
||||
sexp_env_rename(ctx, to, newname, value);
|
||||
|
|
|
|||
|
|
@ -79,7 +79,7 @@ SEXP_API void sexp_shrink_bcode (sexp ctx, sexp_uint_t i);
|
|||
SEXP_API void sexp_expand_bcode (sexp ctx, sexp_uint_t size);
|
||||
SEXP_API void sexp_stack_trace (sexp ctx, sexp out);
|
||||
SEXP_API sexp sexp_free_vars (sexp context, sexp x, sexp fv);
|
||||
SEXP_API int sexp_param_index (sexp lambda, sexp name);
|
||||
SEXP_API int sexp_param_index (sexp ctx, sexp lambda, sexp name);
|
||||
SEXP_API sexp sexp_compile_op (sexp context, sexp self, sexp_sint_t n, sexp obj, sexp env);
|
||||
SEXP_API sexp sexp_generate_op (sexp context, sexp self, sexp_sint_t n, sexp obj, sexp env);
|
||||
SEXP_API sexp sexp_eval_op (sexp context, sexp self, sexp_sint_t n, sexp obj, sexp env);
|
||||
|
|
@ -118,8 +118,8 @@ SEXP_API sexp sexp_open_binary_output_file(sexp ctx, sexp self, sexp_sint_t n, s
|
|||
SEXP_API sexp sexp_close_port_op(sexp ctx, sexp self, sexp_sint_t n, sexp x);
|
||||
SEXP_API sexp sexp_set_port_line_op (sexp ctx, sexp self, sexp_sint_t n, sexp port, sexp line);
|
||||
SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val);
|
||||
SEXP_API sexp sexp_env_cell (sexp env, sexp sym, int localp);
|
||||
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt);
|
||||
SEXP_API sexp sexp_env_cell (sexp ctx, sexp env, sexp sym, int localp);
|
||||
SEXP_API sexp sexp_env_ref (sexp ctx, sexp env, sexp sym, sexp dflt);
|
||||
SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param);
|
||||
SEXP_API sexp sexp_warn_undefs_op (sexp ctx, sexp self, sexp_sint_t n, sexp from, sexp to, sexp res);
|
||||
SEXP_API sexp sexp_make_lit (sexp ctx, sexp value);
|
||||
|
|
|
|||
|
|
@ -412,6 +412,10 @@
|
|||
#endif
|
||||
#endif
|
||||
|
||||
#ifndef SEXP_USE_FLAT_SYNTACTIC_CLOSURES
|
||||
#define SEXP_USE_FLAT_SYNTACTIC_CLOSURES 0
|
||||
#endif
|
||||
|
||||
#if SEXP_USE_UNWRAPPED_TOPLEVEL_BINDINGS
|
||||
#define SEXP_USE_UNWRAPPED_TOPLEVEL_BINDINGS 0
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -683,8 +683,7 @@ sexp sexp_make_flonum(sexp ctx, double f);
|
|||
#define sexp_symbolp(x) (sexp_lsymbolp(x))
|
||||
#endif
|
||||
|
||||
#define sexp_idp(x) \
|
||||
(sexp_symbolp(x) || (sexp_synclop(x) && sexp_symbolp(sexp_synclo_expr(x))))
|
||||
SEXP_API int sexp_idp(sexp x);
|
||||
|
||||
#define sexp_portp(x) (sexp_check_tag(x, SEXP_IPORT) || sexp_check_tag(x, SEXP_OPORT))
|
||||
|
||||
|
|
@ -1494,7 +1493,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj
|
|||
(sexp_proc2)finalizer)
|
||||
#endif
|
||||
|
||||
#define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE))
|
||||
#define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(ctx, sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE))
|
||||
#define sexp_debug(ctx, msg, obj) (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx)))
|
||||
|
||||
/* simplify primitive API interface */
|
||||
|
|
|
|||
|
|
@ -42,13 +42,13 @@ static void sexp_define_accessors (sexp ctx, sexp env, sexp_uint_t ctype,
|
|||
static sexp sexp_get_env_cell (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp id, sexp createp) {
|
||||
sexp cell;
|
||||
sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env);
|
||||
cell = sexp_env_cell(env, id, 0);
|
||||
cell = sexp_env_cell(ctx, env, id, 0);
|
||||
if (! cell) {
|
||||
if (sexp_synclop(id)) {
|
||||
env = sexp_synclo_env(id);
|
||||
id = sexp_synclo_expr(id);
|
||||
}
|
||||
cell = sexp_env_cell(env, id, 0);
|
||||
cell = sexp_env_cell(ctx, env, id, 0);
|
||||
if (!cell && createp)
|
||||
cell = sexp_env_cell_define(ctx, env, id, SEXP_UNDEF, NULL);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -57,7 +57,8 @@ static sexp sexp_heap_walk (sexp ctx, int depth, int printp) {
|
|||
|
||||
if (printp)
|
||||
out = sexp_parameter_ref(ctx,
|
||||
sexp_env_ref(sexp_context_env(ctx),
|
||||
sexp_env_ref(ctx,
|
||||
sexp_context_env(ctx),
|
||||
sexp_global(ctx,SEXP_G_CUR_OUT_SYMBOL),
|
||||
SEXP_FALSE));
|
||||
|
||||
|
|
|
|||
|
|
@ -427,7 +427,7 @@ sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) {
|
|||
runner = sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER);
|
||||
if (! sexp_contextp(runner)) { /* ensure the runner exists */
|
||||
if (sexp_envp(runner)) {
|
||||
tmp = sexp_env_cell(runner, (tmp=sexp_intern(ctx, "signal-runner", -1)), 0);
|
||||
tmp = sexp_env_cell(ctx, runner, (tmp=sexp_intern(ctx, "signal-runner", -1)), 0);
|
||||
if (sexp_pairp(tmp) && sexp_procedurep(sexp_cdr(tmp))) {
|
||||
runner = sexp_make_thread(ctx, self, 2, sexp_cdr(tmp), SEXP_FALSE);
|
||||
sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = runner;
|
||||
|
|
@ -623,7 +623,7 @@ sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) {
|
|||
/**************************************************************************/
|
||||
|
||||
sexp sexp_lookup_named_type (sexp ctx, sexp env, const char *name) {
|
||||
sexp t = sexp_env_ref(env, sexp_intern(ctx, name, -1), SEXP_FALSE);
|
||||
sexp t = sexp_env_ref(ctx, env, sexp_intern(ctx, name, -1), SEXP_FALSE);
|
||||
return sexp_make_fixnum((sexp_typep(t)) ? sexp_type_tag(t) : -1);
|
||||
}
|
||||
|
||||
|
|
|
|||
14
main.c
14
main.c
|
|
@ -193,7 +193,7 @@ static sexp sexp_meta_env (sexp ctx) {
|
|||
}
|
||||
|
||||
static sexp sexp_param_ref (sexp ctx, sexp env, sexp name) {
|
||||
sexp res = sexp_env_ref(env, name, SEXP_FALSE);
|
||||
sexp res = sexp_env_ref(ctx, env, name, SEXP_FALSE);
|
||||
return sexp_opcodep(res) ? sexp_parameter_ref(ctx, res) : NULL;
|
||||
}
|
||||
|
||||
|
|
@ -305,7 +305,7 @@ static sexp check_exception (sexp ctx, sexp res) {
|
|||
advise = sexp_vector_ref(advise, SEXP_ONE);
|
||||
if (sexp_envp(advise)) {
|
||||
sym = sexp_intern(ctx, "repl-advise-exception", -1);
|
||||
advise = sexp_env_ref(advise, sym, SEXP_FALSE);
|
||||
advise = sexp_env_ref(ctx, advise, sym, SEXP_FALSE);
|
||||
if (sexp_procedurep(advise))
|
||||
sexp_apply(ctx, advise, tmp=sexp_list2(ctx, res, err));
|
||||
}
|
||||
|
|
@ -503,7 +503,7 @@ void run_main (int argc, char **argv) {
|
|||
if (! sexp_oportp(out))
|
||||
out = sexp_eval_string(ctx, "(current-output-port)", -1, env);
|
||||
sexp_write_string(ctx, sexp_version_string, out);
|
||||
tmp = sexp_env_ref(env, sym=sexp_intern(ctx, "*features*", -1), SEXP_NULL);
|
||||
tmp = sexp_env_ref(ctx, env, sym=sexp_intern(ctx, "*features*", -1), SEXP_NULL);
|
||||
sexp_write(ctx, tmp, out);
|
||||
sexp_newline(ctx, out);
|
||||
return;
|
||||
|
|
@ -565,11 +565,11 @@ void run_main (int argc, char **argv) {
|
|||
sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), env);
|
||||
sexp_context_env(ctx) = env;
|
||||
sym = sexp_intern(ctx, "repl-import", -1);
|
||||
tmp = sexp_env_ref(sexp_meta_env(ctx), sym, SEXP_VOID);
|
||||
tmp = sexp_env_ref(ctx, sexp_meta_env(ctx), sym, SEXP_VOID);
|
||||
sym = sexp_intern(ctx, "import", -1);
|
||||
sexp_env_define(ctx, env, sym, tmp);
|
||||
sym = sexp_intern(ctx, "cond-expand", -1);
|
||||
tmp = sexp_env_ref(sexp_meta_env(ctx), sym, SEXP_VOID);
|
||||
tmp = sexp_env_ref(ctx, sexp_meta_env(ctx), sym, SEXP_VOID);
|
||||
sexp_env_define(ctx, env, sym, tmp);
|
||||
}
|
||||
#endif
|
||||
|
|
@ -578,7 +578,7 @@ void run_main (int argc, char **argv) {
|
|||
#if SEXP_USE_MODULES
|
||||
/* use scheme load if possible for better stack traces */
|
||||
sym = sexp_intern(ctx, "load", -1);
|
||||
tmp = sexp_env_ref(sexp_meta_env(ctx), sym, SEXP_FALSE);
|
||||
tmp = sexp_env_ref(ctx, sexp_meta_env(ctx), sym, SEXP_FALSE);
|
||||
if (sexp_procedurep(tmp)) {
|
||||
sym = sexp_c_string(ctx, argv[i], -1);
|
||||
sym = sexp_list2(ctx, sym, env);
|
||||
|
|
@ -593,7 +593,7 @@ void run_main (int argc, char **argv) {
|
|||
/* SRFI-22: run main if specified */
|
||||
if (main_symbol) {
|
||||
sym = sexp_intern(ctx, main_symbol, -1);
|
||||
tmp = sexp_env_ref(env, sym, SEXP_FALSE);
|
||||
tmp = sexp_env_ref(ctx, env, sym, SEXP_FALSE);
|
||||
if (sexp_procedurep(tmp)) {
|
||||
args = sexp_list1(ctx, args);
|
||||
check_exception(ctx, sexp_apply(ctx, tmp, args));
|
||||
|
|
|
|||
10
vm.c
10
vm.c
|
|
@ -214,7 +214,7 @@ static void generate_non_global_ref (sexp ctx, sexp name, sexp cell,
|
|||
if (loc == lambda && sexp_lambdap(lambda)) {
|
||||
/* local ref */
|
||||
sexp_emit(ctx, SEXP_OP_LOCAL_REF);
|
||||
sexp_emit_word(ctx, sexp_param_index(lambda, name));
|
||||
sexp_emit_word(ctx, sexp_param_index(ctx, lambda, name));
|
||||
} else {
|
||||
/* closure ref */
|
||||
for (i=0; sexp_pairp(fv); fv=sexp_cdr(fv), i++)
|
||||
|
|
@ -277,7 +277,7 @@ static void generate_set (sexp ctx, sexp set) {
|
|||
} else {
|
||||
/* internally defined variable */
|
||||
sexp_emit(ctx, SEXP_OP_LOCAL_SET);
|
||||
sexp_emit_word(ctx, sexp_param_index(lambda, sexp_ref_name(ref)));
|
||||
sexp_emit_word(ctx, sexp_param_index(ctx, lambda, sexp_ref_name(ref)));
|
||||
}
|
||||
}
|
||||
sexp_emit_push(ctx, SEXP_VOID);
|
||||
|
|
@ -476,7 +476,7 @@ static void generate_tail_jump (sexp ctx, sexp name, sexp loc, sexp lam, sexp ap
|
|||
}
|
||||
for (ls1=ls3; sexp_pairp(ls1); ls1=sexp_cdr(ls1)) {
|
||||
sexp_emit(ctx, SEXP_OP_LOCAL_SET);
|
||||
sexp_emit_word(ctx, sexp_param_index(lam, sexp_car(ls1)));
|
||||
sexp_emit_word(ctx, sexp_param_index(ctx, lam, sexp_car(ls1)));
|
||||
}
|
||||
|
||||
/* drop the current result and jump */
|
||||
|
|
@ -623,7 +623,7 @@ static void generate_lambda (sexp ctx, sexp name, sexp loc, sexp lam, sexp lambd
|
|||
}
|
||||
/* box mutable vars */
|
||||
for (ls=sexp_lambda_sv(lambda); sexp_pairp(ls); ls=sexp_cdr(ls)) {
|
||||
k = sexp_param_index(lambda, sexp_car(ls));
|
||||
k = sexp_param_index(ctx, lambda, sexp_car(ls));
|
||||
sexp_emit(ctx2, SEXP_OP_LOCAL_REF);
|
||||
sexp_emit_word(ctx2, k);
|
||||
sexp_emit_push(ctx2, sexp_car(ls));
|
||||
|
|
@ -736,7 +736,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) {
|
|||
} else {
|
||||
sexp_context_env(ctx2) = env;
|
||||
for (ls=params, refs=SEXP_NULL; sexp_pairp(ls); ls=sexp_cdr(ls)) {
|
||||
ref = sexp_make_ref(ctx2, sexp_car(ls), sexp_env_cell(env, sexp_car(ls), 0));
|
||||
ref = sexp_make_ref(ctx2, sexp_car(ls), sexp_env_cell(ctx, env, sexp_car(ls), 0));
|
||||
if (!sexp_exceptionp(ref)) sexp_push(ctx2, refs, ref);
|
||||
}
|
||||
if (!sexp_exceptionp(refs))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue