diff src/fns.c @ 5420:b9167d522a9a

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
line wrap: on
line diff
--- a/src/fns.c	Wed Oct 27 23:36:14 2010 +0200
+++ b/src/fns.c	Thu Oct 28 23:53:24 2010 +0200
@@ -1568,72 +1568,99 @@
 
 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
 Modify LIST to remove the last N (default 1) elements.
+
 If LIST has N or fewer elements, nil is returned and LIST is unmodified.
+Otherwise, LIST may be dotted, but not circular.
 */
        (list, n))
 {
-  EMACS_INT int_n;
+  Elemcount int_n = 1;
 
   CHECK_LIST (list);
 
-  if (NILP (n))
-    int_n = 1;
-  else
+  if (!NILP (n))
     {
       CHECK_NATNUM (n);
       int_n = XINT (n);
     }
 
-  {
-    Lisp_Object last_cons = list;
-
-    EXTERNAL_LIST_LOOP_1 (list)
-      {
-	if (int_n-- < 0)
-	  last_cons = XCDR (last_cons);
-      }
-
-    if (int_n >= 0)
-      return Qnil;
-
-    XCDR (last_cons) = Qnil;
-    return list;
-  }
+  if (CONSP (list))
+    {
+      Lisp_Object last_cons = list;
+
+      EXTERNAL_LIST_LOOP_3 (elt, list, tail)
+	{
+	  if (int_n-- < 0)
+	    {
+	      last_cons = XCDR (last_cons);
+	    }
+
+	  if (!CONSP (XCDR (tail)))
+	    {
+	      break;
+	    }
+	}
+
+      if (int_n >= 0)
+	{
+	  return Qnil;
+	}
+
+      XCDR (last_cons) = Qnil;
+    }
+
+  return list;
 }
 
 DEFUN ("butlast", Fbutlast, 1, 2, 0, /*
 Return a copy of LIST with the last N (default 1) elements removed.
+
 If LIST has N or fewer elements, nil is returned.
+Otherwise, LIST may be dotted, but not circular, and `(butlast LIST 0)'
+converts a dotted into a true list.
 */
        (list, n))
 {
-  EMACS_INT int_n;
+  Lisp_Object retval = Qnil, retval_tail = Qnil;
+  Elemcount int_n = 1;
 
   CHECK_LIST (list);
 
-  if (NILP (n))
-    int_n = 1;
-  else
+  if (!NILP (n))
     {
       CHECK_NATNUM (n);
       int_n = XINT (n);
     }
 
-  {
-    Lisp_Object retval = Qnil;
-    Lisp_Object tail = list;
-
-    EXTERNAL_LIST_LOOP_1 (list)
-      {
-	if (--int_n < 0)
-	  {
-	    retval = Fcons (XCAR (tail), retval);
-	    tail = XCDR (tail);
-	  }
-      }
-
-    return Fnreverse (retval);
-  }
+  if (CONSP (list))
+    {
+      Lisp_Object tail = list;
+
+      EXTERNAL_LIST_LOOP_3 (elt, list, list_tail)
+	{
+	  if (--int_n < 0)
+	    {
+	      if (NILP (retval_tail))
+		{
+		  retval = retval_tail = Fcons (XCAR (tail), Qnil);
+		}
+	      else
+		{
+		  XSETCDR (retval_tail, Fcons (XCAR (tail), Qnil));
+		  retval_tail = XCDR (retval_tail);
+		}
+
+	      tail = XCDR (tail);
+	    }
+
+	  if (!CONSP (XCDR (list_tail)))
+	    {
+	      break;
+	    }
+	}
+    }
+
+  return retval;
 }
 
 DEFUN ("member", Fmember, 2, 2, 0, /*
@@ -2155,7 +2182,7 @@
   Lisp_Object l1, l2;
   Lisp_Object tortoises[2];
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-  int looped = 0;
+  int l1_count = 0, l2_count = 0;
 
   l1 = org_l1;
   l2 = org_l2;
@@ -2201,37 +2228,56 @@
 	  tem = l1;
 	  l1 = Fcdr (l1);
 	  org_l1 = l1;
+
+	  if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
+	    {
+	      if (l1_count & 1)
+		{
+		  if (!CONSP (tortoises[0]))
+		    {
+		      mapping_interaction_error (Qmerge, tortoises[0]);
+		    }
+
+		  tortoises[0] = XCDR (tortoises[0]);
+		}
+
+	      if (EQ (org_l1, tortoises[0]))
+		{
+		  signal_circular_list_error (org_l1);
+		}
+	    }
 	}
       else
 	{
 	  tem = l2;
 	  l2 = Fcdr (l2);
 	  org_l2 = l2;
+
+	  if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
+	    {
+	      if (l2_count & 1)
+		{
+		  if (!CONSP (tortoises[1]))
+		    {
+		      mapping_interaction_error (Qmerge, tortoises[1]);
+		    }
+
+		  tortoises[1] = XCDR (tortoises[1]);
+		}
+
+	      if (EQ (org_l2, tortoises[1]))
+		{
+		  signal_circular_list_error (org_l2);
+		}
+	    }
 	}
+
       if (NILP (tail))
 	value = tem;
       else
 	Fsetcdr (tail, tem);
+
       tail = tem;
-
-      if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
-        {
-          if (looped & 1)
-            {
-              tortoises[0] = XCDR (tortoises[0]);
-              tortoises[1] = XCDR (tortoises[1]); 
-            }
-
-          if (EQ (org_l1, tortoises[0]))
-            {
-              signal_circular_list_error (org_l1);
-            }
-
-          if (EQ (org_l2, tortoises[1]))
-            {
-              signal_circular_list_error (org_l2);
-            }
-        }
     }
 }