carbon2-commit: Correct the NEW_GC non-DEBUG_XEMACS version of PARSE_KEYWORDS().
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5334:d9e65b48e2bf
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Sep 18 16:46:56 2010 +0100
files: src/ChangeLog src/lisp.h
description:
Correct the NEW_GC non-DEBUG_XEMACS version of PARSE_KEYWORDS().
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (PARSE_KEYWORDS):
Correct the NEW_GC non-DEBUG_XEMACS version of this macro; under
such builds S##function is a pointer, not a Lisp_Subr structure.
diff -r d804e621add0 -r d9e65b48e2bf src/ChangeLog
--- a/src/ChangeLog Sat Sep 18 15:57:20 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 16:46:56 2010 +0100
＠＠ -1,3 +1,9 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp.h (PARSE_KEYWORDS):
+ Correct the NEW_GC non-DEBUG_XEMACS version of this macro; under
+ such builds S##function is a pointer, not a Lisp_Subr structure.
+
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
Simplify the API of PARSE_KEYWORDS for callers.
diff -r d804e621add0 -r d9e65b48e2bf src/lisp.h
--- a/src/lisp.h Sat Sep 18 15:57:20 2010 +0100
+++ b/src/lisp.h Sat Sep 18 16:46:56 2010 +0100
＠＠ -3554,6 +3554,12 ＠＠
(intern_massaging_name (1 + #function))), \
0); \
assert (0 == strcmp (__func__, #function))
+#elsif defined (NEW_GC)
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern (S##function->name), nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, S##function->min_args, 0)
#else
#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
keyword_defaults) \
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Simplify the API of PARSE_KEYWORDS for callers.
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5333:d804e621add0
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Sep 18 15:57:20 2010 +0100
files: src/ChangeLog src/buffer.c src/elhash.c src/fns.c src/lisp.h src/symbols.c
description:
Simplify the API of PARSE_KEYWORDS for callers.
src/ChangeLog addition:
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
Simplify the API of PARSE_KEYWORDS for callers.
* lisp.h (PARSE_KEYWORDS): Simply the API, while making the
implementation a little more complex; work out KEYWORDS_OFFSET
from the appropriate Lisp_Subr struct, take the function name as
the C name of the DEFUN rather than a symbol visible as a
Lisp_Object, on debug builds assert that we're actually in the
function so we choke on badly-done copy-and-pasting,
* lisp.h (PARSE_KEYWORDS_8): New. This is the old PARSE_KEYWORDS.
* fns.c (Fmerge, FsortX, Ffill, Freduce, Freplace):
Change to use the new PARSE_KEYWORDS syntax.
* elhash.c (Fmake_hash_table): Chance to the new PARSE_KEYWORDS
syntax, rename a define to correspond to what other files use.
* symbols.c (intern_massaging_name):
* buffer.c (ADD_INT):
Rename intern_converting_underscores_to_dashes() to
intern_massaging_name(), now it does a little more.
diff -r dd2976af8783 -r d804e621add0 src/ChangeLog
--- a/src/ChangeLog Sat Sep 18 15:03:54 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 15:57:20 2010 +0100
＠＠ -1,3 +1,26 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Simplify the API of PARSE_KEYWORDS for callers.
+
+ * lisp.h (PARSE_KEYWORDS): Simply the API, while making the
+ implementation a little more complex; work out KEYWORDS_OFFSET
+ from the appropriate Lisp_Subr struct, take the function name as
+ the C name of the DEFUN rather than a symbol visible as a
+ Lisp_Object, on debug builds assert that we're actually in the
+ function so we choke on badly-done copy-and-pasting,
+
+ * lisp.h (PARSE_KEYWORDS_8): New. This is the old PARSE_KEYWORDS.
+
+ * fns.c (Fmerge, FsortX, Ffill, Freduce, Freplace):
+ Change to use the new PARSE_KEYWORDS syntax.
+ * elhash.c (Fmake_hash_table): Chance to the new PARSE_KEYWORDS
+ syntax, rename a define to correspond to what other files use.
+
+ * symbols.c (intern_massaging_name):
+ * buffer.c (ADD_INT):
+ Rename intern_converting_underscores_to_dashes() to
+ intern_massaging_name(), now it does a little more.
+
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* termcap.c:
diff -r dd2976af8783 -r d804e621add0 src/buffer.c
--- a/src/buffer.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/buffer.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -1819,10 +1819,10 ＠＠
#define ADD_INT(field) \
plist = cons3 (make_int (b->text->field), \
- intern_converting_underscores_to_dashes (#field), plist)
+ intern_massaging_name (#field), plist)
#define ADD_BOOL(field) \
plist = cons3 (b->text->field ? Qt : Qnil, \
- intern_converting_underscores_to_dashes (#field), plist)
+ intern_massaging_name (#field), plist)
ADD_INT (bufz);
ADD_INT (z);
#ifdef OLD_BYTE_CHAR
diff -r dd2976af8783 -r d804e621add0 src/elhash.c
--- a/src/elhash.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/elhash.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -962,7 +962,7 ＠＠
else if (EQ (key, Qrehash_threshold)) rehash_threshold = value;
else if (EQ (key, Qweakness)) weakness = value;
else if (EQ (key, Qdata)) data = value;
-#ifndef NO_NEED_TO_HANDLE_21_4_CODE
+#ifdef NEED_TO_HANDLE_21_4_CODE
else if (EQ (key, Qtype))/*obsolete*/ weakness = value;
#endif
else if (KEYWORDP (key))
＠＠ -1109,14 +1109,14 ＠＠
*/
(int nargs, Lisp_Object *args))
{
-#ifdef NO_NEED_TO_HANDLE_21_4_CODE
- PARSE_KEYWORDS (Qmake_hash_table, nargs, args, 0, 5,
+#ifndef NEED_TO_HANDLE_21_4_CODE
+ PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 5,
(test, size, rehash_size, rehash_threshold, weakness),
- NULL, 0);
+ NULL);
#else
- PARSE_KEYWORDS (Qmake_hash_table, nargs, args, 0, 6,
+ PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 6,
(test, size, rehash_size, rehash_threshold, weakness,
- type), (type = Qunbound, weakness = Qunbound), 0);
+ type), (type = Qunbound, weakness = Qunbound));
if (EQ (weakness, Qunbound))
{
diff -r dd2976af8783 -r d804e621add0 src/fns.c
--- a/src/fns.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/fns.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -2575,7 +2575,7 ＠＠
Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
- PARSE_KEYWORDS (Qmerge, nargs, args, 4, 1, (key), NULL, 0);
+ PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
CHECK_SEQUENCE (sequence_one);
CHECK_SEQUENCE (sequence_two);
＠＠ -2827,7 +2827,7 ＠＠
Lisp_Object);
Elemcount sequence_len, i;
- PARSE_KEYWORDS (QsortX, nargs, args, 2, 1, (key), NULL, 0);
+ PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
CHECK_SEQUENCE (sequence);
＠＠ -4002,7 +4002,7 ＠＠
Lisp_Object item = args[1];
Elemcount starting = 0, ending = EMACS_INT_MAX, ii, len;
- PARSE_KEYWORDS (Qfill, nargs, args, 2, 2, (start, end), (start = Qzero), 0);
+ PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
CHECK_NATNUM (start);
starting = XINT (start);
＠＠ -5005,9 +5005,9 ＠＠
Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
Elemcount starting, ending = EMACS_INT_MAX, ii = 0;
- PARSE_KEYWORDS (Qreduce, nargs, args, 2, 5,
+ PARSE_KEYWORDS (Freduce, nargs, args, 5,
(start, end, from_end, initial_value, key),
- (start = Qzero, initial_value = Qunbound), 0);
+ (start = Qzero, initial_value = Qunbound));
CHECK_SEQUENCE (sequence);
CHECK_NATNUM (start);
＠＠ -5541,8 +5541,8 ＠＠
Boolint sequence1_listp, sequence2_listp,
overwriting = EQ (sequence1, sequence2);
- PARSE_KEYWORDS (Qreplace, nargs, args, 2, 4, (start1, end1, start2, end2),
- (start1 = start2 = Qzero), 0);
+ PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2),
+ (start1 = start2 = Qzero));
CHECK_SEQUENCE (sequence1);
CHECK_LISP_WRITEABLE (sequence1);
diff -r dd2976af8783 -r d804e621add0 src/lisp.h
--- a/src/lisp.h Sat Sep 18 15:03:54 2010 +0100
+++ b/src/lisp.h Sat Sep 18 15:57:20 2010 +0100
＠＠ -3494,16 +3494,20 ＠＠
/************************************************************************/
/* The C subr must have been declared with MANY as its max args, and this
- PARSE_KEYWORDS call must come before any statements.
-
- FUNCTION is the name of the current function, as a symbol.
+ PARSE_KEYWORDS call must come before any statements. Equivalently, it
+ can appear within braces.
+
+ FUNCTION is the C name of the current DEFUN. If there is no current
+ DEFUN, use the PARSE_KEYWORDS_8 macro, not PARSE_KEYWORDS. If the
+ current DEFUN has optional arguments that are not keywords, you also need
+ to use the PARSE_KEYWORDS_8 macro. This is also the case if there are
+ optional arguments that come before the keywords, as Common Lisp
+ specifies for #'parse-integer.
NARGS is the count of arguments supplied to FUNCTION.
ARGS is a pointer to the argument vector (not a Lisp vector) supplied to
FUNCTION.
-
- KEYWORDS_OFFSET is the offset into ARGS where the keyword arguments start.
KEYWORD_COUNT is the number of keywords FUNCTION is normally prepared to
handle.
＠＠ -3515,11 +3519,6 ＠＠
initial_value) in this parameter, a collection of C statements surrounded
by parentheses and separated by the comma operator. If you don't need
this, supply NULL as KEYWORD_DEFAULTS.
-
- ALLOW_OTHER_KEYS corresponds to the &allow-other-keys argument list
- entry in defun*; it is 1 if other keys are normally allowed, 0
- otherwise. This may be overridden in the caller by specifying
-:allow-other-keys t in the argument list.
For keywords which appear multiple times in the called argument list, the
leftmost one overrides, as specified in section 7.1.1 of the CLHS.
＠＠ -3534,26 +3533,70 ＠＠
and an unrelated name for the local variable, as is possible with the
((:keyword unrelated-var)) syntax in defun* and in Common Lisp. That
shouldn't matter in practice. */
-
-#define PARSE_KEYWORDS(function, nargs, args, keywords_offset, \
- keyword_count, keywords, keyword_defaults, \
- allow_other_keys) \
+#if defined (DEBUG_XEMACS) && defined (__STDC_VERSION__) && \
+ __STDC_VERSION__ >= 199901L
+
+/* This version has the advantage that DEFUN without DEFSUBR still provokes
+ a defined but not used warning, and it provokes an assertion failure at
+ runtime if someone has copied and pasted the PARSE_KEYWORDS macro from
+ another function without changing FUNCTION; that would lead to an
+ incorrect determination of KEYWORDS_OFFSET. */
+
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern_massaging_name (1 + #function), \
+ nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, \
+ /* Can't XSUBR (Fsymbol_function (...))->min_args, \
+ the function may be advised. */ \
+ XINT (Ffunction_min_args \
+ (intern_massaging_name (1 + #function))), \
+ 0); \
+ assert (0 == strcmp (__func__, #function))
+#else
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern (S##function.name), nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, S##function.min_args, 0)
+#endif
+
+/* PARSE_KEYWORDS_8 is a more fine-grained version of PARSE_KEYWORDS. The
+ differences are as follows:
+
+ FUNC_SYM is a symbol reflecting the name of the function for which
+ keywords are being parsed. In PARSE_KEYWORDS, it is the Lisp-visible
+ name of C_FUNC, interned as a symbol in obarray.
+
+ KEYWORDS_OFFSET is the offset into ARGS where the keyword arguments
+ start. In PARSE_KEYWORDS, this is the index of the first optional
+ argument, determined from the information known about C_FUNC.
+
+ ALLOW_OTHER_KEYS corresponds to the &allow-other-keys argument list entry
+ in defun*; it is 1 if other keys are normally allowed, 0 otherwise. This
+ may be overridden in the caller by specifying :allow-other-keys t in the
+ argument list. In PARSE_KEYWORDS, ALLOW_OTHER_KEYS is always 0. */
+
+#define PARSE_KEYWORDS_8(func_sym, nargs, args, \
+ keyword_count, keywords, keyword_defaults, \
+ keywords_offset, allow_other_keys) \
DECLARE_N_KEYWORDS_##keyword_count keywords; \
\
do \
{ \
Lisp_Object pk_key, pk_value; \
- Elemcount pk_i = nargs - 1; \
+ Elemcount pk_i = nargs - 1, pk_offset = keywords_offset; \
Boolint pk_allow_other_keys = allow_other_keys; \
\
- if ((nargs - keywords_offset) & 1) \
+ if ((nargs - pk_offset) & 1) \
{ \
if (!allow_other_keys \
&& !(pk_allow_other_keys \
- = non_nil_allow_other_keys_p (keywords_offset, \
+ = non_nil_allow_other_keys_p (pk_offset, \
nargs, args))) \
{ \
- signal_wrong_number_of_arguments_error (function, nargs); \
+ signal_wrong_number_of_arguments_error (func_sym, nargs); \
} \
else \
{ \
＠＠ -3566,7 +3609,7 ＠＠
(void)(keyword_defaults); \
\
/* Start from the end, because the leftmost element overrides. */ \
- while (pk_i > keywords_offset) \
+ while (pk_i > pk_offset) \
{ \
pk_value = args[pk_i--]; \
pk_key = args[pk_i--]; \
＠＠ -3578,7 +3621,7 ＠＠
continue; \
} \
else if ((pk_allow_other_keys \
- = non_nil_allow_other_keys_p (keywords_offset, \
+ = non_nil_allow_other_keys_p (pk_offset, \
nargs, args))) \
{ \
continue; \
＠＠ -3590,7 +3633,7 ＠＠
} \
else \
{ \
- invalid_keyword_argument (function, pk_key); \
+ invalid_keyword_argument (func_sym, pk_key); \
} \
} \
} while (0)
＠＠ -5649,7 +5692,7 ＠＠
unsigned int hash_string (const Ibyte *, Bytecount);
Lisp_Object intern_istring (const Ibyte *str);
MODULE_API Lisp_Object intern (const CIbyte *str);
-Lisp_Object intern_converting_underscores_to_dashes (const CIbyte *str);
+Lisp_Object intern_massaging_name (const CIbyte *str);
Lisp_Object oblookup (Lisp_Object, const Ibyte *, Bytecount);
void map_obarray (Lisp_Object, int (*) (Lisp_Object, void *), void *);
Lisp_Object indirect_function (Lisp_Object, int);
diff -r dd2976af8783 -r d804e621add0 src/symbols.c
--- a/src/symbols.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/symbols.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -198,15 +198,23 ＠＠
}
Lisp_Object
-intern_converting_underscores_to_dashes (const CIbyte *str)
+intern_massaging_name (const CIbyte *str)
{
Bytecount len = strlen (str);
CIbyte *tmp = alloca_extbytes (len + 1);
Bytecount i;
strcpy (tmp, str);
for (i = 0; i < len; i++)
- if (tmp[i] == '_')
- tmp[i] = '-';
+ {
+ if (tmp[i] == '_')
+ {
+ tmp[i] = '-';
+ }
+ else if (tmp[i] == 'X')
+ {
+ tmp[i] = '*';
+ }
+ }
return intern_istring ((Ibyte *) tmp);
}
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Add some missing #includes, termcap.c, hopefully fixing Adam Sjoegren's build.
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5332:dd2976af8783
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Sep 18 15:03:54 2010 +0100
files: src/ChangeLog src/termcap.c
description:
Add some missing #includes, termcap.c, hopefully fixing Adam Sjoegren's build.
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* termcap.c:
Add a couple of missing includes here, which should fix builds
that use this file. (I have no access to such builds, but Mats'
buildbot shows output that indicates they fail at link time since
DEVICE_BAUD_RATE and IS_DIRECTORY_SEP are available.)
diff -r 5a9aa6c40c9b -r dd2976af8783 src/ChangeLog
--- a/src/ChangeLog Sat Sep 18 14:54:45 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 15:03:54 2010 +0100
＠＠ -1,3 +1,11 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * termcap.c:
+ Add a couple of missing includes here, which should fix builds
+ that use this file. (I have no access to such builds, but Mats'
+ buildbot shows output that indicates they fail at link time since
+ DEVICE_BAUD_RATE and IS_DIRECTORY_SEP are available.)
+
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Freduce):
diff -r 5a9aa6c40c9b -r dd2976af8783 src/termcap.c
--- a/src/termcap.c Sat Sep 18 14:54:45 2010 +0100
+++ b/src/termcap.c Sat Sep 18 15:03:54 2010 +0100
＠＠ -25,7 +25,10 ＠＠
#ifdef emacs
#include <config.h>
#include "lisp.h" /* For encapsulated open, close, read */
-#include "device.h" /* For DEVICE_BAUD_RATE */
+#include "device.h"
+#include "device-impl.h" /* For DEVICE_BAUD_RATE */
+#include "sysfile.h"
+#include "process.h"
#else /* not emacs */
#include <stdlib.h>
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Avoid statement-before-declaration problems with strict C89 builds, fns.c
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5331:5a9aa6c40c9b
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Sep 18 14:54:45 2010 +0100
files: src/ChangeLog src/fns.c
description:
Avoid statement-before-declaration problems with strict C89 builds, fns.c
src/ChangeLog addition:
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Freduce):
Move statements outside of the braces surrounding the
EXTERNAL_LIST_LOOP_3 macro, fixing strict C89 builds. Thank you
for the report, Vin!
diff -r ecdd1daab447 -r 5a9aa6c40c9b src/ChangeLog
--- a/src/ChangeLog Thu Sep 16 21:00:17 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 14:54:45 2010 +0100
＠＠ -1,3 +1,10 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Freduce):
+ Move statements outside of the braces surrounding the
+ EXTERNAL_LIST_LOOP_3 macro, fixing strict C89 builds. Thank you
+ for the report, Vin!
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Flist_length): New, moved here from cl-extra.el, needed
diff -r ecdd1daab447 -r 5a9aa6c40c9b src/fns.c
--- a/src/fns.c Thu Sep 16 21:00:17 2010 +0100
+++ b/src/fns.c Sat Sep 18 14:54:45 2010 +0100
＠＠ -5248,7 +5248,6 ＠＠
}
else if (ending - starting)
{
- ii = 0;
EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
{
/* KEY may amputate the list behind us; make sure what
＠＠ -5264,10 +5263,10 ＠＠
}
}
+ ii = 0;
+
if (ending - starting)
{
- ii = 0;
-
EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
{
/* KEY or FUNCTION may amputate the list behind us; make
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Add an omitted comma, Check-Message, test-harness.el.
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5330:ecdd1daab447
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 21:00:17 2010 +0100
files: lisp/ChangeLog lisp/test-harness.el
description:
Add an omitted comma, Check-Message, test-harness.el.
lisp/ChangeLog addition:
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
diff -r 799742b751c8 -r ecdd1daab447 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Sep 16 20:34:49 2010 +0100
+++ b/lisp/ChangeLog Thu Sep 16 21:00:17 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * test-harness.el (Check-Message):
+ Add an omitted comma here, thank you the buildbot.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
diff -r 799742b751c8 -r ecdd1daab447 lisp/test-harness.el
--- a/lisp/test-harness.el Thu Sep 16 20:34:49 2010 +0100
+++ b/lisp/test-harness.el Thu Sep 16 21:00:17 2010 +0100
＠＠ -502,7 +502,7 ＠＠
`(quote ,(car body))
`(quote (progn ,＠body)))))
`(Skip-Test-Unless (fboundp 'defadvice) "can't defadvice"
- expected-message-regexp
+ ,expected-message-regexp
(let ((messages ""))
(defadvice message (around collect activate)
(defvar messages)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5329:799742b751c8
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 20:34:49 2010 +0100
files: lisp/cl-extra.el src/ChangeLog src/fns.c
description:
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
src/ChangeLog addition:
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Flist_length): New, moved here from cl-extra.el, needed
by the next function.
(shortest_length_among_sequences): New.
(Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
(Fmap_into, Fsome, Fevery):
Use shortest_length_among_sequences() when working out how many
iterations to do, only giving circular list errors if all
arguments are circular.
diff -r 66dbef5f8076 -r 799742b751c8 lisp/cl-extra.el
--- a/lisp/cl-extra.el Thu Sep 16 18:46:05 2010 +0100
+++ b/lisp/cl-extra.el Thu Sep 16 20:34:49 2010 +0100
＠＠ -405,13 +405,6 ＠＠
"Equivalent to (nconc (nreverse X) Y)."
(nconc (nreverse x) y))
-(defun list-length (list)
- "Return the length of LIST. Return nil if LIST is circular."
- (if (listp list)
- (condition-case nil (length list) (circular-list))
- ;; Error on not-a-list:
- (car list)))
-
(defun tailp (sublist list)
"Return true if SUBLIST is a tail of LIST."
(while (and (consp list) (not (eq sublist list)))
diff -r 66dbef5f8076 -r 799742b751c8 src/ChangeLog
--- a/src/ChangeLog Thu Sep 16 18:46:05 2010 +0100
+++ b/src/ChangeLog Thu Sep 16 20:34:49 2010 +0100
＠＠ -1,3 +1,14 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Flist_length): New, moved here from cl-extra.el, needed
+ by the next function.
+ (shortest_length_among_sequences): New.
+ (Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
+ (Fmap_into, Fsome, Fevery):
+ Use shortest_length_among_sequences() when working out how many
+ iterations to do, only giving circular list errors if all
+ arguments are circular.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsubseq):
diff -r 66dbef5f8076 -r 799742b751c8 src/fns.c
--- a/src/fns.c Thu Sep 16 18:46:05 2010 +0100
+++ b/src/fns.c Thu Sep 16 20:34:49 2010 +0100
＠＠ -337,6 +337,29 ＠＠
}
return make_int (len);
+}
+
+/* This is almost the above, but is defined by Common Lisp. We need it in C
+ 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.
+*/
+ (list))
+{
+ Lisp_Object hare, tortoise;
+ Elemcount len;
+
+ for (hare = tortoise = list, len = 0;
+ CONSP (hare) && (! EQ (hare, tortoise) || len == 0);
+ hare = XCDR (hare), len++)
+ {
+ if (len & 1)
+ tortoise = XCDR (tortoise);
+ }
+
+ return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len);
}
/*** string functions. ***/
＠＠ -4458,6 +4481,42 ＠＠
UNGCPRO;
}
+/* Given NSEQUENCES objects at the address pointed to by SEQUENCES, return
+ the length of the shortest sequence. Error if all are circular, or if any
+ one of them is not a sequence. */
+static Elemcount
+shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
+{
+ Elemcount len = EMACS_INT_MAX;
+ Lisp_Object length;
+ int i;
+
+ for (i = 0; i < nsequences; ++i)
+ {
+ if (CONSP (sequences[i]))
+ {
+ length = Flist_length (sequences[i]);
+ if (!NILP (length))
+ {
+ len = min (len, XINT (length));
+ }
+ }
+ else
+ {
+ CHECK_SEQUENCE (sequences[i]);
+ length = Flength (sequences[i]);
+ len = min (len, XINT (length));
+ }
+ }
+
+ if (NILP (length))
+ {
+ signal_circular_list_error (sequences[0]);
+ }
+
+ return len;
+}
+
DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /*
Call FUNCTION on each element of SEQUENCE, and concat results to a string.
Between each pair of results, insert SEPARATOR.
＠＠ -4485,11 +4544,7 ＠＠
args[2] = sequence;
args[1] = separator;
- for (i = 2; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ len = shortest_length_among_sequences (nargs - 2, args + 2);
if (len == 0) return build_ascstring ("");
＠＠ -4536,15 +4591,8 ＠＠
(int nargs, Lisp_Object *args))
{
Lisp_Object function = args[0];
- Elemcount len = EMACS_INT_MAX;
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
Lisp_Object *args0;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
args0 = alloca_array (Lisp_Object, len);
mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX);
＠＠ -4567,18 +4615,10 ＠＠
(int nargs, Lisp_Object *args))
{
Lisp_Object function = args[0];
- Elemcount len = EMACS_INT_MAX;
- Lisp_Object result;
- struct gcpro gcpro1;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
-
- result = make_vector (len, Qnil);
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
+ Lisp_Object result = make_vector (len, Qnil);
+
+ struct gcpro gcpro1;
GCPRO1 (result);
/* Don't pass result as the lisp_object argument, we want mapcarX to protect
a single list argument's elements from being garbage-collected. */
＠＠ -4602,21 +4642,13 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Lisp_Object function = args[0], *result;
- Elemcount result_len = EMACS_INT_MAX;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- result_len = min (result_len, XINT (Flength (args[i])));
- }
-
- result = alloca_array (Lisp_Object, result_len);
- mapcarX (result_len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
+ Lisp_Object function = args[0], *result = alloca_array (Lisp_Object, len);
+
+ mapcarX (len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
/* #'nconc GCPROs its args in case of signals and error. */
- return Fnconc (result_len, result);
+ return Fnconc (len, result);
}
DEFUN ("mapc", Fmapc, 2, MANY, 0, /*
＠＠ -4637,17 +4669,9 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Elemcount len = EMACS_INT_MAX;
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
Lisp_Object sequence = args[1];
struct gcpro gcpro1;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
-
/* We need to GCPRO sequence, because mapcarX will modify the
elements of the args array handed to it, and this may involve
elements of sequence getting garbage collected. */
＠＠ -4677,15 +4701,8 ＠＠
Lisp_Object function = args[1];
Lisp_Object result = Qnil;
Lisp_Object *args0 = NULL;
- Elemcount len = EMACS_INT_MAX;
- int i;
- struct gcpro gcpro1;
-
- for (i = 2; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ Elemcount len = shortest_length_among_sequences (nargs - 2, args + 2);
+ struct gcpro gcpro1;
if (!NILP (type))
{
＠＠ -4742,19 +4759,14 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Elemcount len = EMACS_INT_MAX;
+ Elemcount len;
Lisp_Object result_sequence = args[0];
Lisp_Object function = args[1];
- int i;
args[0] = function;
args[1] = result_sequence;
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ len = shortest_length_among_sequences (nargs - 1, args + 1);
mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
Qmap_into);
＠＠ -4776,14 +4788,7 ＠＠
{
Lisp_Object result = Qnil,
result_ptr = STORE_VOID_IN_LISP ((void *) &result);
- Elemcount len = EMACS_INT_MAX;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome);
＠＠ -4803,14 +4808,7 ＠＠
(int nargs, Lisp_Object *args))
{
Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result);
- Elemcount len = EMACS_INT_MAX;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery);
＠＠ -6683,6 +6681,7 ＠＠
DEFSUBR (Frandom);
DEFSUBR (Flength);
DEFSUBR (Fsafe_length);
+ DEFSUBR (Flist_length);
DEFSUBR (Fstring_equal);
DEFSUBR (Fcompare_strings);
DEFSUBR (Fstring_lessp);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5328:66dbef5f8076
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 18:46:05 2010 +0100
files: src/ChangeLog src/fns.c
description:
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsubseq):
Change the string code to better fit in with the rest of this
function (it still uses get_string_range_char(), though, which *may*
diverge algorithmically from what we're doing).
If dealing with a cons, only call #'length if we have reason to
believe that the START and END arguments are badly specified, and
check for circular lists ourselves when that's appropriate.
If dealing with a vector, call Fvector() on the appropriate subset
of the old vector's data directly, don't initialise the result
with nil and then copy.
(Ffill):
Only check the range arguments for a cons SEQUENCE if we have good
reason to think they were badly specified.
(Freduce):
Handle multiple values properly. Add bounds checking to this
function, as specificied by ANSI Common Lisp.
diff -r 2def0d83a5e3 -r 66dbef5f8076 src/ChangeLog
--- a/src/ChangeLog Thu Sep 16 16:46:27 2010 +0100
+++ b/src/ChangeLog Thu Sep 16 18:46:05 2010 +0100
＠＠ -1,3 +1,26 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Fsubseq):
+ Change the string code to better fit in with the rest of this
+ function (it still uses get_string_range_char(), though, which *may*
+ diverge algorithmically from what we're doing).
+
+ If dealing with a cons, only call #'length if we have reason to
+ believe that the START and END arguments are badly specified, and
+ check for circular lists ourselves when that's appropriate.
+
+ If dealing with a vector, call Fvector() on the appropriate subset
+ of the old vector's data directly, don't initialise the result
+ with nil and then copy.
+
+ (Ffill):
+ Only check the range arguments for a cons SEQUENCE if we have good
+ reason to think they were badly specified.
+
+ (Freduce):
+ Handle multiple values properly. Add bounds checking to this
+ function, as specificied by ANSI Common Lisp.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* eval.c (Ffunction, Fquote):
diff -r 2def0d83a5e3 -r 66dbef5f8076 src/fns.c
--- a/src/fns.c Thu Sep 16 16:46:27 2010 +0100
+++ b/src/fns.c Thu Sep 16 18:46:05 2010 +0100
＠＠ -1011,7 +1011,9 ＠＠
DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
Return the subsequence of SEQUENCE starting at START and ending before END.
END may be omitted; then the subsequence runs to the end of SEQUENCE.
-If START or END is negative, it counts from the end.
+
+If START or END is negative, it counts from the end, in contravention of
+Common Lisp.
The returned subsequence is always of the same type as SEQUENCE.
If SEQUENCE is a string, relevant parts of the string-extent-data
are copied to the new string.
＠＠ -1021,95 +1023,139 ＠＠
*/
(sequence, start, end))
{
- EMACS_INT len, s, e;
+ Elemcount len, ss, ee = EMACS_INT_MAX, ii;
+ Lisp_Object result = Qnil;
+
+ CHECK_SEQUENCE (sequence);
+ CHECK_INT (start);
+ ss = XINT (start);
+
+ if (!NILP (end))
+ {
+ CHECK_INT (end);
+ ee = XINT (end);
+ }
if (STRINGP (sequence))
{
- Charcount ccstart, ccend;
Bytecount bstart, blen;
- Lisp_Object val;
-
- CHECK_INT (start);
- get_string_range_char (sequence, start, end, &ccstart, &ccend,
+
+ get_string_range_char (sequence, start, end, &ss, &ee,
GB_HISTORICAL_STRING_BEHAVIOR);
- bstart = string_index_char_to_byte (sequence, ccstart);
- blen = string_offset_char_to_byte_len (sequence, bstart, ccend - ccstart);
- val = make_string (XSTRING_DATA (sequence) + bstart, blen);
+ bstart = string_index_char_to_byte (sequence, ss);
+ blen = string_offset_char_to_byte_len (sequence, bstart, ee - ss);
+
+ result = make_string (XSTRING_DATA (sequence) + bstart, blen);
/* Copy any applicable extent information into the new string. */
- copy_string_extents (val, sequence, 0, bstart, blen);
- return val;
- }
-
- CHECK_SEQUENCE (sequence);
-
- len = XINT (Flength (sequence));
-
- CHECK_INT (start);
- s = XINT (start);
- if (s < 0)
- s = len + s;
-
- if (NILP (end))
- e = len;
- else
- {
- CHECK_INT (end);
- e = XINT (end);
- if (e < 0)
- e = len + e;
- }
-
- check_sequence_range (sequence, make_int (s), make_int (e),
- make_int (len));
-
- if (VECTORP (sequence))
- {
- Lisp_Object result = make_vector (e - s, Qnil);
- EMACS_INT i;
- Lisp_Object *in_elts = XVECTOR_DATA (sequence);
- Lisp_Object *out_elts = XVECTOR_DATA (result);
-
- for (i = s; i < e; i++)
- out_elts[i - s] = in_elts[i];
- return result;
- }
- else if (LISTP (sequence))
- {
- Lisp_Object result = Qnil, result_tail;
- EMACS_INT i;
-
- sequence = Fnthcdr (make_int (s), sequence);
-
- if (s < e)
- {
+ copy_string_extents (result, sequence, 0, bstart, blen);
+ }
+ else if (CONSP (sequence))
+ {
+ Lisp_Object result_tail, saved = sequence;
+
+ if (ss < 0 || ee < 0)
+ {
+ len = XINT (Flength (sequence));
+ if (ss < 0)
+ {
+ ss = len + ss;
+ start = make_integer (ss);
+ }
+
+ if (ee < 0)
+ {
+ ee = len + ee;
+ end = make_integer (ee);
+ }
+ else
+ {
+ ee = min (ee, len);
+ }
+ }
+
+ if (0 != ss)
+ {
+ sequence = Fnthcdr (make_int (ss), sequence);
+ }
+
+ if (ss < ee && !NILP (sequence))
+ {
result = result_tail = Fcons (Fcar (sequence), Qnil);
sequence = Fcdr (sequence);
- for (i = s + 1; i < e; i++)
- {
- XSETCDR (result_tail, Fcons (Fcar (sequence), Qnil));
- sequence = Fcdr (sequence);
- result_tail = XCDR (result_tail);
- }
- }
-
- return result;
- }
- else if (BIT_VECTORP (sequence))
- {
- Lisp_Object result = make_bit_vector (e - s, Qzero);
- EMACS_INT i;
-
- for (i = s; i < e; i++)
- set_bit_vector_bit (XBIT_VECTOR (result), i - s,
- bit_vector_bit (XBIT_VECTOR (sequence), i));
- return result;
- }
- else
- {
- ABORT (); /* unreachable, since CHECK_SEQUENCE (sequence) did not
- error */
- return Qnil;
- }
+ ii = ss + 1;
+
+ {
+ EXTERNAL_LIST_LOOP_2 (elt, sequence)
+ {
+ if (!(ii < ee))
+ {
+ break;
+ }
+
+ XSETCDR (result_tail, Fcons (elt, Qnil));
+ result_tail = XCDR (result_tail);
+ ii++;
+ }
+ }
+ }
+
+ if (NILP (result) || (ii < ee && !NILP (end)))
+ {
+ /* We were handed a cons, which definitely has elements. nil
+ result means either ss >= ee or SEQUENCE was nil after the
+ nthcdr; in both cases that means START and END were incorrectly
+ specified for this sequence. ii < ee with a non-nil end means
+ the user handed us a bogus end value. */
+ check_sequence_range (saved, start, end, Flength (saved));
+ }
+ }
+ else
+ {
+ len = XINT (Flength (sequence));
+ if (ss < 0)
+ {
+ ss = len + ss;
+ start = make_integer (ss);
+ }
+
+ if (ee < 0)
+ {
+ ee = len + ee;
+ end = make_integer (ee);
+ }
+ else
+ {
+ ee = min (len, ee);
+ }
+
+ check_sequence_range (sequence, start, end, make_int (len));
+
+ if (VECTORP (sequence))
+ {
+ result = Fvector (ee - ss, XVECTOR_DATA (sequence) + ss);
+ }
+ else if (BIT_VECTORP (sequence))
+ {
+ result = make_bit_vector (ee - ss, Qzero);
+
+ for (ii = ss; ii < ee; ii++)
+ {
+ set_bit_vector_bit (XBIT_VECTOR (result), ii - ss,
+ bit_vector_bit (XBIT_VECTOR (sequence), ii));
+ }
+ }
+ else if (NILP (sequence))
+ {
+ DO_NOTHING;
+ }
+ else
+ {
+ /* Won't happen, since CHECK_SEQUENCE didn't error. */
+ ABORT ();
+ }
+ }
+
+ return result;
}
DEFUN ("substring-no-properties", Fsubstring_no_properties, 1, 3, 0, /*
＠＠ -4005,9 +4051,9 ＠＠
++counting;
}
- if (counting != ending)
- {
- check_sequence_range (sequence, start, end, Flength (sequence));
+ if (counting < starting || (counting != ending && !NILP (end)))
+ {
+ check_sequence_range (args[0], start, end, Flength (args[0]));
}
}
else
＠＠ -4970,7 +5016,10 ＠＠
CHECK_KEY_ARGUMENT (key);
-#define KEY(key, item) (EQ (key, Qidentity) ? item : call1 (key, item))
+#define KEY(key, item) (EQ (Qidentity, key) ? item : \
+ IGNORE_MULTIPLE_VALUES (call1 (key, item)))
+#define CALL2(function, accum, item) \
+ IGNORE_MULTIPLE_VALUES (call2 (function, accum, item))
starting = XINT (start);
if (!NILP (end))
＠＠ -4979,16 +5028,24 ＠＠
ending = XINT (end);
}
+ if (!(starting <= ending))
+ {
+ check_sequence_range (sequence, start, end, Flength (sequence));
+ }
+
if (VECTORP (sequence))
{
Lisp_Vector *vv = XVECTOR (sequence);
+
+ check_sequence_range (sequence, start, end, make_int (vv->size));
+
ending = min (ending, vv->size);
if (!UNBOUNDP (initial_value))
{
accum = initial_value;
}
- else if (ending - starting && starting < ending)
+ else if (ending - starting)
{
if (NILP (from_end))
{
＠＠ -5006,14 +5063,14 ＠＠
{
for (ii = starting; ii < ending; ++ii)
{
- accum = call2 (function, accum, KEY (key, vv->contents[ii]));
+ accum = CALL2 (function, accum, KEY (key, vv->contents[ii]));
}
}
else
{
for (ii = ending - 1; ii >= starting; --ii)
{
- accum = call2 (function, KEY (key, vv->contents[ii]), accum);
+ accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
}
}
}
＠＠ -5021,13 +5078,15 ＠＠
{
Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+ check_sequence_range (sequence, start, end, make_int (bv->size));
+
ending = min (ending, bv->size);
if (!UNBOUNDP (initial_value))
{
accum = initial_value;
}
- else if (ending - starting && starting < ending)
+ else if (ending - starting)
{
if (NILP (from_end))
{
＠＠ -5045,7 +5104,7 ＠＠
{
for (ii = starting; ii < ending; ++ii)
{
- accum = call2 (function, accum,
+ accum = CALL2 (function, accum,
KEY (key, make_int (bit_vector_bit (bv, ii))));
}
}
＠＠ -5053,13 +5112,12 ＠＠
{
for (ii = ending - 1; ii >= starting; --ii)
{
- accum = call2 (function, KEY (key,
+ accum = CALL2 (function, KEY (key,
make_int (bit_vector_bit (bv,
ii))),
accum);
}
}
-
}
else if (STRINGP (sequence))
{
＠＠ -5080,7 +5138,7 ＠＠
{
accum = initial_value;
}
- else if (ending - starting && starting < ending)
+ else if (ending - starting)
{
accum = KEY (key, make_char (itext_ichar (cursor)));
starting++;
＠＠ -5097,9 +5155,9 ＠＠
cursor_offset = cursor - startp;
}
- while (cursor_offset < byte_len && starting < ending)
- {
- accum = call2 (function, accum,
+ while (cursor_offset < byte_len && ii < ending)
+ {
+ accum = CALL2 (function, accum,
KEY (key, make_char (itext_ichar (cursor))));
startp = XSTRING_DATA (sequence);
＠＠ -5113,8 +5171,14 ＠＠
INC_IBYTEPTR (cursor);
cursor_offset = cursor - startp;
- ++starting;
- }
+ ++ii;
+ }
+
+ if (ii < starting || (ii < ending && !NILP (end)))
+ {
+ check_sequence_range (sequence, start, end, Flength (sequence));
+ ABORT ();
+ }
}
else
{
＠＠ -5122,6 +5186,8 ＠＠
Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
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);
＠＠ -5130,7 +5196,7 ＠＠
{
accum = initial_value;
}
- else if (ending - starting && starting < ending)
+ else if (ending - starting)
{
accum = KEY (key, make_char (itext_ichar (cursor)));
ending--;
＠＠ -5150,7 +5216,7 ＠＠
for (ii = ending - 1; ii >= starting; --ii)
{
- accum = call2 (function, KEY (key,
+ accum = CALL2 (function, KEY (key,
make_char (itext_ichar (cursor))),
accum);
if (ii > 0)
＠＠ -5182,27 +5248,27 ＠＠
{
accum = initial_value;
}
- else if (ending - starting && starting < ending)
- {
- Elemcount counting = 0;
+ else if (ending - starting)
+ {
+ ii = 0;
EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
{
/* KEY may amputate the list behind us; make sure what
remains to be processed is still reachable. */
tailed = tail;
- if (counting == starting)
+ if (ii == starting)
{
accum = KEY (key, elt);
starting++;
break;
}
- ++counting;
- }
- }
-
- if (ending - starting && starting < ending)
- {
- Elemcount counting = 0;
+ ++ii;
+ }
+ }
+
+ if (ending - starting)
+ {
+ ii = 0;
EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
{
＠＠ -5210,22 +5276,28 ＠＠
sure what remains to be processed is still
reachable. */
tailed = tail;
- if (counting >= starting)
- {
- if (counting < ending)
+ if (ii >= starting)
+ {
+ if (ii < ending)
{
- accum = call2 (function, accum, KEY (key, elt));
+ accum = CALL2 (function, accum, KEY (key, elt));
}
- else if (counting == ending)
+ else if (ii == ending)
{
break;
}
}
- ++counting;
+ ++ii;
}
}
UNGCPRO;
+
+ if (ii < starting || (ii < ending && !NILP (end)))
+ {
+ check_sequence_range (sequence, start, end, Flength (sequence));
+ ABORT ();
+ }
}
else
{
＠＠ -5234,11 +5306,9 ＠＠
Elemcount counting = 0, len = 0;
struct gcpro gcpro1;
- if (ending - starting && starting < ending
- && EMACS_INT_MAX == ending)
- {
- ending = XINT (Flength (sequence));
- }
+ len = XINT (Flength (sequence));
+ check_sequence_range (sequence, start, end, make_int (len));
+ ending = min (ending, len);
/* :from-end with a list; make an alloca copy of the relevant list
data, attempting to go backwards isn't worth the trouble. */
＠＠ -5295,7 +5365,7 ＠＠
for (ii = len; ii != 0;)
{
--ii;
- accum = call2 (function, KEY (key, subsequence[ii]), accum);
+ accum = CALL2 (function, KEY (key, subsequence[ii]), accum);
}
if (subsequence != NULL)
＠＠ -5310,7 +5380,7 ＠＠
arguments. */
if (UNBOUNDP (accum))
{
- accum = call0 (function);
+ accum = IGNORE_MULTIPLE_VALUES (call0 (function));
}
return accum;
＠＠ -5470,7 +5540,7 ＠＠
Lisp_Object sequence1 = args[0], sequence2 = args[1],
result = sequence1;
Elemcount starting1, ending1 = EMACS_INT_MAX, starting2;
- Elemcount ending2 = EMACS_INT_MAX, counting, startcounting;
+ Elemcount ending2 = EMACS_INT_MAX, counting = 0, startcounting;
Boolint sequence1_listp, sequence2_listp,
overwriting = EQ (sequence1, sequence2);
＠＠ -5516,32 +5586,30 ＠＠
if (sequence1_listp && !ZEROP (start1))
{
- Lisp_Object nthcdrd = Fnthcdr (start1, sequence1);
-
- if (NILP (nthcdrd))
- {
- check_sequence_range (sequence1, start1, end1, Flength (sequence1));
+ sequence1 = Fnthcdr (start1, sequence1);
+
+ if (NILP (sequence1))
+ {
+ check_sequence_range (args[0], start1, end1, Flength (args[0]));
/* Give up early here. */
return result;
}
- sequence1 = nthcdrd;
ending1 -= starting1;
starting1 = 0;
}
if (sequence2_listp && !ZEROP (start2))
{
- Lisp_Object nthcdrd = Fnthcdr (start2, sequence2);
-
- if (NILP (nthcdrd))
- {
- check_sequence_range (sequence1, start1, end1, Flength (sequence1));
+ sequence2 = Fnthcdr (start2, sequence2);
+
+ if (NILP (sequence2))
+ {
+ check_sequence_range (args[1], start1, end1, Flength (args[1]));
/* Nothing available to replace sequence1's contents. */
return result;
}
- sequence2 = nthcdrd;
ending2 -= starting2;
starting2 = 0;
}
＠＠ -5560,7 +5628,7 ＠＠
Elemcount len = XINT (Flength (sequence2));
Lisp_Object *subsequence
= alloca_array (Lisp_Object, min (ending2, len));
- Elemcount counting = 0, ii = 0;
+ Elemcount ii = 0;
LIST_LOOP_2 (elt, sequence2)
{
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Don't uselessly call #'nreverse, #'hash-table-key-list and friends.
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5327:2def0d83a5e3
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 16:46:27 2010 +0100
files: lisp/ChangeLog lisp/behavior.el lisp/hash-table.el
description:
Don't uselessly call #'nreverse, #'hash-table-key-list and friends.
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
diff -r 3acaa0fc09be -r 2def0d83a5e3 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Sep 16 15:58:10 2010 +0100
+++ b/lisp/ChangeLog Thu Sep 16 16:46:27 2010 +0100
＠＠ -1,3 +1,13 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * hash-table.el (hash-table-key-list, hash-table-value-list)
+ (hash-table-key-value-alist, hash-table-key-value-plist):
+ Remove some useless #'nreverse calls in these files; our hash
+ tables have no order, it's not helpful to pretend they do.
+ * behavior.el (read-behavior):
+ Do the same in this file, in some code evidently copied from
+ hash-table.el.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* info.el (Info-insert-dir):
diff -r 3acaa0fc09be -r 2def0d83a5e3 lisp/behavior.el
--- a/lisp/behavior.el Thu Sep 16 15:58:10 2010 +0100
+++ b/lisp/behavior.el Thu Sep 16 16:46:27 2010 +0100
＠＠ -349,15 +349,11 ＠＠
(let ((result
(completing-read
prompt
- (let ((table (let (lis)
- (maphash #'(lambda (key val)
- (push (cons key val) lis))
- behavior-hash-table)
- (nreverse lis))))
- (mapc #'(lambda (aentry)
- (setcar aentry (symbol-name (car aentry))))
- table)
- table)
+ (let (list)
+ (maphash #'(lambda (key value)
+ (push (cons (symbol-name key) value) list))
+ behavior-hash-table)
+ list)
nil must-match initial-contents (or history 'behavior-history)
default-value)))
(if (and result (stringp result))
diff -r 3acaa0fc09be -r 2def0d83a5e3 lisp/hash-table.el
--- a/lisp/hash-table.el Thu Sep 16 15:58:10 2010 +0100
+++ b/lisp/hash-table.el Thu Sep 16 16:46:27 2010 +0100
＠＠ -37,34 +37,27 ＠＠
(defun hash-table-key-list (hash-table)
"Return a list of all keys in HASH-TABLE."
- (let (lis)
- (maphash #'(lambda (key val)
- (push key lis))
- hash-table)
- (nreverse lis)))
+ (let (list)
+ (maphash #'(lambda (key value) (push key list)) hash-table)
+ list))
(defun hash-table-value-list (hash-table)
"Return a list of all values in HASH-TABLE."
- (let (lis)
- (maphash #'(lambda (key val)
- (push val lis))
- hash-table)
- (nreverse lis)))
+ (let (list)
+ (maphash #'(lambda (key value) (push value list)) hash-table)
+ list))
(defun hash-table-key-value-alist (hash-table)
"Return an alist of (KEY . VALUE) for all keys and values in HASH-TABLE."
- (let (lis)
- (maphash #'(lambda (key val)
- (push (cons key val) lis))
+ (let (list)
+ (maphash #'(lambda (key value) (setq list (acons key value list)))
hash-table)
- (nreverse lis)))
+ list))
(defun hash-table-key-value-plist (hash-table)
"Return a plist for all keys and values in HASH-TABLE.
A plist is a simple list containing alternating keys and values."
- (let (lis)
- (maphash #'(lambda (key val)
- (push key lis)
- (push val lis))
+ (let (list)
+ (maphash #'(lambda (key value) (setq list (list* key value list)))
hash-table)
- (nreverse lis)))
+ list))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Use #'some, #'every, etc. for composing boolean operations on lists.
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5326:3acaa0fc09be
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 15:58:10 2010 +0100
files: lisp/ChangeLog lisp/files.el lisp/format.el lisp/info.el
description:
Use #'some, #'every, etc. for composing boolean operations on lists.
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
diff -r 90a0084b3541 -r 3acaa0fc09be lisp/ChangeLog
--- a/lisp/ChangeLog Thu Sep 16 15:34:35 2010 +0100
+++ b/lisp/ChangeLog Thu Sep 16 15:58:10 2010 +0100
＠＠ -1,3 +1,12 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * info.el (Info-insert-dir):
+ * format.el (format-deannotate-region):
+ * files.el (cd, save-buffers-kill-emacs):
+ Use #'some, #'every and related functions for applying boolean
+ operations to lists, instead of rolling our own ones that cons and
+ don't short-circuit.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
diff -r 90a0084b3541 -r 3acaa0fc09be lisp/files.el
--- a/lisp/files.el Thu Sep 16 15:34:35 2010 +0100
+++ b/lisp/files.el Thu Sep 16 15:58:10 2010 +0100
＠＠ -606,15 +606,10 ＠＠
(setq cd-path (or (and trypath
(mapcar #'file-name-as-directory trypath))
(list (file-name-as-directory "")))))
- (or (catch 'found
- (mapc #'(lambda (x)
- (let ((f (expand-file-name (concat x dir))))
- (if (file-directory-p f)
- (progn
- (cd-absolute f)
- (throw 'found t)))))
- cd-path)
- nil)
+ (or (some #'(lambda (x)
+ (let ((f (expand-file-name (concat x dir))))
+ (when (file-directory-p f) (cd-absolute f))))
+ cd-path)
;; jwz: give a better error message to those of us with the
;; good taste not to use a kludge like $CDPATH.
(if (equal cd-path '("./"))
＠＠ -4454,9 +4449,10 ＠＠
With prefix arg, silently save all file-visiting buffers, then kill."
(interactive "P")
(save-some-buffers arg t)
- (and (or (not (memq t (mapcar #'(lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf)))
- (buffer-list))))
+ (and (or (not (some #'(lambda (buf)
+ (and (buffer-file-name buf)
+ (buffer-modified-p buf)))
+ (buffer-list)))
(yes-or-no-p "Modified buffers exist; exit anyway? "))
(or (not (fboundp 'process-list))
;; process-list is not defined on VMS.
diff -r 90a0084b3541 -r 3acaa0fc09be lisp/format.el
--- a/lisp/format.el Thu Sep 16 15:34:35 2010 +0100
+++ b/lisp/format.el Thu Sep 16 15:58:10 2010 +0100
＠＠ -604,9 +604,8 ＠＠
(if (member top-name ans)
;; This annotation is listed, but still have to
;; check if multiple annotations are satisfied
- (if (member nil (mapcar (lambda (r)
- (assoc r open-ans))
- ans))
+ (if (notevery (lambda (r) (assoc r open-ans))
+ ans)
nil ; multiple ans not satisfied
;; If there are multiple annotations going
;; into one text property, split up the other
diff -r 90a0084b3541 -r 3acaa0fc09be lisp/info.el
--- a/lisp/info.el Thu Sep 16 15:34:35 2010 +0100
+++ b/lisp/info.el Thu Sep 16 15:58:10 2010 +0100
＠＠ -864,14 +864,13 ＠＠
(if (and Info-dir-contents Info-dir-file-attributes
;; Verify that none of the files we used has changed
;; since we used it.
- (eval (cons 'and
- (mapcar #'(lambda (elt)
- (let ((curr (file-attributes (car elt))))
- ;; Don't compare the access time.
- (if curr (setcar (nthcdr 4 curr) 0))
- (setcar (nthcdr 4 (cdr elt)) 0)
- (equal (cdr elt) curr)))
- Info-dir-file-attributes))))
+ (every #'(lambda (elt)
+ (let ((curr (file-attributes (car elt))))
+ ;; Don't compare the access time.
+ (if curr (setcar (nthcdr 4 curr) 0))
+ (setcar (nthcdr 4 (cdr elt)) 0)
+ (equal (cdr elt) curr)))
+ Info-dir-file-attributes))
(insert Info-dir-contents)
(let ((dirs (reverse Info-directory-list))
buffers lbuffers buffer others nodes dirs-done)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Rephrase the #'the docstring, make it nicer while byte-compiling.
14 years, 4 months
Aidan Kehoe
Aidan Kehoe
changeset: 5325:90a0084b3541
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 15:34:35 2010 +0100
files: lisp/ChangeLog lisp/bytecomp.el lisp/cl-macs.el
description:
Rephrase the #'the docstring, make it nicer while byte-compiling.
lisp/ChangeLog addition:
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
diff -r 09f8ed0933c7 -r 90a0084b3541 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Sep 16 15:24:40 2010 +0100
+++ b/lisp/ChangeLog Thu Sep 16 15:34:35 2010 +0100
＠＠ -1,3 +1,10 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp.el (byte-compile-initial-macro-environment):
+ * cl-macs.el (the):
+ Rephrase the docstring, make its implementation when compiling
+ files a little nicer.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
diff -r 09f8ed0933c7 -r 90a0084b3541 lisp/bytecomp.el
--- a/lisp/bytecomp.el Thu Sep 16 15:24:40 2010 +0100
+++ b/lisp/bytecomp.el Thu Sep 16 15:34:35 2010 +0100
＠＠ -504,10 +504,10 ＠＠
(byte-compile-eval (cons 'progn body))
(cons 'progn body)))
(the .
- ,#'(lambda (&rest body)
+ ,#'(lambda (type form)
(if byte-compile-delete-errors
- (second body)
- (apply (cdr (symbol-function 'the)) body)))))
+ form
+ (funcall (cdr (symbol-function 'the)) type form)))))
"The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
expanded by the compiler as when expanded by the interpreter.")
diff -r 09f8ed0933c7 -r 90a0084b3541 lisp/cl-macs.el
--- a/lisp/cl-macs.el Thu Sep 16 15:24:40 2010 +0100
+++ b/lisp/cl-macs.el Thu Sep 16 15:34:35 2010 +0100
＠＠ -1963,13 +1963,13 ＠＠
(defmacro locally (&rest body) (cons 'progn body))
;;;###autoload
(defmacro the (type form)
- "Assert that FORM gives a result of type TYPE, and return FORM.
+ "Assert that FORM gives a result of type TYPE, and return that result.
TYPE is a Common Lisp type specifier.
If macro expansion of a `the' form happens during byte compilation, and the
byte compiler customization variable `byte-compile-delete-errors' is
-non-nil, `the' just returns FORM, without making any type checks."
+non-nil, `the' is equivalent to FORM without any type checks."
(if (cl-safe-expr-p form)
`(prog1 ,form (assert ,(cl-make-type-test form type) t))
(let ((saved (gensym)))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments