[COMMIT] Fix some bugs in fns.c, discovered in passing while doing other work.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1289746449 0
# Node ID 4c4085177ca574759fe9206b6d3919be5f4409b4
# Parent 6468cf6f0b9df27b0a91fb87878a9cbb7af7c316
Fix some bugs in fns.c, discovered in passing while doing other work.
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fnreverse):
Check that non-list sequences are writable from Lisp before
modifying them. (There's an argument that we should do this for
list sequences too, but for the moment other code (e.g. #'setcar)
doesn't.)
(mapcarX): Initialise lisp_vals_staging, lisp_vals_type
explicitly, for the sake of compile warnings. Check if
lisp_vals_staging is non-NULL when deciding whether to replace a
string's range.
(Fsome): Cross-reference to #'find-if in the doc string for this
function.
(Freduce): GCPRO accum in this function, when a key argument is
specicified it can be silently garbage-collected. When deciding
whether to iterate across a string, check whether the cursor
exceeds the byte len; while iterating, increment an integer
counter. Don't ABORT() if check_sequence_range() returns when
handed a suspicious sequence; it is legal to supply the length of
SEQUENCE as the :end keyword value, and this will provoke our
suspicions, legitimately enough. (Problems with this function
revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.)
(Freplace): Check list sequence lengths using the arguments, not
the conses we're currently looking at, thank you Paul Dietz.
diff -r 6468cf6f0b9d -r 4c4085177ca5 src/ChangeLog
--- a/src/ChangeLog Sun Nov 14 14:13:06 2010 +0000
+++ b/src/ChangeLog Sun Nov 14 14:54:09 2010 +0000
＠＠ -1,3 +1,28 ＠＠
+2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Fnreverse):
+ Check that non-list sequences are writable from Lisp before
+ modifying them. (There's an argument that we should do this for
+ list sequences too, but for the moment other code (e.g. #'setcar)
+ doesn't.)
+ (mapcarX): Initialise lisp_vals_staging, lisp_vals_type
+ explicitly, for the sake of compile warnings. Check if
+ lisp_vals_staging is non-NULL when deciding whether to replace a
+ string's range.
+ (Fsome): Cross-reference to #'find-if in the doc string for this
+ function.
+ (Freduce): GCPRO accum in this function, when a key argument is
+ specicified it can be silently garbage-collected. When deciding
+ whether to iterate across a string, check whether the cursor
+ exceeds the byte len; while iterating, increment an integer
+ counter. Don't ABORT() if check_sequence_range() returns when
+ handed a suspicious sequence; it is legal to supply the length of
+ SEQUENCE as the :end keyword value, and this will provoke our
+ suspicions, legitimately enough. (Problems with this function
+ revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.)
+ (Freplace): Check list sequence lengths using the arguments, not
+ the conses we're currently looking at, thank you Paul Dietz.
+
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Frandom): Correct the docstring here, the name of the
diff -r 6468cf6f0b9d -r 4c4085177ca5 src/fns.c
--- a/src/fns.c Sun Nov 14 14:13:06 2010 +0000
+++ b/src/fns.c Sun Nov 14 14:54:09 2010 +0000
＠＠ -1108,11 +1108,12 ＠＠
sequence = Fnthcdr (make_int (ss), sequence);
}
+ ii = ss + 1;
+
if (ss < ee && !NILP (sequence))
{
result = result_tail = Fcons (Fcar (sequence), Qnil);
sequence = Fcdr (sequence);
- ii = ss + 1;
{
EXTERNAL_LIST_LOOP_2 (elt, sequence)
＠＠ -2128,6 +2129,7 ＠＠
Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
Elemcount half = length / 2;
Lisp_Object swap = Qnil;
+ CHECK_LISP_WRITEABLE (sequence);
while (ii > half)
{
＠＠ -2144,6 +2146,7 ＠＠
Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
+ CHECK_LISP_WRITEABLE (sequence);
while (cursor < endp)
{
staging_end -= itext_ichar_len (cursor);
＠＠ -2165,6 +2168,7 ＠＠
Elemcount half = length / 2;
int swap = 0;
+ CHECK_LISP_WRITEABLE (sequence);
while (ii > half)
{
swap = bit_vector_bit (bv, length - ii);
＠＠ -4450,7 +4454,7 ＠＠
{
Lisp_Object called, *args;
struct gcpro gcpro1, gcpro2;
- Ibyte *lisp_vals_staging, *cursor;
+ Ibyte *lisp_vals_staging = NULL, *cursor = NULL;
int i, j;
assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
＠＠ -4497,7 +4501,7 ＠＠
}
else
{
- enum lrecord_type lisp_vals_type;
+ enum lrecord_type lisp_vals_type = lrecord_type_symbol;
Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
for (j = 0; j < nsequences; ++j)
{
＠＠ -4516,6 +4520,10 ＠＠
lisp_vals_staging = cursor
= alloca_ibytes (call_count * MAX_ICHAR_LEN);
}
+ else if (ARRAYP (lisp_vals))
+ {
+ CHECK_LISP_WRITEABLE (lisp_vals);
+ }
}
for (i = 0; i < call_count; ++i)
＠＠ -4641,9 +4649,9 ＠＠
}
}
- if (!EQ (caller, Qsome) && !EQ (caller, Qevery) &&
- lrecord_type_string == lisp_vals_type)
- {
+ if (lisp_vals_staging != NULL)
+ {
+ CHECK_LISP_WRITEABLE (lisp_vals);
replace_string_range (lisp_vals, Qzero, make_int (call_count),
lisp_vals_staging, cursor);
}
＠＠ -4659,7 +4667,7 ＠＠
shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
{
Elemcount len = EMACS_INT_MAX;
- Lisp_Object length;
+ Lisp_Object length = Qnil;
int i;
for (i = 0; i < nsequences; ++i)
＠＠ -4953,6 +4961,10 ＠＠
With optional SEQUENCES, call PREDICATE each time with as many arguments as
there are SEQUENCES (plus one for the element from SEQUENCE).
+See also `find-if', which returns the corresponding element of SEQUENCE,
+rather than the value given by PREDICATE, and accepts bounding index
+keywords.
+
arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
*/
(int nargs, Lisp_Object *args))
＠＠ -5205,11 +5217,14 ＠＠
if (VECTORP (sequence))
{
Lisp_Vector *vv = XVECTOR (sequence);
+ struct gcpro gcpro1;
check_sequence_range (sequence, start, end, make_int (vv->size));
ending = min (ending, vv->size);
+ GCPRO1 (accum);
+
if (!UNBOUNDP (initial_value))
{
accum = initial_value;
＠＠ -5242,15 +5257,19 ＠＠
accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
}
}
+
+ UNGCPRO;
}
else if (BIT_VECTORP (sequence))
{
Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+ struct gcpro gcpro1;
check_sequence_range (sequence, start, end, make_int (bv->size));
-
ending = min (ending, bv->size);
+ GCPRO1 (accum);
+
if (!UNBOUNDP (initial_value))
{
accum = initial_value;
＠＠ -5287,9 +5306,16 ＠＠
accum);
}
}
+
+ UNGCPRO;
+
}
else if (STRINGP (sequence))
{
+ struct gcpro gcpro1;
+
+ GCPRO1 (accum);
+
if (NILP (from_end))
{
Bytecount byte_len = XSTRING_LENGTH (sequence);
＠＠ -5307,7 +5333,7 ＠＠
{
accum = initial_value;
}
- else if (ending - starting)
+ else if (ending - starting && cursor_offset < byte_len)
{
accum = KEY (key, make_char (itext_ichar (cursor)));
starting++;
＠＠ -5322,6 +5348,7 ＠＠
INC_IBYTEPTR (cursor);
cursor_offset = cursor - startp;
+ ii++;
}
while (cursor_offset < byte_len && ii < ending)
＠＠ -5346,7 +5373,6 ＠＠
if (ii < starting || (ii < ending && !NILP (end)))
{
check_sequence_range (sequence, start, end, Flength (sequence));
- ABORT ();
}
}
else
＠＠ -5356,7 +5382,6 ＠＠
const Ibyte *cursor;
check_sequence_range (sequence, start, end, make_int (len));
-
ending = min (ending, len);
cursor = string_char_addr (sequence, ending - 1);
cursor_offset = cursor - XSTRING_DATA (sequence);
＠＠ -5403,15 +5428,17 ＠＠
}
}
}
+
+ UNGCPRO;
}
else if (LISTP (sequence))
{
if (NILP (from_end))
{
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2;
Lisp_Object tailed = Qnil;
- GCPRO1 (tailed);
+ GCPRO2 (tailed, accum);
if (!UNBOUNDP (initial_value))
{
＠＠ -5464,7 +5491,6 ＠＠
if (ii < starting || (ii < ending && !NILP (end)))
{
check_sequence_range (sequence, start, end, Flength (sequence));
- ABORT ();
}
}
else
＠＠ -5930,12 +5956,12 ＠＠
if (NILP (sequence1))
{
- check_sequence_range (sequence1, start1, end1,
+ check_sequence_range (args[0], start1, end1,
make_int (XINT (start1) + shortest_len));
}
else if (NILP (sequence2))
{
- check_sequence_range (sequence2, start2, end2,
+ check_sequence_range (args[1], start2, end2,
make_int (XINT (start2) + shortest_len));
}
}
＠＠ -5998,7 +6024,7 ＠＠
if (NILP (sequence1))
{
- check_sequence_range (sequence1, start1, end1,
+ check_sequence_range (args[0], start1, end1,
make_int (XINT (start1) + starting1));
}
}
＠＠ -6055,7 +6081,7 ＠＠
if (NILP (sequence2))
{
- check_sequence_range (sequence2, start2, end2,
+ check_sequence_range (args[1], start2, end2,
make_int (XINT (start2) + starting2));
}
}
--
“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
- 1 participants
- 0 comments
[COMMIT] Correct argument name in docstring, #'random.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1289743986 0
# Node ID 6468cf6f0b9df27b0a91fb87878a9cbb7af7c316
# Parent ec05a30f7148371455c9a76027727a20a5516df6
Correct argument name in docstring, #'random.
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Frandom): Correct the docstring here, the name of the
argument is LIMIT, not N.
diff -r ec05a30f7148 -r 6468cf6f0b9d src/ChangeLog
--- a/src/ChangeLog Sun Nov 14 13:46:29 2010 +0000
+++ b/src/ChangeLog Sun Nov 14 14:13:06 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Frandom): Correct the docstring here, the name of the
+ argument is LIMIT, not N.
+
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (bytecode_nreverse): Call Fnreverse() if SEQUENCE is
diff -r ec05a30f7148 -r 6468cf6f0b9d src/fns.c
--- a/src/fns.c Sun Nov 14 13:46:29 2010 +0000
+++ b/src/fns.c Sun Nov 14 14:13:06 2010 +0000
＠＠ -214,9 +214,10 ＠＠
DEFUN ("random", Frandom, 0, 1, 0, /*
Return a pseudo-random number.
All fixnums are equally likely. On most systems, this is 31 bits' worth.
-With positive integer argument N, return random number in interval [0,N).
-N can be a bignum, in which case the range of possible values is extended.
-With argument t, set the random number seed from the current time and pid.
+With positive integer argument LIMIT, return random number in interval [0,
+LIMIT). LIMIT can be a bignum, in which case the range of possible values
+is extended. With argument t, set the random number seed from the current
+time and pid.
*/
(limit))
{
--
“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
- 1 participants
- 0 comments
commit: Fix some bugs in fns.c, discovered in passing while doing other work.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5303:4c4085177ca5
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Nov 14 14:54:09 2010 +0000
files: src/ChangeLog src/fns.c
description:
Fix some bugs in fns.c, discovered in passing while doing other work.
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fnreverse):
Check that non-list sequences are writable from Lisp before
modifying them. (There's an argument that we should do this for
list sequences too, but for the moment other code (e.g. #'setcar)
doesn't.)
(mapcarX): Initialise lisp_vals_staging, lisp_vals_type
explicitly, for the sake of compile warnings. Check if
lisp_vals_staging is non-NULL when deciding whether to replace a
string's range.
(Fsome): Cross-reference to #'find-if in the doc string for this
function.
(Freduce): GCPRO accum in this function, when a key argument is
specicified it can be silently garbage-collected. When deciding
whether to iterate across a string, check whether the cursor
exceeds the byte len; while iterating, increment an integer
counter. Don't ABORT() if check_sequence_range() returns when
handed a suspicious sequence; it is legal to supply the length of
SEQUENCE as the :end keyword value, and this will provoke our
suspicions, legitimately enough. (Problems with this function
revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.)
(Freplace): Check list sequence lengths using the arguments, not
the conses we're currently looking at, thank you Paul Dietz.
diff -r 6468cf6f0b9d -r 4c4085177ca5 src/ChangeLog
--- a/src/ChangeLog Sun Nov 14 14:13:06 2010 +0000
+++ b/src/ChangeLog Sun Nov 14 14:54:09 2010 +0000
＠＠ -1,3 +1,28 ＠＠
+2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Fnreverse):
+ Check that non-list sequences are writable from Lisp before
+ modifying them. (There's an argument that we should do this for
+ list sequences too, but for the moment other code (e.g. #'setcar)
+ doesn't.)
+ (mapcarX): Initialise lisp_vals_staging, lisp_vals_type
+ explicitly, for the sake of compile warnings. Check if
+ lisp_vals_staging is non-NULL when deciding whether to replace a
+ string's range.
+ (Fsome): Cross-reference to #'find-if in the doc string for this
+ function.
+ (Freduce): GCPRO accum in this function, when a key argument is
+ specicified it can be silently garbage-collected. When deciding
+ whether to iterate across a string, check whether the cursor
+ exceeds the byte len; while iterating, increment an integer
+ counter. Don't ABORT() if check_sequence_range() returns when
+ handed a suspicious sequence; it is legal to supply the length of
+ SEQUENCE as the :end keyword value, and this will provoke our
+ suspicions, legitimately enough. (Problems with this function
+ revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.)
+ (Freplace): Check list sequence lengths using the arguments, not
+ the conses we're currently looking at, thank you Paul Dietz.
+
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Frandom): Correct the docstring here, the name of the
diff -r 6468cf6f0b9d -r 4c4085177ca5 src/fns.c
--- a/src/fns.c Sun Nov 14 14:13:06 2010 +0000
+++ b/src/fns.c Sun Nov 14 14:54:09 2010 +0000
＠＠ -1108,11 +1108,12 ＠＠
sequence = Fnthcdr (make_int (ss), sequence);
}
+ ii = ss + 1;
+
if (ss < ee && !NILP (sequence))
{
result = result_tail = Fcons (Fcar (sequence), Qnil);
sequence = Fcdr (sequence);
- ii = ss + 1;
{
EXTERNAL_LIST_LOOP_2 (elt, sequence)
＠＠ -2128,6 +2129,7 ＠＠
Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
Elemcount half = length / 2;
Lisp_Object swap = Qnil;
+ CHECK_LISP_WRITEABLE (sequence);
while (ii > half)
{
＠＠ -2144,6 +2146,7 ＠＠
Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
+ CHECK_LISP_WRITEABLE (sequence);
while (cursor < endp)
{
staging_end -= itext_ichar_len (cursor);
＠＠ -2165,6 +2168,7 ＠＠
Elemcount half = length / 2;
int swap = 0;
+ CHECK_LISP_WRITEABLE (sequence);
while (ii > half)
{
swap = bit_vector_bit (bv, length - ii);
＠＠ -4450,7 +4454,7 ＠＠
{
Lisp_Object called, *args;
struct gcpro gcpro1, gcpro2;
- Ibyte *lisp_vals_staging, *cursor;
+ Ibyte *lisp_vals_staging = NULL, *cursor = NULL;
int i, j;
assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
＠＠ -4497,7 +4501,7 ＠＠
}
else
{
- enum lrecord_type lisp_vals_type;
+ enum lrecord_type lisp_vals_type = lrecord_type_symbol;
Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
for (j = 0; j < nsequences; ++j)
{
＠＠ -4516,6 +4520,10 ＠＠
lisp_vals_staging = cursor
= alloca_ibytes (call_count * MAX_ICHAR_LEN);
}
+ else if (ARRAYP (lisp_vals))
+ {
+ CHECK_LISP_WRITEABLE (lisp_vals);
+ }
}
for (i = 0; i < call_count; ++i)
＠＠ -4641,9 +4649,9 ＠＠
}
}
- if (!EQ (caller, Qsome) && !EQ (caller, Qevery) &&
- lrecord_type_string == lisp_vals_type)
- {
+ if (lisp_vals_staging != NULL)
+ {
+ CHECK_LISP_WRITEABLE (lisp_vals);
replace_string_range (lisp_vals, Qzero, make_int (call_count),
lisp_vals_staging, cursor);
}
＠＠ -4659,7 +4667,7 ＠＠
shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
{
Elemcount len = EMACS_INT_MAX;
- Lisp_Object length;
+ Lisp_Object length = Qnil;
int i;
for (i = 0; i < nsequences; ++i)
＠＠ -4953,6 +4961,10 ＠＠
With optional SEQUENCES, call PREDICATE each time with as many arguments as
there are SEQUENCES (plus one for the element from SEQUENCE).
+See also `find-if', which returns the corresponding element of SEQUENCE,
+rather than the value given by PREDICATE, and accepts bounding index
+keywords.
+
arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
*/
(int nargs, Lisp_Object *args))
＠＠ -5205,10 +5217,13 ＠＠
if (VECTORP (sequence))
{
Lisp_Vector *vv = XVECTOR (sequence);
+ struct gcpro gcpro1;
check_sequence_range (sequence, start, end, make_int (vv->size));
ending = min (ending, vv->size);
+
+ GCPRO1 (accum);
if (!UNBOUNDP (initial_value))
{
＠＠ -5242,14 +5257,18 ＠＠
accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
}
}
+
+ UNGCPRO;
}
else if (BIT_VECTORP (sequence))
{
Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+ struct gcpro gcpro1;
check_sequence_range (sequence, start, end, make_int (bv->size));
-
ending = min (ending, bv->size);
+
+ GCPRO1 (accum);
if (!UNBOUNDP (initial_value))
{
＠＠ -5287,9 +5306,16 ＠＠
accum);
}
}
+
+ UNGCPRO;
+
}
else if (STRINGP (sequence))
{
+ struct gcpro gcpro1;
+
+ GCPRO1 (accum);
+
if (NILP (from_end))
{
Bytecount byte_len = XSTRING_LENGTH (sequence);
＠＠ -5307,7 +5333,7 ＠＠
{
accum = initial_value;
}
- else if (ending - starting)
+ else if (ending - starting && cursor_offset < byte_len)
{
accum = KEY (key, make_char (itext_ichar (cursor)));
starting++;
＠＠ -5322,6 +5348,7 ＠＠
INC_IBYTEPTR (cursor);
cursor_offset = cursor - startp;
+ ii++;
}
while (cursor_offset < byte_len && ii < ending)
＠＠ -5346,7 +5373,6 ＠＠
if (ii < starting || (ii < ending && !NILP (end)))
{
check_sequence_range (sequence, start, end, Flength (sequence));
- ABORT ();
}
}
else
＠＠ -5356,7 +5382,6 ＠＠
const Ibyte *cursor;
check_sequence_range (sequence, start, end, make_int (len));
-
ending = min (ending, len);
cursor = string_char_addr (sequence, ending - 1);
cursor_offset = cursor - XSTRING_DATA (sequence);
＠＠ -5403,15 +5428,17 ＠＠
}
}
}
+
+ UNGCPRO;
}
else if (LISTP (sequence))
{
if (NILP (from_end))
{
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2;
Lisp_Object tailed = Qnil;
- GCPRO1 (tailed);
+ GCPRO2 (tailed, accum);
if (!UNBOUNDP (initial_value))
{
＠＠ -5464,7 +5491,6 ＠＠
if (ii < starting || (ii < ending && !NILP (end)))
{
check_sequence_range (sequence, start, end, Flength (sequence));
- ABORT ();
}
}
else
＠＠ -5930,12 +5956,12 ＠＠
if (NILP (sequence1))
{
- check_sequence_range (sequence1, start1, end1,
+ check_sequence_range (args[0], start1, end1,
make_int (XINT (start1) + shortest_len));
}
else if (NILP (sequence2))
{
- check_sequence_range (sequence2, start2, end2,
+ check_sequence_range (args[1], start2, end2,
make_int (XINT (start2) + shortest_len));
}
}
＠＠ -5998,7 +6024,7 ＠＠
if (NILP (sequence1))
{
- check_sequence_range (sequence1, start1, end1,
+ check_sequence_range (args[0], start1, end1,
make_int (XINT (start1) + starting1));
}
}
＠＠ -6055,7 +6081,7 ＠＠
if (NILP (sequence2))
{
- check_sequence_range (sequence2, start2, end2,
+ check_sequence_range (args[1], start2, end2,
make_int (XINT (start2) + starting2));
}
}
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Correct argument name in docstring, #'random.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5302:6468cf6f0b9d
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Nov 14 14:13:06 2010 +0000
files: src/ChangeLog src/fns.c
description:
Correct argument name in docstring, #'random.
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Frandom): Correct the docstring here, the name of the
argument is LIMIT, not N.
diff -r ec05a30f7148 -r 6468cf6f0b9d src/ChangeLog
--- a/src/ChangeLog Sun Nov 14 13:46:29 2010 +0000
+++ b/src/ChangeLog Sun Nov 14 14:13:06 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Frandom): Correct the docstring here, the name of the
+ argument is LIMIT, not N.
+
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (bytecode_nreverse): Call Fnreverse() if SEQUENCE is
diff -r ec05a30f7148 -r 6468cf6f0b9d src/fns.c
--- a/src/fns.c Sun Nov 14 13:46:29 2010 +0000
+++ b/src/fns.c Sun Nov 14 14:13:06 2010 +0000
＠＠ -214,9 +214,10 ＠＠
DEFUN ("random", Frandom, 0, 1, 0, /*
Return a pseudo-random number.
All fixnums are equally likely. On most systems, this is 31 bits' worth.
-With positive integer argument N, return random number in interval [0,N).
-N can be a bignum, in which case the range of possible values is extended.
-With argument t, set the random number seed from the current time and pid.
+With positive integer argument LIMIT, return random number in interval [0,
+LIMIT). LIMIT can be a bignum, in which case the range of possible values
+is extended. With argument t, set the random number seed from the current
+time and pid.
*/
(limit))
{
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Fix a bytecomp.el bug compiling #'eql, which was masked by cl-macs.el
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
The bug this fixes only manifests itself when bytecomp.el is loaded after
cl-macs.el, which never happens in the normal course of events; I noticed it
when making some changes to bytecomp.el and reloading it. The below is
clearer and a little faster.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1289742389 0
# Node ID ec05a30f7148371455c9a76027727a20a5516df6
# Parent 9f738305f80fcb8039f61664f197f87be61a8960
Fix a bytecomp.el bug compiling #'eql, which was masked by cl-macs.el
lisp/ChangeLog addition:
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
diff -r 9f738305f80f -r ec05a30f7148 lisp/ChangeLog
--- a/lisp/ChangeLog Sat Nov 06 21:18:52 2010 +0000
+++ b/lisp/ChangeLog Sun Nov 14 13:46:29 2010 +0000
＠＠ -1,3 +1,17 ＠＠
+2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (eql): Don't remove the byte-compile property of this
+ symbol. That was necessary to override a bug in bytecomp.el where
+ #'eql was confused with #'eq, which bug we no longer have.
+ If neither expression is constant, don't attempt to handle the
+ expression in this compiler macro, leave it to byte-compile-eql,
+ which produces better code anyway.
+ * bytecomp.el (eq): #'eql is not the function associated with the
+ byte-eq byte code.
+ (byte-compile-eql): Add an explicit compile method for this
+ function, for cases where the cl-macs compiler macro hasn't
+ reduced it to #'eq or #'equal.
+
2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
Add compiler macros and compilation sanity-checking for various
diff -r 9f738305f80f -r ec05a30f7148 lisp/bytecomp.el
--- a/lisp/bytecomp.el Sat Nov 06 21:18:52 2010 +0000
+++ b/lisp/bytecomp.el Sun Nov 14 13:46:29 2010 +0000
＠＠ -3160,7 +3160,7 ＠＠
(byte-defop-compiler fixnump 1)
(byte-defop-compiler skip-chars-forward 1-2+1)
(byte-defop-compiler skip-chars-backward 1-2+1)
-(byte-defop-compiler (eql byte-eq) 2)
+(byte-defop-compiler eq 2)
(byte-defop-compiler20 old-eq 2)
(byte-defop-compiler20 old-memq 2)
(byte-defop-compiler cons 2)
＠＠ -3909,6 +3909,7 ＠＠
(byte-defop-compiler-1 let*)
(byte-defop-compiler-1 integerp)
+(byte-defop-compiler-1 eql)
(byte-defop-compiler-1 fillarray)
(defun byte-compile-progn (form)
＠＠ -4143,6 +4144,24 ＠＠
(byte-compile-constant t)
(byte-compile-out-tag donetag))))
+(defun byte-compile-eql (form)
+ (if (eql 3 (length form))
+ (let ((donetag (byte-compile-make-tag))
+ (eqtag (byte-compile-make-tag)))
+ (mapc 'byte-compile-form (cdr form))
+ (byte-compile-out 'byte-dup 0)
+ (byte-compile-out 'byte-numberp 0)
+ (byte-compile-goto 'byte-goto-if-nil eqtag)
+ (byte-compile-out 'byte-dup 0)
+ (byte-compile-out 'byte-fixnump 0)
+ (byte-compile-goto 'byte-goto-if-not-nil eqtag)
+ (byte-compile-out 'byte-equal 0)
+ (byte-compile-goto 'byte-goto donetag)
+ (byte-compile-out-tag eqtag)
+ (byte-compile-out 'byte-eq 0)
+ (byte-compile-out-tag donetag))
+ (byte-compile-subr-wrong-args form 2)))
+
;;(byte-defop-compiler-1 /= byte-compile-negated)
(byte-defop-compiler-1 atom byte-compile-negated)
(byte-defop-compiler-1 nlistp byte-compile-negated)
diff -r 9f738305f80f -r ec05a30f7148 lisp/cl-macs.el
--- a/lisp/cl-macs.el Sat Nov 06 21:18:52 2010 +0000
+++ b/lisp/cl-macs.el Sun Nov 14 13:46:29 2010 +0000
＠＠ -3270,7 +3270,6 ＠＠
(defun cl-non-fixnum-number-p (object)
(and (numberp object) (not (fixnump object))))
-(put 'eql 'byte-compile nil)
(define-compiler-macro eql (&whole form a b)
(cond ((eq (cl-const-expr-p a) t)
(let ((val (cl-const-expr-val a)))
＠＠ -3282,15 +3281,6 ＠＠
(if (cl-non-fixnum-number-p val)
(list 'equal a b)
(list 'eq a b))))
- ((cl-simple-expr-p a 5)
- (list 'if (list 'numberp a)
- (list 'equal a b)
- (list 'eq a b)))
- ((and (cl-safe-expr-p a)
- (cl-simple-expr-p b 5))
- (list 'if (list 'numberp b)
- (list 'equal a b)
- (list 'eq a b)))
(t form)))
(macrolet
--
“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
- 1 participants
- 0 comments
commit: Fix a bytecomp.el bug compiling #'eql, which was masked by cl-macs.el
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5301:ec05a30f7148
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Nov 14 13:46:29 2010 +0000
files: lisp/ChangeLog lisp/bytecomp.el lisp/cl-macs.el
description:
Fix a bytecomp.el bug compiling #'eql, which was masked by cl-macs.el
lisp/ChangeLog addition:
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
diff -r 9f738305f80f -r ec05a30f7148 lisp/ChangeLog
--- a/lisp/ChangeLog Sat Nov 06 21:18:52 2010 +0000
+++ b/lisp/ChangeLog Sun Nov 14 13:46:29 2010 +0000
＠＠ -1,3 +1,17 ＠＠
+2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (eql): Don't remove the byte-compile property of this
+ symbol. That was necessary to override a bug in bytecomp.el where
+ #'eql was confused with #'eq, which bug we no longer have.
+ If neither expression is constant, don't attempt to handle the
+ expression in this compiler macro, leave it to byte-compile-eql,
+ which produces better code anyway.
+ * bytecomp.el (eq): #'eql is not the function associated with the
+ byte-eq byte code.
+ (byte-compile-eql): Add an explicit compile method for this
+ function, for cases where the cl-macs compiler macro hasn't
+ reduced it to #'eq or #'equal.
+
2010-10-25 Aidan Kehoe <kehoea(a)parhasard.net>
Add compiler macros and compilation sanity-checking for various
diff -r 9f738305f80f -r ec05a30f7148 lisp/bytecomp.el
--- a/lisp/bytecomp.el Sat Nov 06 21:18:52 2010 +0000
+++ b/lisp/bytecomp.el Sun Nov 14 13:46:29 2010 +0000
＠＠ -3160,7 +3160,7 ＠＠
(byte-defop-compiler fixnump 1)
(byte-defop-compiler skip-chars-forward 1-2+1)
(byte-defop-compiler skip-chars-backward 1-2+1)
-(byte-defop-compiler (eql byte-eq) 2)
+(byte-defop-compiler eq 2)
(byte-defop-compiler20 old-eq 2)
(byte-defop-compiler20 old-memq 2)
(byte-defop-compiler cons 2)
＠＠ -3909,6 +3909,7 ＠＠
(byte-defop-compiler-1 let*)
(byte-defop-compiler-1 integerp)
+(byte-defop-compiler-1 eql)
(byte-defop-compiler-1 fillarray)
(defun byte-compile-progn (form)
＠＠ -4142,6 +4143,24 ＠＠
(byte-compile-discard)
(byte-compile-constant t)
(byte-compile-out-tag donetag))))
+
+(defun byte-compile-eql (form)
+ (if (eql 3 (length form))
+ (let ((donetag (byte-compile-make-tag))
+ (eqtag (byte-compile-make-tag)))
+ (mapc 'byte-compile-form (cdr form))
+ (byte-compile-out 'byte-dup 0)
+ (byte-compile-out 'byte-numberp 0)
+ (byte-compile-goto 'byte-goto-if-nil eqtag)
+ (byte-compile-out 'byte-dup 0)
+ (byte-compile-out 'byte-fixnump 0)
+ (byte-compile-goto 'byte-goto-if-not-nil eqtag)
+ (byte-compile-out 'byte-equal 0)
+ (byte-compile-goto 'byte-goto donetag)
+ (byte-compile-out-tag eqtag)
+ (byte-compile-out 'byte-eq 0)
+ (byte-compile-out-tag donetag))
+ (byte-compile-subr-wrong-args form 2)))
;;(byte-defop-compiler-1 /= byte-compile-negated)
(byte-defop-compiler-1 atom byte-compile-negated)
diff -r 9f738305f80f -r ec05a30f7148 lisp/cl-macs.el
--- a/lisp/cl-macs.el Sat Nov 06 21:18:52 2010 +0000
+++ b/lisp/cl-macs.el Sun Nov 14 13:46:29 2010 +0000
＠＠ -3270,7 +3270,6 ＠＠
(defun cl-non-fixnum-number-p (object)
(and (numberp object) (not (fixnump object))))
-(put 'eql 'byte-compile nil)
(define-compiler-macro eql (&whole form a b)
(cond ((eq (cl-const-expr-p a) t)
(let ((val (cl-const-expr-val a)))
＠＠ -3282,15 +3281,6 ＠＠
(if (cl-non-fixnum-number-p val)
(list 'equal a b)
(list 'eq a b))))
- ((cl-simple-expr-p a 5)
- (list 'if (list 'numberp a)
- (list 'equal a b)
- (list 'eq a b)))
- ((and (cl-safe-expr-p a)
- (cl-simple-expr-p b 5))
- (list 'if (list 'numberp b)
- (list 'equal a b)
- (list 'eq a b)))
(t form)))
(macrolet
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[CARBON2-COMMIT] Fix the Carbon2 build, use non-in-tree XPM and avoid reserved words.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1289172601 0
# Node ID 2c4a037960ffbba91ad7518996539b6d146160b2
# Parent 5a1589f2687677cbe4e491791e11302e1ff72196
Fix the Carbon2 build, use non-in-tree XPM and avoid reserved words.
src/ChangeLog.carbon2 addition:
2010-11-07 Aidan Kehoe <kehoea(a)parhasard.net>
* glyphs.c: Dont #include the in-tree carbon library here, it
breaks the build.
* glyphs-carbon.c: Hackishly use the X11 include files here;
really the right answer is not to include the XPM library with the
Carbon build at all.
* event-carbon.c (debug_print_event): Don't confuse the C++
compiler by using a reserved word as a parameter name.
diff -r 5a1589f26876 -r 2c4a037960ff src/ChangeLog.carbon2
--- a/src/ChangeLog.carbon2 Sun Nov 07 23:01:49 2010 +0000
+++ b/src/ChangeLog.carbon2 Sun Nov 07 23:30:01 2010 +0000
＠＠ -1,3 +1,13 ＠＠
+2010-11-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * glyphs.c: Dont #include the in-tree carbon library here, it
+ breaks the build.
+ * glyphs-carbon.c: Hackishly use the X11 include files here;
+ really the right answer is not to include the XPM library with the
+ Carbon build at all.
+ * event-carbon.c (debug_print_event): Don't confuse the C++
+ compiler by using a reserved word as a parameter name.
+
2010-06-04 Aidan Kehoe <kehoea(a)parhasard.net>
* select-carbon.c (pasteboard_get_utext_or_text):
diff -r 5a1589f26876 -r 2c4a037960ff src/event-carbon.c
--- a/src/event-carbon.c Sun Nov 07 23:01:49 2010 +0000
+++ b/src/event-carbon.c Sun Nov 07 23:30:01 2010 +0000
＠＠ -488,9 +488,9 ＠＠
}
static void
-debug_print_event (EventClass class, UInt32 kind)
+debug_print_event (EventClass klasse, UInt32 kind)
{
- stderr_out ("Class = %c%c%c%c; ", (char)(class >> 24), (char)(class >> 16 & 0xff), (char)(class >> 8 & 0xff), (char)(class & 0xff));
+ stderr_out ("Class = %c%c%c%c; ", (char)(klasse >> 24), (char)(klasse >> 16 & 0xff), (char)(klasse >> 8 & 0xff), (char)(klasse & 0xff));
stderr_out ("kind = %lu", kind);
}
diff -r 5a1589f26876 -r 2c4a037960ff src/glyphs-carbon.c
--- a/src/glyphs-carbon.c Sun Nov 07 23:01:49 2010 +0000
+++ b/src/glyphs-carbon.c Sun Nov 07 23:30:01 2010 +0000
＠＠ -27,8 +27,6 ＠＠
#include "console-carbon-impl.h"
#include "fontcolor-carbon-impl.h"
-#include "../carbon/xpm/xpm.h"
-
extern unsigned long carbon_string_to_color (const Ibyte *);
static CGColorRef transparent_color;
＠＠ -323,6 +321,9 ＠＠
#ifdef HAVE_XPM
+#define Cursor X11Cursor
+#include <X11/xpm.h>
+
#define BPLINE(width) ((int)(~3UL & (unsigned long)((width) +3)))
struct color_symbol
diff -r 5a1589f26876 -r 2c4a037960ff src/glyphs.c
--- a/src/glyphs.c Sun Nov 07 23:01:49 2010 +0000
+++ b/src/glyphs.c Sun Nov 07 23:30:01 2010 +0000
＠＠ -66,14 +66,10 ＠＠
#include "sysfile.h"
-#if defined (HAVE_XPM) && !defined (HAVE_GTK) && !defined (HAVE_CARBON)
+#if defined (HAVE_XPM) && !defined (HAVE_GTK)
#include <X11/xpm.h>
#endif
-#if defined (HAVE_XPM) && defined (HAVE_CARBON)
-#include "../carbon/xpm/xpm.h"
-#endif
-
Lisp_Object Qimage_conversion_error;
Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
--
“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
- 1 participants
- 0 comments
carbon2-commit: Fix the Carbon2 build, use non-in-tree XPM and avoid reserved words.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5358:2c4a037960ff
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Nov 07 23:30:01 2010 +0000
files: src/ChangeLog.carbon2 src/event-carbon.c src/glyphs-carbon.c src/glyphs.c
description:
Fix the Carbon2 build, use non-in-tree XPM and avoid reserved words.
src/ChangeLog.carbon2 addition:
2010-11-07 Aidan Kehoe <kehoea(a)parhasard.net>
* glyphs.c: Dont #include the in-tree carbon library here, it
breaks the build.
* glyphs-carbon.c: Hackishly use the X11 include files here;
really the right answer is not to include the XPM library with the
Carbon build at all.
* event-carbon.c (debug_print_event): Don't confuse the C++
compiler by using a reserved word as a parameter name.
diff -r 5a1589f26876 -r 2c4a037960ff src/ChangeLog.carbon2
--- a/src/ChangeLog.carbon2 Sun Nov 07 23:01:49 2010 +0000
+++ b/src/ChangeLog.carbon2 Sun Nov 07 23:30:01 2010 +0000
＠＠ -1,3 +1,13 ＠＠
+2010-11-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * glyphs.c: Dont #include the in-tree carbon library here, it
+ breaks the build.
+ * glyphs-carbon.c: Hackishly use the X11 include files here;
+ really the right answer is not to include the XPM library with the
+ Carbon build at all.
+ * event-carbon.c (debug_print_event): Don't confuse the C++
+ compiler by using a reserved word as a parameter name.
+
2010-06-04 Aidan Kehoe <kehoea(a)parhasard.net>
* select-carbon.c (pasteboard_get_utext_or_text):
diff -r 5a1589f26876 -r 2c4a037960ff src/event-carbon.c
--- a/src/event-carbon.c Sun Nov 07 23:01:49 2010 +0000
+++ b/src/event-carbon.c Sun Nov 07 23:30:01 2010 +0000
＠＠ -488,9 +488,9 ＠＠
}
static void
-debug_print_event (EventClass class, UInt32 kind)
+debug_print_event (EventClass klasse, UInt32 kind)
{
- stderr_out ("Class = %c%c%c%c; ", (char)(class >> 24), (char)(class >> 16 & 0xff), (char)(class >> 8 & 0xff), (char)(class & 0xff));
+ stderr_out ("Class = %c%c%c%c; ", (char)(klasse >> 24), (char)(klasse >> 16 & 0xff), (char)(klasse >> 8 & 0xff), (char)(klasse & 0xff));
stderr_out ("kind = %lu", kind);
}
diff -r 5a1589f26876 -r 2c4a037960ff src/glyphs-carbon.c
--- a/src/glyphs-carbon.c Sun Nov 07 23:01:49 2010 +0000
+++ b/src/glyphs-carbon.c Sun Nov 07 23:30:01 2010 +0000
＠＠ -26,8 +26,6 ＠＠
#include "console-carbon-impl.h"
#include "fontcolor-carbon-impl.h"
-
-#include "../carbon/xpm/xpm.h"
extern unsigned long carbon_string_to_color (const Ibyte *);
＠＠ -322,6 +320,9 ＠＠
**********************************************************************/
#ifdef HAVE_XPM
+
+#define Cursor X11Cursor
+#include <X11/xpm.h>
#define BPLINE(width) ((int)(~3UL & (unsigned long)((width) +3)))
diff -r 5a1589f26876 -r 2c4a037960ff src/glyphs.c
--- a/src/glyphs.c Sun Nov 07 23:01:49 2010 +0000
+++ b/src/glyphs.c Sun Nov 07 23:30:01 2010 +0000
＠＠ -66,12 +66,8 ＠＠
#include "sysfile.h"
-#if defined (HAVE_XPM) && !defined (HAVE_GTK) && !defined (HAVE_CARBON)
+#if defined (HAVE_XPM) && !defined (HAVE_GTK)
#include <X11/xpm.h>
-#endif
-
-#if defined (HAVE_XPM) && defined (HAVE_CARBON)
-#include "../carbon/xpm/xpm.h"
#endif
Lisp_Object Qimage_conversion_error;
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Automated merge with file:///Sources/xemacs-21.5-checked-out
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5357:5a1589f26876
parent: 5356:9f738305f80f
parent: 5282:c8faf8c372c2
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Nov 07 23:01:49 2010 +0000
files: ChangeLog configure configure.ac lisp/ChangeLog lisp/device.el lisp/dumped-lisp.el lisp/faces.el lisp/mule/mule-cmds.el lisp/startup.el src/ChangeLog src/config.h.in src/emacs.c src/fns.c src/lisp.h src/symsinit.h tests/ChangeLog tests/automated/lisp-tests.el
description:
Automated merge with file:///Sources/xemacs-21.5-checked-out
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Accept sequences generally, not just lists, #'reverse, #'nreverse.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5356:9f738305f80f
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Nov 06 21:18:52 2010 +0000
files: man/ChangeLog man/lispref/lists.texi src/ChangeLog src/bytecode.c src/fns.c tests/ChangeLog tests/automated/lisp-tests.el
description:
Accept sequences generally, not just lists, #'reverse, #'nreverse.
src/ChangeLog addition:
2010-11-06 Aidan Kehoe <kehoea(a)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(a)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(a)parhasard.net>
* 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>
+
+ * 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>
* 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>
+
+ * 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>
* 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>
+
+ * 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>
* 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
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments