Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5285:99de5fd48e87

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff lisp/ChangeLog addition: 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): * cl-macs.el (remf, getf): * cl-extra.el (tailp, cl-set-getf, cl-do-remf): * cl.el (ldiff, endp): Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp; add circularity checking for the first two. #'cl-set-getf and #'cl-do-remf were Lisp implementations of #'plist-put and #'plist-remprop; change the names to aliases, changes the macros that use them to using #'plist-put and #'plist-remprop directly. src/ChangeLog addition: 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * fns.c (Fnbutlast, Fbutlast): Tighten up Common Lisp compatibility for these two functions; they need to operate on dotted lists without erroring. tests/ChangeLog addition: 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el (x): Test #'nbutlast, #'butlast with dotted lists. Check that #'ldiff and #'tailp don't hang on circular lists; check that #'tailp returns t with circular lists when that is appropriate. Test them both with dotted lists.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 14 Oct 2010 18:50:38 +0100
parents be436ac36ba4
children 28651c24b3f8 b9167d522a9a
comparison
equal deleted inserted replaced
5284:d27c1ee1943b 5285:99de5fd48e87
1568 return retval; 1568 return retval;
1569 } 1569 }
1570 1570
1571 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* 1571 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
1572 Modify LIST to remove the last N (default 1) elements. 1572 Modify LIST to remove the last N (default 1) elements.
1573
1573 If LIST has N or fewer elements, nil is returned and LIST is unmodified. 1574 If LIST has N or fewer elements, nil is returned and LIST is unmodified.
1575 Otherwise, LIST may be dotted, but not circular.
1574 */ 1576 */
1575 (list, n)) 1577 (list, n))
1576 { 1578 {
1577 EMACS_INT int_n; 1579 Elemcount int_n = 1;
1578 1580
1579 CHECK_LIST (list); 1581 CHECK_LIST (list);
1580 1582
1581 if (NILP (n)) 1583 if (!NILP (n))
1582 int_n = 1;
1583 else
1584 { 1584 {
1585 CHECK_NATNUM (n); 1585 CHECK_NATNUM (n);
1586 int_n = XINT (n); 1586 int_n = XINT (n);
1587 } 1587 }
1588 1588
1589 { 1589 if (CONSP (list))
1590 Lisp_Object last_cons = list; 1590 {
1591 1591 Lisp_Object last_cons = list;
1592 EXTERNAL_LIST_LOOP_1 (list) 1592
1593 { 1593 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1594 if (int_n-- < 0) 1594 {
1595 last_cons = XCDR (last_cons); 1595 if (int_n-- < 0)
1596 } 1596 {
1597 1597 last_cons = XCDR (last_cons);
1598 if (int_n >= 0) 1598 }
1599 return Qnil; 1599
1600 1600 if (!CONSP (XCDR (tail)))
1601 XCDR (last_cons) = Qnil; 1601 {
1602 return list; 1602 break;
1603 } 1603 }
1604 }
1605
1606 if (int_n >= 0)
1607 {
1608 return Qnil;
1609 }
1610
1611 XCDR (last_cons) = Qnil;
1612 }
1613
1614 return list;
1604 } 1615 }
1605 1616
1606 DEFUN ("butlast", Fbutlast, 1, 2, 0, /* 1617 DEFUN ("butlast", Fbutlast, 1, 2, 0, /*
1607 Return a copy of LIST with the last N (default 1) elements removed. 1618 Return a copy of LIST with the last N (default 1) elements removed.
1619
1608 If LIST has N or fewer elements, nil is returned. 1620 If LIST has N or fewer elements, nil is returned.
1621 Otherwise, LIST may be dotted, but not circular, and `(butlast LIST 0)'
1622 converts a dotted into a true list.
1609 */ 1623 */
1610 (list, n)) 1624 (list, n))
1611 { 1625 {
1612 EMACS_INT int_n; 1626 Lisp_Object retval = Qnil, retval_tail = Qnil;
1627 Elemcount int_n = 1;
1613 1628
1614 CHECK_LIST (list); 1629 CHECK_LIST (list);
1615 1630
1616 if (NILP (n)) 1631 if (!NILP (n))
1617 int_n = 1;
1618 else
1619 { 1632 {
1620 CHECK_NATNUM (n); 1633 CHECK_NATNUM (n);
1621 int_n = XINT (n); 1634 int_n = XINT (n);
1622 } 1635 }
1623 1636
1624 { 1637 if (CONSP (list))
1625 Lisp_Object retval = Qnil; 1638 {
1626 Lisp_Object tail = list; 1639 Lisp_Object tail = list;
1627 1640
1628 EXTERNAL_LIST_LOOP_1 (list) 1641 EXTERNAL_LIST_LOOP_3 (elt, list, list_tail)
1629 { 1642 {
1630 if (--int_n < 0) 1643 if (--int_n < 0)
1631 { 1644 {
1632 retval = Fcons (XCAR (tail), retval); 1645 if (NILP (retval_tail))
1633 tail = XCDR (tail); 1646 {
1634 } 1647 retval = retval_tail = Fcons (XCAR (tail), Qnil);
1635 } 1648 }
1636 1649 else
1637 return Fnreverse (retval); 1650 {
1638 } 1651 XSETCDR (retval_tail, Fcons (XCAR (tail), Qnil));
1652 retval_tail = XCDR (retval_tail);
1653 }
1654
1655 tail = XCDR (tail);
1656 }
1657
1658 if (!CONSP (XCDR (list_tail)))
1659 {
1660 break;
1661 }
1662 }
1663 }
1664
1665 return retval;
1639 } 1666 }
1640 1667
1641 DEFUN ("member", Fmember, 2, 2, 0, /* 1668 DEFUN ("member", Fmember, 2, 2, 0, /*
1642 Return non-nil if ELT is an element of LIST. Comparison done with `equal'. 1669 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1643 The value is actually the tail of LIST whose car is ELT. 1670 The value is actually the tail of LIST whose car is ELT.