From c4acf012b52c4f71ba69db0e7969debb94f6dbc0 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 30 Oct 2011 22:36:56 +0900
Subject: [PATCH] sexp_strip_synclos checks cycles

---
 eval.c | 29 +++++++++++++++++++++++------
 1 file changed, 23 insertions(+), 6 deletions(-)

diff --git a/eval.c b/eval.c
index a76b0f2f..5621b10a 100644
--- a/eval.c
+++ b/eval.c
@@ -473,17 +473,34 @@ sexp sexp_syntactic_closure_expr_op (sexp ctx sexp_api_params(self, n), sexp x)
 }
 
 sexp sexp_strip_synclos (sexp ctx sexp_api_params(self, n), sexp x) {
-  sexp res;
-  sexp_gc_var2(kar, kdr);
-  sexp_gc_preserve2(ctx, kar, kdr);
+  sexp ls1, ls2, ls3;
+  sexp_gc_var2(res, tmp);
+  sexp_gc_preserve2(ctx, res, tmp);
  loop:
   if (sexp_synclop(x)) {
     x = sexp_synclo_expr(x);
     goto loop;
   } else if (sexp_pairp(x)) {
-    kar = sexp_strip_synclos(ctx sexp_api_pass(self, n), sexp_car(x));
-    kdr = sexp_strip_synclos(ctx sexp_api_pass(self, n), sexp_cdr(x));
-    res = sexp_cons(ctx, kar, kdr);
+    tmp = sexp_strip_synclos(ctx sexp_api_pass(self, n), sexp_car(x));
+    ls3 = res = sexp_cons(ctx, tmp, SEXP_NULL);
+    for (ls1=sexp_cdr(x), ls2=x;
+         sexp_pairp(ls1) && sexp_pairp(sexp_cdr(ls1)) && ls1 != ls2;
+         ls1=sexp_cddr(ls1), ls2=sexp_cdr(ls2)) {
+      tmp = sexp_strip_synclos(ctx sexp_api_pass(self, n), sexp_car(ls1));
+      sexp_cdr(ls3) = sexp_cons(ctx, tmp, SEXP_NULL);
+      ls3 = sexp_cdr(ls3);
+      tmp = sexp_strip_synclos(ctx sexp_api_pass(self, n), sexp_cadr(ls1));
+      sexp_cdr(ls3) = sexp_cons(ctx, tmp, SEXP_NULL);
+      ls3 = sexp_cdr(ls3);
+    }
+    if (sexp_pairp(ls1)) {
+      tmp = (ls1 == ls2) ? sexp_car(ls1) : sexp_strip_synclos(ctx sexp_api_pass(self, n), sexp_car(ls1));
+      sexp_cdr(ls3) = sexp_cons(ctx, tmp, SEXP_NULL);
+      ls3 = sexp_cdr(ls3);
+      ls1 = sexp_cdr(ls1);
+    }
+    sexp_cdr(ls3) = (ls1 == ls2) ? ls1 : sexp_strip_synclos(ctx sexp_api_pass(self, n), ls1);
+    sexp_pair_source(res) = sexp_pair_source(x);
     sexp_immutablep(res) = 1;
   } else {
     res = x;