From 7805c7e91f132e739677ff09e734d7ac181ad213 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sun, 21 Sep 2014 03:27:48 -0400
Subject: [PATCH] EXPERIMENTAL Add 'min-length+'.

---
 libguile/list.c | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 86 insertions(+)

diff --git a/libguile/list.c b/libguile/list.c
index 669f566..ebb3814 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -31,6 +31,7 @@
 #include "libguile/eval.h"
 
 #include <stdarg.h>
+#include <assert.h>
 
 
 /* creating lists */
@@ -218,6 +219,91 @@ SCM_DEFINE (scm_length, "length", 1, 0, 0,
 #undef FUNC_NAME
 
 
+SCM_DEFINE (scm_min_length_plus, "min-length+", 0, 0, 1,
+            (SCM lists),
+	    "Return the number of times one can do cdr on every of the\n"
+            "given arguments until at least one of them turns into null\n"
+            "with nothing turning into anything but a pair or null.  If\n"
+            "any turn into a non-pair, non-null value, it is an error.\n"
+            "If all lists are cyclic, return #f.")
+#define FUNC_NAME s_scm_min_length_plus
+{
+  SCM tortoise;
+  SCM *v;
+  long n;                       /* The number of lists not yet known to be cyclic */
+  long i;                       /* loop variable over lists [0..n] */
+  size_t length_so_far = 0;
+
+  /* Allocate a C vector 'v' to keep the pointers, one per list.  */
+  n = scm_ilength (lists);
+  assert (n >= 0);
+  if (n >= 32)
+    v = (SCM *) scm_malloc (n * sizeof (SCM));
+  else
+    v = (SCM *) alloca (n * sizeof (SCM));
+
+  /* Copy 'lists' to the C vector 'v' */
+  {
+    SCM p = lists;
+    for (i = 0; i < n; i++)
+      {
+        v[i] = SCM_CAR (p);
+        p    = SCM_CDR (p);
+      }
+  }
+
+  /* This loop repeats once time we discover a cycle,
+     at which point we pop v[n-1], decrementing n.  */
+  for (; n > 0; v[--n] = SCM_UNDEFINED)
+    {
+      int toggle = 0;
+
+      tortoise = v[n-1];
+      for (;;)
+        {
+          int found_null = 0;
+
+          /* Advance all pairs in 'v' to their CDRs, while also checking
+             for non-pairs.  If we find the end of a list, set the
+             'done' flag and then continue the loop, to check that every
+             element of 'v' is either a pair or null.  If we find a
+             dotted tail (i.e. a non-null non-pair) in 'v', raise an
+             error immediately.  */
+          for (i = 0; i < n; i++)
+            {
+              if (scm_is_pair (v[i]))
+                v[i] = SCM_CDR (v[i]);
+              else if (scm_is_null (v[i]))
+                found_null = 1;
+              else
+                scm_wrong_type_arg_msg ("min-length+", (i + 1),
+                                        scm_list_ref (lists, scm_from_long (i)),
+                                        "proper or circular list");
+            }
+
+          if (found_null)
+            return scm_from_size_t (length_so_far);
+
+          length_so_far++;
+
+          /* Once every two turns, advance the tortoise
+             and check for a cycle.  */
+          if (toggle)
+            {
+              tortoise = SCM_CDR (tortoise);
+              if (scm_is_eq (tortoise, v[n-1]))
+                break;          /* We found a cycle */
+            }
+          toggle = !toggle;
+        }
+    }
+
+  /* We found cycles in every list, so return #f.  */
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+
 
 /* appending lists */
 
-- 
1.8.4