Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5420:b9167d522a9a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rebase with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 28 Oct 2010 23:53:24 +0200
parents 308d34e9f07d 99de5fd48e87
children 46491edfd94a
comparison
equal deleted inserted replaced
5419:eaf01113cd42 5420:b9167d522a9a
1566 return retval; 1566 return retval;
1567 } 1567 }
1568 1568
1569 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* 1569 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
1570 Modify LIST to remove the last N (default 1) elements. 1570 Modify LIST to remove the last N (default 1) elements.
1571
1571 If LIST has N or fewer elements, nil is returned and LIST is unmodified. 1572 If LIST has N or fewer elements, nil is returned and LIST is unmodified.
1573 Otherwise, LIST may be dotted, but not circular.
1572 */ 1574 */
1573 (list, n)) 1575 (list, n))
1574 { 1576 {
1575 EMACS_INT int_n; 1577 Elemcount int_n = 1;
1576 1578
1577 CHECK_LIST (list); 1579 CHECK_LIST (list);
1578 1580
1579 if (NILP (n)) 1581 if (!NILP (n))
1580 int_n = 1;
1581 else
1582 { 1582 {
1583 CHECK_NATNUM (n); 1583 CHECK_NATNUM (n);
1584 int_n = XINT (n); 1584 int_n = XINT (n);
1585 } 1585 }
1586 1586
1587 { 1587 if (CONSP (list))
1588 Lisp_Object last_cons = list; 1588 {
1589 1589 Lisp_Object last_cons = list;
1590 EXTERNAL_LIST_LOOP_1 (list) 1590
1591 { 1591 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1592 if (int_n-- < 0) 1592 {
1593 last_cons = XCDR (last_cons); 1593 if (int_n-- < 0)
1594 } 1594 {
1595 1595 last_cons = XCDR (last_cons);
1596 if (int_n >= 0) 1596 }
1597 return Qnil; 1597
1598 1598 if (!CONSP (XCDR (tail)))
1599 XCDR (last_cons) = Qnil; 1599 {
1600 return list; 1600 break;
1601 } 1601 }
1602 }
1603
1604 if (int_n >= 0)
1605 {
1606 return Qnil;
1607 }
1608
1609 XCDR (last_cons) = Qnil;
1610 }
1611
1612 return list;
1602 } 1613 }
1603 1614
1604 DEFUN ("butlast", Fbutlast, 1, 2, 0, /* 1615 DEFUN ("butlast", Fbutlast, 1, 2, 0, /*
1605 Return a copy of LIST with the last N (default 1) elements removed. 1616 Return a copy of LIST with the last N (default 1) elements removed.
1617
1606 If LIST has N or fewer elements, nil is returned. 1618 If LIST has N or fewer elements, nil is returned.
1619 Otherwise, LIST may be dotted, but not circular, and `(butlast LIST 0)'
1620 converts a dotted into a true list.
1607 */ 1621 */
1608 (list, n)) 1622 (list, n))
1609 { 1623 {
1610 EMACS_INT int_n; 1624 Lisp_Object retval = Qnil, retval_tail = Qnil;
1625 Elemcount int_n = 1;
1611 1626
1612 CHECK_LIST (list); 1627 CHECK_LIST (list);
1613 1628
1614 if (NILP (n)) 1629 if (!NILP (n))
1615 int_n = 1;
1616 else
1617 { 1630 {
1618 CHECK_NATNUM (n); 1631 CHECK_NATNUM (n);
1619 int_n = XINT (n); 1632 int_n = XINT (n);
1620 } 1633 }
1621 1634
1622 { 1635 if (CONSP (list))
1623 Lisp_Object retval = Qnil; 1636 {
1624 Lisp_Object tail = list; 1637 Lisp_Object tail = list;
1625 1638
1626 EXTERNAL_LIST_LOOP_1 (list) 1639 EXTERNAL_LIST_LOOP_3 (elt, list, list_tail)
1627 { 1640 {
1628 if (--int_n < 0) 1641 if (--int_n < 0)
1629 { 1642 {
1630 retval = Fcons (XCAR (tail), retval); 1643 if (NILP (retval_tail))
1631 tail = XCDR (tail); 1644 {
1632 } 1645 retval = retval_tail = Fcons (XCAR (tail), Qnil);
1633 } 1646 }
1634 1647 else
1635 return Fnreverse (retval); 1648 {
1636 } 1649 XSETCDR (retval_tail, Fcons (XCAR (tail), Qnil));
1650 retval_tail = XCDR (retval_tail);
1651 }
1652
1653 tail = XCDR (tail);
1654 }
1655
1656 if (!CONSP (XCDR (list_tail)))
1657 {
1658 break;
1659 }
1660 }
1661 }
1662
1663 return retval;
1637 } 1664 }
1638 1665
1639 DEFUN ("member", Fmember, 2, 2, 0, /* 1666 DEFUN ("member", Fmember, 2, 2, 0, /*
1640 Return non-nil if ELT is an element of LIST. Comparison done with `equal'. 1667 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1641 The value is actually the tail of LIST whose car is ELT. 1668 The value is actually the tail of LIST whose car is ELT.
2153 Lisp_Object tail; 2180 Lisp_Object tail;
2154 Lisp_Object tem; 2181 Lisp_Object tem;
2155 Lisp_Object l1, l2; 2182 Lisp_Object l1, l2;
2156 Lisp_Object tortoises[2]; 2183 Lisp_Object tortoises[2];
2157 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 2184 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2158 int looped = 0; 2185 int l1_count = 0, l2_count = 0;
2159 2186
2160 l1 = org_l1; 2187 l1 = org_l1;
2161 l2 = org_l2; 2188 l2 = org_l2;
2162 tail = Qnil; 2189 tail = Qnil;
2163 value = Qnil; 2190 value = Qnil;
2199 if (NILP (c_predicate (Fcar (l2), Fcar (l1), predicate, key_func))) 2226 if (NILP (c_predicate (Fcar (l2), Fcar (l1), predicate, key_func)))
2200 { 2227 {
2201 tem = l1; 2228 tem = l1;
2202 l1 = Fcdr (l1); 2229 l1 = Fcdr (l1);
2203 org_l1 = l1; 2230 org_l1 = l1;
2231
2232 if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
2233 {
2234 if (l1_count & 1)
2235 {
2236 if (!CONSP (tortoises[0]))
2237 {
2238 mapping_interaction_error (Qmerge, tortoises[0]);
2239 }
2240
2241 tortoises[0] = XCDR (tortoises[0]);
2242 }
2243
2244 if (EQ (org_l1, tortoises[0]))
2245 {
2246 signal_circular_list_error (org_l1);
2247 }
2248 }
2204 } 2249 }
2205 else 2250 else
2206 { 2251 {
2207 tem = l2; 2252 tem = l2;
2208 l2 = Fcdr (l2); 2253 l2 = Fcdr (l2);
2209 org_l2 = l2; 2254 org_l2 = l2;
2255
2256 if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
2257 {
2258 if (l2_count & 1)
2259 {
2260 if (!CONSP (tortoises[1]))
2261 {
2262 mapping_interaction_error (Qmerge, tortoises[1]);
2263 }
2264
2265 tortoises[1] = XCDR (tortoises[1]);
2266 }
2267
2268 if (EQ (org_l2, tortoises[1]))
2269 {
2270 signal_circular_list_error (org_l2);
2271 }
2272 }
2210 } 2273 }
2274
2211 if (NILP (tail)) 2275 if (NILP (tail))
2212 value = tem; 2276 value = tem;
2213 else 2277 else
2214 Fsetcdr (tail, tem); 2278 Fsetcdr (tail, tem);
2279
2215 tail = tem; 2280 tail = tem;
2216
2217 if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
2218 {
2219 if (looped & 1)
2220 {
2221 tortoises[0] = XCDR (tortoises[0]);
2222 tortoises[1] = XCDR (tortoises[1]);
2223 }
2224
2225 if (EQ (org_l1, tortoises[0]))
2226 {
2227 signal_circular_list_error (org_l1);
2228 }
2229
2230 if (EQ (org_l2, tortoises[1]))
2231 {
2232 signal_circular_list_error (org_l2);
2233 }
2234 }
2235 } 2281 }
2236 } 2282 }
2237 2283
2238 static void 2284 static void
2239 array_merge (Lisp_Object *dest, Elemcount dest_len, 2285 array_merge (Lisp_Object *dest, Elemcount dest_len,