[COMMIT] Handle bignum N correctly, #'butlast, #'nbutlast.

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1290004646 0 # Node ID cde1608596d0b70c29939d8f4701299c3cf4aa1e # Parent 09fed7053634cd8ab9c1a79add8533ac93d8023d Handle bignum N correctly, #'butlast, #'nbutlast. 2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net&gt; * fns.c (bignum_butlast): New. (Fnbutlast, Fbutlast): Use it. In #'butlast and #'nbutlast, if N is a bignum, we should always return nil. Bug revealed by Paul Dietz' test suite, thank you Paul. diff -r 09fed7053634 -r cde1608596d0 src/ChangeLog --- a/src/ChangeLog Wed Nov 17 14:30:03 2010 +0000 +++ b/src/ChangeLog Wed Nov 17 14:37:26 2010 +0000 ＠＠ -1,3 +1,11 ＠＠ +2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * fns.c (bignum_butlast): New. + (Fnbutlast, Fbutlast): Use it. + In #'butlast and #'nbutlast, if N is a bignum, we should always + return nil. Bug revealed by Paul Dietz' test suite, thank you + Paul. + 2010-11-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * .gdbinit.in: Remove lrecord_type_popup_data, diff -r 09fed7053634 -r cde1608596d0 src/fns.c --- a/src/fns.c Wed Nov 17 14:30:03 2010 +0000 +++ b/src/fns.c Wed Nov 17 14:37:26 2010 +0000 ＠＠ -1576,6 +1576,9 ＠＠ return retval; } +static Lisp_Object bignum_butlast (Lisp_Object list, Lisp_Object number, + Boolint copy); + DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* Modify LIST to remove the last N (default 1) elements. ＠＠ -1590,6 +1593,11 ＠＠ if (!NILP (n)) { + if (BIGNUMP (n)) + { + return bignum_butlast (list, n, 0); + } + CHECK_NATNUM (n); int_n = XINT (n); } ＠＠ -1638,6 +1646,11 ＠＠ if (!NILP (n)) { + if (BIGNUMP (n)) + { + return bignum_butlast (list, n, 1); + } + CHECK_NATNUM (n); int_n = XINT (n); } ＠＠ -1673,6 +1686,42 ＠＠ return retval; } +/* This is sufficient to implement #'butlast and #'nbutlast with bignum N + under XEmacs, because #'list-length and #'safe-length can never return a + bignum. This means that #'nbutlast never has to modify and #'butlast + never has to copy. */ +static Lisp_Object +bignum_butlast (Lisp_Object list, Lisp_Object number, Boolint copy) +{ + Boolint malformed = EQ (Fsafe_length (list), Qzero); + Boolint circular = !malformed && EQ (Flist_length (list), Qnil); + + assert (BIGNUMP (number)); + +#ifdef HAVE_BIGNUM + + if (bignum_sign (XBIGNUM_DATA (number)) < 0) + { + dead_wrong_type_argument (Qnatnump, number); + } + + number = Fcanonicalize_number (number); + + if (INTP (number)) + { + return copy ? Fbutlast (list, number) : Fnbutlast (list, number); + } + +#endif + + if (circular) + { + signal_circular_list_error (list); + } + + return Qnil; +} + DEFUN ("member", Fmember, 2, 2, 0, /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. The value is actually the tail of LIST whose car is ELT. -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches