bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!

[Mark H Weaver]

David Kastrup <address@hidden> writes:

> Mark H Weaver <address@hidden> writes:
>
>> I can take care of doing this myself, and will of course still credit
>> you in whatever manner you prefer, but I've run into a legal problem: we
>> don't currently have copyright papers for you on file.  Are you willing
>> to file copyright papers for GUILE?
>
> No problems with that.  Standard request-assign?

request-assign.future would be good, which assigns "PAST AND FUTURE
CHANGES".  Is that what you meant by "Standard request-assign"?

> At any rate, here is what I would suggest to create: a function
> min-length receiving a list of lists (possibly as separate arguments via
> a rest argument).
>
> It will return the number of times one can do cdr on every of the given
> arguments until at least one of them turns into a list end with nothing
> turning into anything but a pair or a list end.

I agree that these are reasonable semantics for validation by 'map' and
'for-each'.  I went ahead and implemented it (attached below).  For
efficiency in the common case, I check for cycles in only one list at a
time.  If a cycle is found, the circular list is discarded and cycle
detection begins on another list.  Let me know if you see a way to
improve it.

However, this is not the procedure needed for 'drop-right',
so we'll still need to add a lax variant of length+.  Maybe
'improper-list-length+'?

I guess that both of these new procedures should go in a new module:
(srfi srfi-1 gnu).  We've used this convention for other SRFI
extensions, e.g. (srfi srfi-9 gnu).

    Regards,
      Mark


>From 7805c7e91f132e739677ff09e734d7ac181ad213 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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