xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 5432:46491edfd94a

Merge with trunk.

author	Mats Lidell <matsl@xemacs.org>
date	Sun, 07 Nov 2010 00:22:33 +0100
parents	b9167d522a9a 9f738305f80f
children	002cb5224e4f

comparison

equal deleted inserted replaced

-:5cddeeeb25bb
+:46491edfd94a
 for shortest_length_among_sequences(), below, for the various sequence
 functions that can usefully operate on circular lists. */
 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))
 {
 Lisp_Object hare, tortoise;
 Elemcount len;
 CONSP (hare) && (! EQ (hare, tortoise) || len == 0);
 hare = XCDR (hare), len++)
 {
 if (len & 1)
 	tortoise = XCDR (tortoise);
+}
+if (!LISTP (hare))
+{
+signal_malformed_list_error (list);
 }
 return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len);
 }
 			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 @ 5432:46491edfd94a