David Kastrup <d...@gnu.org> writes:
> Mark H Weaver <m...@netris.org> 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 <m...@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
