Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5306:cde1608596d0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handle bignum N correctly, #'butlast, #'nbutlast. 2010-11-17 Aidan Kehoe <kehoea@parhasard.net> * 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.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 17 Nov 2010 14:37:26 +0000
parents 4c4085177ca5
children c096d8051f89
comparison
equal deleted inserted replaced
5305:09fed7053634 5306:cde1608596d0
1574 } 1574 }
1575 1575
1576 return retval; 1576 return retval;
1577 } 1577 }
1578 1578
1579 static Lisp_Object bignum_butlast (Lisp_Object list, Lisp_Object number,
1580 Boolint copy);
1581
1579 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* 1582 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
1580 Modify LIST to remove the last N (default 1) elements. 1583 Modify LIST to remove the last N (default 1) elements.
1581 1584
1582 If LIST has N or fewer elements, nil is returned and LIST is unmodified. 1585 If LIST has N or fewer elements, nil is returned and LIST is unmodified.
1583 Otherwise, LIST may be dotted, but not circular. 1586 Otherwise, LIST may be dotted, but not circular.
1588 1591
1589 CHECK_LIST (list); 1592 CHECK_LIST (list);
1590 1593
1591 if (!NILP (n)) 1594 if (!NILP (n))
1592 { 1595 {
1596 if (BIGNUMP (n))
1597 {
1598 return bignum_butlast (list, n, 0);
1599 }
1600
1593 CHECK_NATNUM (n); 1601 CHECK_NATNUM (n);
1594 int_n = XINT (n); 1602 int_n = XINT (n);
1595 } 1603 }
1596 1604
1597 if (CONSP (list)) 1605 if (CONSP (list))
1636 1644
1637 CHECK_LIST (list); 1645 CHECK_LIST (list);
1638 1646
1639 if (!NILP (n)) 1647 if (!NILP (n))
1640 { 1648 {
1649 if (BIGNUMP (n))
1650 {
1651 return bignum_butlast (list, n, 1);
1652 }
1653
1641 CHECK_NATNUM (n); 1654 CHECK_NATNUM (n);
1642 int_n = XINT (n); 1655 int_n = XINT (n);
1643 } 1656 }
1644 1657
1645 if (CONSP (list)) 1658 if (CONSP (list))
1669 } 1682 }
1670 } 1683 }
1671 } 1684 }
1672 1685
1673 return retval; 1686 return retval;
1687 }
1688
1689 /* This is sufficient to implement #'butlast and #'nbutlast with bignum N
1690 under XEmacs, because #'list-length and #'safe-length can never return a
1691 bignum. This means that #'nbutlast never has to modify and #'butlast
1692 never has to copy. */
1693 static Lisp_Object
1694 bignum_butlast (Lisp_Object list, Lisp_Object number, Boolint copy)
1695 {
1696 Boolint malformed = EQ (Fsafe_length (list), Qzero);
1697 Boolint circular = !malformed && EQ (Flist_length (list), Qnil);
1698
1699 assert (BIGNUMP (number));
1700
1701 #ifdef HAVE_BIGNUM
1702
1703 if (bignum_sign (XBIGNUM_DATA (number)) < 0)
1704 {
1705 dead_wrong_type_argument (Qnatnump, number);
1706 }
1707
1708 number = Fcanonicalize_number (number);
1709
1710 if (INTP (number))
1711 {
1712 return copy ? Fbutlast (list, number) : Fnbutlast (list, number);
1713 }
1714
1715 #endif
1716
1717 if (circular)
1718 {
1719 signal_circular_list_error (list);
1720 }
1721
1722 return Qnil;
1674 } 1723 }
1675 1724
1676 DEFUN ("member", Fmember, 2, 2, 0, /* 1725 DEFUN ("member", Fmember, 2, 2, 0, /*
1677 Return non-nil if ELT is an element of LIST. Comparison done with `equal'. 1726 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1678 The value is actually the tail of LIST whose car is ELT. 1727 The value is actually the tail of LIST whose car is ELT.