[COMMIT] Accept sequences generally, not just lists, #'reverse, #'nreverse.

This is something that came up with work I’m doing to get various others of Paul Dietz’ tests working, and it’s a reasonable change generally. Common Lisp specifies that both functions take sequences, not just lists. APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1289078332 0 # Node ID 9f738305f80fcb8039f61664f197f87be61a8960 # Parent 28651c24b3f8db171de88a939777895c737612e8 Accept sequences generally, not just lists, #'reverse, #'nreverse. src/ChangeLog addition: 2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * automated/lisp-tests.el (list-nreverse): Check that #'reverse and #'nreverse handle non-list sequences properly. diff -r 28651c24b3f8 -r 9f738305f80f man/ChangeLog --- a/man/ChangeLog Sat Nov 06 14:51:13 2010 +0000 +++ b/man/ChangeLog Sat Nov 06 21:18:52 2010 +0000 ＠＠ -1,3 +1,9 ＠＠ +2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * lispref/os.texi (Time Conversion): diff -r 28651c24b3f8 -r 9f738305f80f man/lispref/lists.texi --- a/man/lispref/lists.texi Sat Nov 06 14:51:13 2010 +0000 +++ b/man/lispref/lists.texi Sat Nov 06 21:18:52 2010 +0000 ＠＠ -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)) diff -r 28651c24b3f8 -r 9f738305f80f src/ChangeLog --- a/src/ChangeLog Sat Nov 06 14:51:13 2010 +0000 +++ b/src/ChangeLog Sat Nov 06 21:18:52 2010 +0000 ＠＠ -1,3 +1,10 ＠＠ +2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * fns.c (Flist_length): Error if LIST is dotted in this function; diff -r 28651c24b3f8 -r 9f738305f80f src/bytecode.c --- a/src/bytecode.c Sat Nov 06 14:51:13 2010 +0000 +++ b/src/bytecode.c Sat Nov 06 21:18:52 2010 +0000 ＠＠ -251,21 +251,28 ＠＠ } static Lisp_Object -bytecode_nreverse (Lisp_Object list) +bytecode_nreverse (Lisp_Object sequence) { - REGISTER Lisp_Object prev = Qnil; - REGISTER Lisp_Object tail = list; + if (LISTP (sequence)) + { + REGISTER Lisp_Object prev = Qnil; + REGISTER Lisp_Object tail = sequence; - while (!NILP (tail)) + while (!NILP (tail)) + { + REGISTER Lisp_Object next; + CHECK_CONS (tail); + next = XCDR (tail); + XCDR (tail) = prev; + prev = tail; + tail = next; + } + return prev; + } + else { - REGISTER Lisp_Object next; - CHECK_CONS (tail); - next = XCDR (tail); - XCDR (tail) = prev; - prev = tail; - tail = next; + return Fnreverse (sequence); } - return prev; } diff -r 28651c24b3f8 -r 9f738305f80f src/fns.c --- a/src/fns.c Sat Nov 06 14:51:13 2010 +0000 +++ b/src/fns.c Sat Nov 06 21:18:52 2010 +0000 ＠＠ -2092,43 +2092,161 ＠＠ } DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* -Reverse LIST by destructively modifying cdr pointers. -Return the beginning of the reversed list. -Also see: `reverse'. -*/ - (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; +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. +*/ + (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 diff -r 28651c24b3f8 -r 9f738305f80f tests/ChangeLog --- a/tests/ChangeLog Sat Nov 06 14:51:13 2010 +0000 +++ b/tests/ChangeLog Sat Nov 06 21:18:52 2010 +0000 ＠＠ -1,3 +1,9 ＠＠ +2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el (list-nreverse): + Check that #'reverse and #'nreverse handle non-list sequences + properly. + 2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el (malformed-list): Check that #'mapcar, diff -r 28651c24b3f8 -r 9f738305f80f tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Sat Nov 06 14:51:13 2010 +0000 +++ b/tests/automated/lisp-tests.el Sat Nov 06 21:18:52 2010 +0000 ＠＠ -2484,4 +2484,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 -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches