Mercurial > hg > xemacs-beta

changeset 5432:46491edfd94a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Sun, 07 Nov 2010 00:22:33 +0100
parents 5cddeeeb25bb (current diff) 9f738305f80f (diff)
children 863f16484873
files src/bytecode.c src/fns.c tests/automated/lisp-tests.el
diffstat 7 files changed, 247 insertions(+), 53 deletions(-) [+]
line wrap: on
line diff
--- a/man/ChangeLog	Sun Nov 07 00:15:08 2010 +0100
+++ b/man/ChangeLog	Sun Nov 07 00:22:33 2010 +0100
@@ -1,3 +1,9 @@
+2010-11-06  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* lispref/lists.texi (Rearrangement, Building Lists):
+	Document that #'nreverse and #'reverse now accept sequences, not
+	just lists, in this file.
+
 2010-09-02  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* lispref/os.texi (Time Conversion):
--- a/man/lispref/lists.texi	Sun Nov 07 00:15:08 2010 +0100
+++ b/man/lispref/lists.texi	Sun Nov 07 00:22:33 2010 +0100
@@ -655,9 +655,9 @@
 (@pxref{String Conversion}).
 @end defun
 
-@defun reverse list
-This function creates a new list whose elements are the elements of
-@var{list}, but in reverse order.  The original argument @var{list} is
+@defun reverse sequence
+This function creates a new sequence whose elements are the elements of
+@var{sequence}, but in reverse order.  The original argument @var{sequence} is
 @emph{not} altered.
 
 @example
@@ -998,13 +998,14 @@
 @end smallexample
 @end defun
 
-@defun nreverse list
+@defun nreverse sequence
 @cindex reversing a list
-  This function reverses the order of the elements of @var{list}.
-Unlike @code{reverse}, @code{nreverse} alters its argument by reversing
-the @sc{cdr}s in the cons cells forming the list.  The cons cell that
-used to be the last one in @var{list} becomes the first cell of the
-value.
+@cindex reversing a sequence
+  This function reverses the order of the elements of @var{sequence}.
+Unlike @code{reverse}, @code{nreverse} alters its argument.  If
+@var{sequence} is a list, it does this by reversing the @sc{cdr}s in the
+cons cells forming the sequence.  The cons cell that used to be the last
+one in @var{sequence} becomes the first cell of the value.
 
   For example:
 
@@ -1027,7 +1028,7 @@
 @end example
 
   To avoid confusion, we usually store the result of @code{nreverse}
-back in the same variable which held the original list:
+back in the same variable which held the original sequence:
 
 @example
 (setq x (nreverse x))
--- a/src/ChangeLog	Sun Nov 07 00:15:08 2010 +0100
+++ b/src/ChangeLog	Sun Nov 07 00:22:33 2010 +0100
@@ -1,3 +1,15 @@
+2010-11-06  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecode.c (bytecode_nreverse): Call Fnreverse() if SEQUENCE is
+	not a cons in this function.
+	(Fnreverse, Freverse):
+	Accept sequences, not just lists, in these functions.
+
+2010-11-06  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (Flist_length): Error if LIST is dotted in this function;
+	document this behaviour.
+
 2010-10-25  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* specifier.c (specifier_instance_from_inst_list):
--- a/src/bytecode.c	Sun Nov 07 00:15:08 2010 +0100
+++ b/src/bytecode.c	Sun Nov 07 00:22:33 2010 +0100
@@ -249,21 +249,28 @@
 }
 
 static Lisp_Object
-bytecode_nreverse (Lisp_Object list)
+bytecode_nreverse (Lisp_Object sequence)
 {
-  REGISTER Lisp_Object prev = Qnil;
-  REGISTER Lisp_Object tail = list;
-
-  while (!NILP (tail))
+  if (LISTP (sequence))
     {
-      REGISTER Lisp_Object next;
-      CHECK_CONS (tail);
-      next = XCDR (tail);
-      XCDR (tail) = prev;
-      prev = tail;
-      tail = next;
+      REGISTER Lisp_Object prev = Qnil;
+      REGISTER Lisp_Object tail = sequence;
+
+      while (!NILP (tail))
+	{
+	  REGISTER Lisp_Object next;
+	  CHECK_CONS (tail);
+	  next = XCDR (tail);
+	  XCDR (tail) = prev;
+	  prev = tail;
+	  tail = next;
+	}
+      return prev;
     }
-  return prev;
+  else
+    {
+      return Fnreverse (sequence);
+    }
 }
 
 
