carbon2-commit: Handle bignum N correctly, #'butlast, #'nbutlast.

changeset: 5364:cde1608596d0 user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Wed Nov 17 14:37:26 2010 +0000 files: src/ChangeLog src/fns.c description: 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); } ＠＠ -1671,6 +1684,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, /* _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches