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

making syntactic closure free variable handling agree with mit-scheme

Browse source
This commit is contained in:
Alex Shinn 2016-02-27 16:06:20 +09:00
parent 36651c4115
commit 207ae1f24e
2 changed files with 24 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
eval.c
View file

@ -93,19 +93,25 @@ static sexp sexp_env_cell_loc1 (sexp env, sexp key, int localp, sexp *varenv) {
if (varenv) *varenv = env; if (varenv) *varenv = env;
return ls; return ls;
} }
env = (localp ? NULL : sexp_env_parent(env)); if (localp) break;
env = sexp_env_parent(env);
} while (env && sexp_envp(env)); } while (env && sexp_envp(env));
return NULL; return NULL;
} }
static sexp sexp_env_cell_loc (sexp ctx, sexp env, sexp key, int localp, sexp *varenv) { static sexp sexp_env_cell_loc (sexp ctx, sexp env, sexp key, int localp, sexp *varenv) {
sexp cell = sexp_env_cell_loc1(env, key, localp, varenv); sexp cell, ls = sexp_vectorp(sexp_context_specific(ctx)) ? sexp_memq(ctx, sexp_id_name(key), sexp_context_fv(ctx)) : SEXP_NULL;
for ( ; sexp_pairp(ls); ls=sexp_cdr(ls))
if (sexp_envp(sexp_car(ls))) {
env = sexp_car(ls);
break;
}
cell = sexp_env_cell_loc1(env, key, localp, varenv);
while (!cell && key && sexp_synclop(key)) { while (!cell && key && sexp_synclop(key)) {
if (sexp_not(sexp_memq(ctx, sexp_synclo_expr(key), sexp_context_fv(ctx))) if (!sexp_pairp(ls) && sexp_not(sexp_memq(ctx, sexp_synclo_expr(key), sexp_synclo_free_vars(key))))
&& sexp_not(sexp_memq(ctx, sexp_synclo_expr(key), sexp_synclo_free_vars(key))))
env = sexp_synclo_env(key); env = sexp_synclo_env(key);
key = sexp_synclo_expr(key); key = sexp_synclo_expr(key);
cell = sexp_env_cell_loc1(env, key, 0, varenv); cell = sexp_env_cell_loc1(env, key, localp, varenv);
} }
return cell; return cell;
} }
@ -568,9 +574,13 @@ sexp sexp_make_child_context (sexp ctx, sexp lambda) {
/**************************** identifiers *****************************/ /**************************** identifiers *****************************/
int sexp_idp (sexp x) { sexp sexp_id_name (sexp x) {
while (sexp_synclop(x)) x = sexp_synclo_expr(x); while (sexp_synclop(x)) x = sexp_synclo_expr(x);
return sexp_symbolp(x); return x;
}
int sexp_idp (sexp x) {
return sexp_symbolp(sexp_id_name(x));
} }
sexp sexp_identifierp_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) { sexp sexp_identifierp_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
@ -1055,9 +1065,12 @@ static sexp analyze (sexp ctx, sexp object, int depth, int defok) {
res = analyze_var_ref(ctx, x, NULL); res = analyze_var_ref(ctx, x, NULL);
} else if (sexp_synclop(x)) { } else if (sexp_synclop(x)) {
tmp = sexp_make_child_context(ctx, sexp_context_lambda(ctx)); tmp = sexp_make_child_context(ctx, sexp_context_lambda(ctx));
if (sexp_pairp(sexp_synclo_free_vars(x))) {
sexp_push(ctx, sexp_context_fv(tmp), sexp_context_env(ctx));
sexp_context_fv(tmp) = sexp_append2(tmp, sexp_context_fv(tmp) = sexp_append2(tmp,
sexp_synclo_free_vars(x), sexp_synclo_free_vars(x),
sexp_context_fv(tmp)); sexp_context_fv(tmp));
}
sexp_context_env(tmp) = sexp_extend_synclo_env(tmp, sexp_synclo_env(x)); sexp_context_env(tmp) = sexp_extend_synclo_env(tmp, sexp_synclo_env(x));
x = sexp_synclo_expr(x); x = sexp_synclo_expr(x);
res = analyze(tmp, x, depth, defok); res = analyze(tmp, x, depth, defok);

1
include/chibi/sexp.h
View file

@ -753,6 +753,7 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_symbolp(x) (sexp_lsymbolp(x)) #define sexp_symbolp(x) (sexp_lsymbolp(x))
#endif #endif
SEXP_API sexp sexp_id_name(sexp x);
SEXP_API int sexp_idp(sexp x); SEXP_API int sexp_idp(sexp x);
#define sexp_portp(x) (sexp_check_tag(x, SEXP_IPORT) || sexp_check_tag(x, SEXP_OPORT)) #define sexp_portp(x) (sexp_check_tag(x, SEXP_IPORT) || sexp_check_tag(x, SEXP_OPORT))