--- a/src/fns.c	Sun Nov 07 00:15:08 2010 +0100
+++ b/src/fns.c	Sun Nov 07 00:22:33 2010 +0100
@@ -343,6 +343,7 @@
 
 DEFUN ("list-length", Flist_length, 1, 1, 0, /*
 Return the length of LIST.  Return nil if LIST is circular.
+Error if LIST is dotted.
 */
        (list))
 {
@@ -357,6 +358,11 @@
 	tortoise = XCDR (tortoise);
     }
 
+  if (!LISTP (hare))
+    {
+      signal_malformed_list_error (list);
+    }
+
   return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len);
 }
 
@@ -2084,43 +2090,161 @@
 }
 
 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
-Reverse LIST by destructively modifying cdr pointers.
-Return the beginning of the reversed list.
-Also see: `reverse'.
+Reverse SEQUENCE, destructively.
+
+Return the beginning of the reversed sequence, which will be a distinct Lisp
+object if SEQUENCE is a list with length greater than one.  See also
+`reverse', the non-destructive version of this function.
 */
-       (list))
-{
-  struct gcpro gcpro1, gcpro2;
-  Lisp_Object prev = Qnil;
-  Lisp_Object tail = list;
-
-  /* We gcpro our args; see `nconc' */
-  GCPRO2 (prev, tail);
-  while (!NILP (tail))
-    {
-      REGISTER Lisp_Object next;
-      CONCHECK_CONS (tail);
-      next = XCDR (tail);
-      XCDR (tail) = prev;
-      prev = tail;
-      tail = next;
-    }
-  UNGCPRO;
-  return prev;
+       (sequence))
+{
+  CHECK_SEQUENCE (sequence);
+
+  if (CONSP (sequence))
+    {
+      struct gcpro gcpro1, gcpro2;
+      Lisp_Object prev = Qnil;
+      Lisp_Object tail = sequence;
+
+      /* We gcpro our args; see `nconc' */
+      GCPRO2 (prev, tail);
+      while (!NILP (tail))
+	{
+	  REGISTER Lisp_Object next;
+	  CONCHECK_CONS (tail);
+	  next = XCDR (tail);
+	  XCDR (tail) = prev;
+	  prev = tail;
+	  tail = next;
+	}
+      UNGCPRO;
+      return prev;
+    }
+  else if (VECTORP (sequence))
+    {
+      Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
+      Elemcount half = length / 2;
+      Lisp_Object swap = Qnil;
+
+      while (ii > half)
+	{
+	  swap = XVECTOR_DATA (sequence) [length - ii];
+	  XVECTOR_DATA (sequence) [length - ii]
+	    = XVECTOR_DATA (sequence) [ii - 1];
+	  XVECTOR_DATA (sequence) [ii - 1] = swap;
+	  --ii;
+	}
+    }
+  else if (STRINGP (sequence))
+    {
+      Elemcount length = XSTRING_LENGTH (sequence);
+      Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
+      Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
+
+      while (cursor < endp)
+	{
+	  staging_end -= itext_ichar_len (cursor);
+	  itext_copy_ichar (cursor, staging_end);
+	  INC_IBYTEPTR (cursor);
+	}
+
+      assert (staging == staging_end);
+
+      memcpy (XSTRING_DATA (sequence), staging, length);
+      init_string_ascii_begin (sequence);
+      bump_string_modiff (sequence);
+      sledgehammer_check_ascii_begin (sequence);
+    }
+  else if (BIT_VECTORP (sequence))
+    {
+      Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+      Elemcount length = bit_vector_length (bv), ii = length;
+      Elemcount half = length / 2;
+      int swap = 0;
+
+      while (ii > half)
+	{
+	  swap = bit_vector_bit (bv, length - ii);
+	  set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1));
+	  set_bit_vector_bit (bv, ii - 1, swap);
+	  --ii;
+	}
+    }
+  else 
+    {
+      assert (NILP (sequence));
+    }
+
+  return sequence;
 }
 
 DEFUN ("reverse", Freverse, 1, 1, 0, /*
-Reverse LIST, copying.  Return the beginning of the reversed list.
+Reverse SEQUENCE, copying.  Return the reversed sequence.
 See also the function `nreverse', which is used more often.
 */
-       (list))
-{
-  Lisp_Object reversed_list = Qnil;
-  EXTERNAL_LIST_LOOP_2 (elt, list)
-    {
-      reversed_list = Fcons (elt, reversed_list);
-    }
-  return reversed_list;
+       (sequence))
+{
+  Lisp_Object result = Qnil;
+
+  CHECK_SEQUENCE (sequence);
+
+  if (CONSP (sequence))
+    {
+      EXTERNAL_LIST_LOOP_2 (elt, sequence)
+	{
+	  result = Fcons (elt, result);
+	}
+    }
+  else if (VECTORP (sequence))
+    {
+      Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
+      Lisp_Object *staging = alloca_array (Lisp_Object, length);
+
+      while (ii > 0)
+	{
+	  staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1];
+	  --ii;
+	}
+
+      result = Fvector (length, staging);
+    }
+  else if (STRINGP (sequence))
+    {
+      Elemcount length = XSTRING_LENGTH (sequence);
+      Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
+      Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
+
+      while (cursor < endp)
+	{
+	  staging_end -= itext_ichar_len (cursor);
+	  itext_copy_ichar (cursor, staging_end);
+	  INC_IBYTEPTR (cursor);
+	}
+
+      assert (staging == staging_end);
+
+      result = make_string (staging, length);
+    }
+  else if (BIT_VECTORP (sequence))
+    {
+      Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence), *res;
+      Elemcount length = bit_vector_length (bv), ii = length;
+
+      result = make_bit_vector (length, Qzero);
+      res = XBIT_VECTOR (result);
+
+      while (ii > 0)
+	{
+	  set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1));
+	  --ii;
+	}
+    }
+  else 
+    {
+      assert (NILP (sequence));
+    }
+
+  return result;
 }
 
 static Lisp_Object
