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

Avoid stripping syntactic closures in more cases. Fixes issue #339.

Browse source
This commit is contained in:
Alex Shinn 2016-05-17 00:53:57 +09:00
parent c1e7e1f23a
commit ee90f25d7f
1 changed files with 27 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
eval.c
View file

@ -592,15 +592,37 @@ sexp sexp_syntactic_closure_expr_op (sexp ctx, sexp self, sexp_sint_t n, sexp x)
return (sexp_synclop(x) ? sexp_synclo_expr(x) : x); return (sexp_synclop(x) ? sexp_synclo_expr(x) : x);
} }
#if SEXP_USE_READER_LABELS
static int sexp_cyclic_synclop(sexp x) {
sexp ls1, ls2;
if (!sexp_pairp(x))
return 0;
for (ls1=x, ls2=sexp_id_name(sexp_cdr(ls1));
sexp_pairp(ls2) && sexp_pairp(sexp_id_name(sexp_cdr(ls2)));
ls1=sexp_id_name(sexp_cdr(ls1)),
ls2=sexp_id_name(sexp_cdr(sexp_id_name(sexp_cdr(ls2))))) {
if (ls1 == ls2 || ls1 == sexp_id_name(sexp_car(ls2)))
return 1;
}
for (ls1=x, ls2=sexp_id_name(sexp_car(ls1));
sexp_pairp(ls2) && sexp_pairp(sexp_id_name(sexp_car(ls2)));
ls1=sexp_id_name(sexp_car(ls1)),
ls2=sexp_id_name(sexp_car(sexp_id_name(sexp_car(ls2))))) {
if (ls1 == ls2 || ls1 == sexp_id_name(sexp_cdr(ls2)))
return 1;
}
return 0;
}
#else
#define sexp_cyclic_synclop(x) 0
#endif
sexp sexp_strip_synclos_bound (sexp ctx, sexp x, int depth) { sexp sexp_strip_synclos_bound (sexp ctx, sexp x, int depth) {
sexp_gc_var3(res, kar, kdr); sexp_gc_var3(res, kar, kdr);
if (depth <= 0) return x; if (depth <= 0) return x;
sexp_gc_preserve3(ctx, res, kar, kdr); sexp_gc_preserve3(ctx, res, kar, kdr);
loop: x = sexp_id_name(x);
if (sexp_synclop(x)) { if (sexp_pairp(x) && !sexp_cyclic_synclop(x)) {
x = sexp_synclo_expr(x);
goto loop;
} else if (sexp_pairp(x) && sexp_truep(sexp_length(ctx, x))) {
kar = sexp_strip_synclos_bound(ctx, sexp_car(x), depth-1); kar = sexp_strip_synclos_bound(ctx, sexp_car(x), depth-1);
kdr = sexp_strip_synclos_bound(ctx, sexp_cdr(x), depth-1); kdr = sexp_strip_synclos_bound(ctx, sexp_cdr(x), depth-1);
res = sexp_cons(ctx, kar, kdr); res = sexp_cons(ctx, kar, kdr);