From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.bugs Subject: bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right! Date: Mon, 22 Sep 2014 13:15:18 -0400 Message-ID: <87fvfjk255.fsf@yeeloong.lan> References: <1401821778-19972-1-git-send-email-dak@gnu.org> <1401821778-19972-2-git-send-email-dak@gnu.org> <87k34yl4s3.fsf@yeeloong.lan> <87wq8ypblg.fsf@fencepost.gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1411406309 2738 80.91.229.3 (22 Sep 2014 17:18:29 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 22 Sep 2014 17:18:29 +0000 (UTC) Cc: 17485@debbugs.gnu.org To: David Kastrup Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Mon Sep 22 19:18:22 2014 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XW7Fl-00082c-Pt for guile-bugs@m.gmane.org; Mon, 22 Sep 2014 19:18:22 +0200 Original-Received: from localhost ([::1]:47868 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XW7Fl-0008Lq-8g for guile-bugs@m.gmane.org; Mon, 22 Sep 2014 13:18:21 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39458) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XW7Fc-0008Iz-PQ for bug-guile@gnu.org; Mon, 22 Sep 2014 13:18:18 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XW7FX-0003s9-ER for bug-guile@gnu.org; Mon, 22 Sep 2014 13:18:12 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:57502) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XW7FX-0003qN-AZ for bug-guile@gnu.org; Mon, 22 Sep 2014 13:18:07 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1XW7FR-000557-MW for bug-guile@gnu.org; Mon, 22 Sep 2014 13:18:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Mark H Weaver Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Mon, 22 Sep 2014 17:18:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 17485 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 17485-submit@debbugs.gnu.org id=B17485.141140623919483 (code B ref 17485); Mon, 22 Sep 2014 17:18:01 +0000 Original-Received: (at 17485) by debbugs.gnu.org; 22 Sep 2014 17:17:19 +0000 Original-Received: from localhost ([127.0.0.1]:49066 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XW7Ek-00054B-IZ for submit@debbugs.gnu.org; Mon, 22 Sep 2014 13:17:19 -0400 Original-Received: from world.peace.net ([96.39.62.75]:51015) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XW7Ei-000542-8x for 17485@debbugs.gnu.org; Mon, 22 Sep 2014 13:17:17 -0400 Original-Received: from c-24-62-95-23.hsd1.ma.comcast.net ([24.62.95.23] helo=yeeloong.lan) by world.peace.net with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1XW7EZ-0007oD-KS; Mon, 22 Sep 2014 13:17:07 -0400 In-Reply-To: <87wq8ypblg.fsf@fencepost.gnu.org> (David Kastrup's message of "Sat, 20 Sep 2014 17:15:23 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.bugs:7571 Archived-At: --=-=-= Content-Type: text/plain David Kastrup writes: > Mark H Weaver 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0002-EXPERIMENTAL-Add-min-length.patch Content-Description: [PATCH] EXPERIMENTAL Add 'min-length+' >From 7805c7e91f132e739677ff09e734d7ac181ad213 Mon Sep 17 00:00:00 2001 From: Mark H Weaver 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 +#include /* 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 --=-=-=--