From: Mark H Weaver <mhw@netris.org>
To: David Kastrup <dak@gnu.org>
Cc: 17485@debbugs.gnu.org
Subject: bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!
Date: Mon, 22 Sep 2014 13:15:18 -0400 [thread overview]
Message-ID: <87fvfjk255.fsf@yeeloong.lan> (raw)
In-Reply-To: <87wq8ypblg.fsf@fencepost.gnu.org> (David Kastrup's message of "Sat, 20 Sep 2014 17:15:23 +0200")
[-- Attachment #1: Type: text/plain, Size: 1593 bytes --]
David Kastrup <dak@gnu.org> writes:
> Mark H Weaver <mhw@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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] EXPERIMENTAL Add 'min-length+' --]
[-- Type: text/x-patch, Size: 3470 bytes --]
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>
\f
/* 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
+
+
\f
/* appending lists */
--
1.8.4
next prev parent reply other threads:[~2014-09-22 17:15 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-05-13 10:47 bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9 David Kastrup
2014-06-01 23:41 ` Mark H Weaver
2014-06-02 7:59 ` David Kastrup
2014-06-03 18:56 ` bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f David Kastrup
2014-06-03 18:56 ` bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right! David Kastrup
2014-06-04 3:29 ` Mark H Weaver
2014-06-04 3:45 ` Mark H Weaver
2014-09-20 14:56 ` Mark H Weaver
2014-09-20 15:15 ` David Kastrup
2014-09-22 17:15 ` Mark H Weaver [this message]
2014-09-22 18:40 ` David Kastrup
2014-06-03 18:56 ` bug#17485: [PATCH 3/3] Reimplement reduce-right in srfi-1 David Kastrup
2014-06-04 3:30 ` Mark H Weaver
2014-06-04 3:42 ` bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f Mark H Weaver
2014-06-04 4:57 ` David Kastrup
2014-06-04 10:09 ` David Kastrup
2014-06-05 13:57 ` David Kastrup
2016-06-21 14:42 ` bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9 Andy Wingo
2016-06-21 15:31 ` David Kastrup
2016-07-12 7:07 ` Andy Wingo
2016-07-12 7:43 ` bug#17485: Ugh, well David Kastrup
2016-07-12 13:54 ` Andy Wingo
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87fvfjk255.fsf@yeeloong.lan \
--to=mhw@netris.org \
--cc=17485@debbugs.gnu.org \
--cc=dak@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).