--- a/tests/ChangeLog	Sun Nov 07 00:15:08 2010 +0100
+++ b/tests/ChangeLog	Sun Nov 07 00:22:33 2010 +0100
@@ -1,3 +1,14 @@
+2010-11-06  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el (list-nreverse):
+	Check that #'reverse and #'nreverse handle non-list sequences
+	properly.
+
+2010-11-06  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el (malformed-list): Check that #'mapcar,
+	#'map and #'list-length throw this error when appropriate.
+
 2010-10-25  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el:
--- a/tests/automated/lisp-tests.el	Sun Nov 07 00:15:08 2010 +0100
+++ b/tests/automated/lisp-tests.el	Sun Nov 07 00:22:33 2010 +0100
@@ -1038,6 +1038,12 @@
  1)
  "checking multiple values are correctly discarded in mapcar")
 
+(let ((malformed-list '(1 2 3 4 hi there . tail)))
+  (Check-Error malformed-list (mapcar #'identity malformed-list))
+  (Check-Error malformed-list (map nil #'eq [1 2 3 4]
+				   malformed-list))
+  (Check-Error malformed-list (list-length malformed-list)))
+
 ;;-----------------------------------------------------
 ;; Test vector functions
 ;;-----------------------------------------------------
@@ -2476,4 +2482,31 @@
   (Assert (equal expected (merge 'list list '(1) #'<))
 	  "checking merge's circularity checks are sane"))
 
+(flet ((list-nreverse (list)
+	 (do ((list1 list (cdr list1))
+	      (list2 nil (prog1 list1 (setcdr list1 list2))))
+	     ((atom list1) list2))))
+  (let* ((integers (loop for i from 0 to 6000 collect i))
+	 (characters (mapcan #'(lambda (integer)
+				 (if (char-int-p integer)
+				     (list (int-char integer)))) integers))
+	 (fourth-bit #'(lambda (integer) (ash (logand #x10 integer) -4)))
+	 (bits (mapcar fourth-bit integers))
+	 (vector (vconcat integers))
+	 (string (concat characters))
+	 (bit-vector (bvconcat bits)))
+    (Assert (equal (reverse vector)
+	     (vconcat (list-nreverse (copy-list integers)))))
+    (Assert (eq vector (nreverse vector)))
+    (Assert (equal vector (vconcat (list-nreverse (copy-list integers)))))
+    (Assert (equal (reverse string)
+	     (concat (list-nreverse (copy-list characters)))))
+    (Assert (eq string (nreverse string)))
+    (Assert (equal string (concat (list-nreverse (copy-list characters)))))
+    (Assert (eq bit-vector (nreverse bit-vector)))
+    (Assert (equal (bvconcat (list-nreverse (copy-list bits))) bit-vector))
+    (Assert (not (equal bit-vector
+			(mapcar fourth-bit
+				(loop for i from 0 to 6000 collect i)))))))
+
 ;;; end of lisp-tests.el