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 non-strict matching of identifiers to treat let(rec)-syntax as non-top-level.

Browse source
This commit is contained in:
Alex Shinn 2014-02-04 20:48:46 +09:00
parent dbb8a2e441
commit e5da561a5d
5 changed files with 40 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
eval.c
View file

@ -598,7 +598,8 @@ sexp sexp_strip_synclos (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
#if SEXP_USE_STRICT_TOPLEVEL_BINDINGS
#define sexp_non_local_cell_p(cell) (!cell)
#else
#define sexp_non_local_cell_p(cell) (!cell || !sexp_lambdap(sexp_cdr(cell)))
#define sexp_non_local_cell_p(cell) \
(!cell || (!sexp_lambdap(sexp_cdr(cell)) && !sexp_env_cell_syntactic_p(cell)))
#endif
sexp sexp_identifier_eq_op (sexp ctx, sexp self, sexp_sint_t n, sexp e1, sexp id1, sexp e2, sexp id2) {
@ -866,7 +867,7 @@ static sexp analyze_define (sexp ctx, sexp x, int depth) {
return res;
}
static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx, int localp) {
sexp res = SEXP_VOID, name;
sexp_gc_var1(mac);
sexp_gc_preserve1(eval_ctx, mac);
@ -875,7 +876,7 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
&& sexp_idp(sexp_caar(ls)) && sexp_nullp(sexp_cddar(ls)))) {
res = sexp_compile_error(eval_ctx, "bad syntax binding", sexp_pairp(ls) ? sexp_car(ls) : ls);
break;
} else {
}
if (sexp_idp(sexp_cadar(ls)))
mac = sexp_env_ref(eval_ctx, sexp_context_env(eval_ctx), sexp_cadar(ls), SEXP_FALSE);
else
@ -893,7 +894,10 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
if (sexp_macrop(mac) && sexp_pairp(sexp_cadar(ls)))
sexp_macro_source(mac) = sexp_pair_source(sexp_cadar(ls));
sexp_env_define(eval_ctx, sexp_context_env(bind_ctx), name, mac);
}
#if !SEXP_USE_STRICT_TOPLEVEL_BINDINGS
if (localp)
sexp_env_cell_syntactic_p(sexp_env_cell(eval_ctx, sexp_context_env(bind_ctx), name, 0)) = 1;
#endif
}
sexp_gc_release1(eval_ctx);
return res;
@ -904,7 +908,7 @@ static sexp analyze_define_syntax (sexp ctx, sexp x) {
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
tmp = sexp_list1(ctx, sexp_cdr(x));
res = sexp_exceptionp(tmp) ? tmp : analyze_bind_syntax(tmp, ctx, ctx);
res = sexp_exceptionp(tmp) ? tmp : analyze_bind_syntax(tmp, ctx, ctx, 0);
sexp_gc_release1(ctx);
return res;
}
@ -925,7 +929,7 @@ static sexp analyze_let_syntax_aux (sexp ctx, sexp x, int recp, int depth) {
#endif
ctx2 = sexp_make_child_context(ctx, sexp_context_lambda(ctx));
sexp_context_env(ctx2) = env;
tmp = analyze_bind_syntax(sexp_cadr(x), (recp ? ctx2 : ctx), ctx2);
tmp = analyze_bind_syntax(sexp_cadr(x), (recp ? ctx2 : ctx), ctx2, 1);
res = (sexp_exceptionp(tmp) ? tmp : analyze_seq(ctx2, sexp_cddr(x), depth, 1));
}
sexp_gc_release3(ctx);

3
include/chibi/eval.h
View file

@ -121,6 +121,9 @@ SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val);
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);
#if SEXP_USE_RENAME_BINDINGS
SEXP_API sexp sexp_env_rename (sexp ctx, sexp env, sexp key, sexp value);
#endif
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);
SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1);

4
include/chibi/features.h
View file

@ -428,6 +428,10 @@
#endif
#endif
#ifndef SEXP_USE_SPLICING_LET_SYNTAX
#define SEXP_USE_SPLICING_LET_SYNTAX 0
#endif
#ifndef SEXP_USE_FLAT_SYNTACTIC_CLOSURES
#define SEXP_USE_FLAT_SYNTACTIC_CLOSURES 0
#endif

2
include/chibi/sexp.h
View file

@ -946,6 +946,8 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_bytecode_source(x) (sexp_field(x, bytecode, SEXP_BYTECODE, source))
#define sexp_bytecode_data(x) (sexp_field(x, bytecode, SEXP_BYTECODE, data))
#define sexp_env_cell_syntactic_p(x) ((x)->syntacticp)
#define sexp_env_syntactic_p(x) ((x)->syntacticp)
#define sexp_env_parent(x) (sexp_field(x, env, SEXP_ENV, parent))
#define sexp_env_bindings(x) (sexp_field(x, env, SEXP_ENV, bindings))

7
main.c
View file

@ -570,8 +570,11 @@ void run_main (int argc, char **argv) {
sym = sexp_intern(ctx, "import", -1);
sexp_env_define(ctx, env, sym, tmp);
sym = sexp_intern(ctx, "cond-expand", -1);
tmp = sexp_env_ref(ctx, sexp_meta_env(ctx), sym, SEXP_VOID);
sexp_env_define(ctx, env, sym, tmp);
tmp = sexp_env_cell(ctx, sexp_meta_env(ctx), sym, 0);
#if SEXP_USE_RENAME_BINDINGS
sexp_env_rename(ctx, env, sym, tmp);
#endif
sexp_env_define(ctx, env, sym, sexp_cdr(tmp));
}
#endif
sexp_context_tracep(ctx) = 1;