xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 5300:9f738305f80f

Accept sequences generally, not just lists, #'reverse, #'nreverse. src/ChangeLog addition: 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. man/ChangeLog addition: 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. tests/ChangeLog addition: 2010-11-06 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el (list-nreverse): Check that #'reverse and #'nreverse handle non-list sequences properly.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Sat, 06 Nov 2010 21:18:52 +0000
parents	28651c24b3f8
children	6468cf6f0b9d 46491edfd94a

comparison

equal deleted inserted replaced

-:28651c24b3f8
+:9f738305f80f
 			EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
 return alist;
 }
 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
-Reverse LIST by destructively modifying cdr pointers.
+Reverse SEQUENCE, destructively.
-Return the beginning of the reversed list.
-Also see: `reverse'.
+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
-(list))
+`reverse', the non-destructive version of this function.
-{
+*/
-struct gcpro gcpro1, gcpro2;
+(sequence))
-Lisp_Object prev = Qnil;
+{
-Lisp_Object tail = list;
+CHECK_SEQUENCE (sequence);
-/* We gcpro our args; see `nconc' */
+if (CONSP (sequence))
-GCPRO2 (prev, tail);
+{
-while (!NILP (tail))
+struct gcpro gcpro1, gcpro2;
-{
+Lisp_Object prev = Qnil;
-REGISTER Lisp_Object next;
+Lisp_Object tail = sequence;
-CONCHECK_CONS (tail);
-next = XCDR (tail);
+/* We gcpro our args; see `nconc' */
-XCDR (tail) = prev;
+GCPRO2 (prev, tail);
-prev = tail;
+while (!NILP (tail))
-tail = next;
+	{
-}
+	  REGISTER Lisp_Object next;
-UNGCPRO;
+	  CONCHECK_CONS (tail);
-return prev;
+	  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))
+(sequence))
 {
-Lisp_Object reversed_list = Qnil;
+Lisp_Object result = Qnil;
-EXTERNAL_LIST_LOOP_2 (elt, list)
-{
+CHECK_SEQUENCE (sequence);
-reversed_list = Fcons (elt, reversed_list);
-}
+if (CONSP (sequence))
-return reversed_list;
+{
+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
 c_merge_predicate_key (Lisp_Object obj1, Lisp_Object obj2,
 Lisp_Object pred, Lisp_Object key_func)

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5300:9f738305f80f