[COMMIT] Support up to nine keywords in the PARSE_KEYWORDS() macro.
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293671078 0
# Node ID df125a42c50cdcfa85a5cceae8256cbeb842cac4
# Parent 57a64ab2ae4573e6952067b91edbc1cd0215feb9
Support up to nine keywords in the PARSE_KEYWORDS() macro.
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (DECLARE_N_KEYWORDS_8, DECLARE_N_KEYWORDS_9)
(CHECK_N_KEYWORDS_8, CHECK_N_KEYWORDS_9):
Support up to nine keywords in the PARSE_KEYWORDS() macro.
diff -r 57a64ab2ae45 -r df125a42c50c src/ChangeLog
--- a/src/ChangeLog Thu Dec 30 01:00:40 2010 +0000
+++ b/src/ChangeLog Thu Dec 30 01:04:38 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp.h (DECLARE_N_KEYWORDS_8, DECLARE_N_KEYWORDS_9)
+ (CHECK_N_KEYWORDS_8, CHECK_N_KEYWORDS_9):
+ Support up to nine keywords in the PARSE_KEYWORDS() macro.
+
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* elhash.c (syms_of_elhash):
diff -r 57a64ab2ae45 -r df125a42c50c src/lisp.h
--- a/src/lisp.h Thu Dec 30 01:00:40 2010 +0000
+++ b/src/lisp.h Thu Dec 30 01:04:38 2010 +0000
＠＠ -3641,6 +3641,10 ＠＠
DECLARE_N_KEYWORDS_5(a,b,c,d,e), f = Qnil
#define DECLARE_N_KEYWORDS_7(a,b,c,d,e,f,g) \
DECLARE_N_KEYWORDS_6(a,b,c,d,e,f), g = Qnil
+#define DECLARE_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \
+ DECLARE_N_KEYWORDS_7(a,b,c,d,e,f,g), h = Qnil
+#define DECLARE_N_KEYWORDS_9(a,b,c,d,e,f,g,h,i) \
+ DECLARE_N_KEYWORDS_8(a,b,c,d,e,f,g,h), i = Qnil
#define CHECK_N_KEYWORDS_1(a) \
else if (EQ (pk_key, Q_##a)) { a = pk_value; }
＠＠ -3656,6 +3660,12 ＠＠
else if (EQ (pk_key, Q_##f)) { f = pk_value; }
#define CHECK_N_KEYWORDS_7(a,b,c,d,e,f,g) CHECK_N_KEYWORDS_6(a,b,c,d,e,f) \
else if (EQ (pk_key, Q_##g)) { g = pk_value; }
+#define CHECK_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \
+ CHECK_N_KEYWORDS_7(a,b,c,d,e,f,g) \
+ else if (EQ (pk_key, Q_##h)) { h = pk_value; }
+#define CHECK_N_KEYWORDS_9(a,b,c,d,e,f,g,h,i) \
+ CHECK_N_KEYWORDS_8(a,b,c,d,e,f,g,h) \
+ else if (EQ (pk_key, Q_##i)) { i = pk_value; }
Boolint non_nil_allow_other_keys_p (Elemcount offset, int nargs,
Lisp_Object *args);
--
“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
[COMMIT] Implement some basic Lisp functions in terms of Common Lisp builtins.
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293670840 0
# Node ID 57a64ab2ae4573e6952067b91edbc1cd0215feb9
# Parent 31be2a3d121d6c2795ab0eb45fbc782be88f14c1
Implement some basic Lisp functions in terms of Common Lisp builtins.
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
diff -r 31be2a3d121d -r 57a64ab2ae45 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Dec 30 00:50:10 2010 +0000
+++ b/lisp/ChangeLog Thu Dec 30 01:00:40 2010 +0000
＠＠ -1,3 +1,19 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * simple.el (assoc-ignore-case): Remove a duplicate definition of
+ this function (it's already in subr.el).
+ * iso8859-1.el (char-width):
+ On non-Mule, make this function equivalent to that produced by
+ (constantly 1), but preserve its docstring.
+ * subr.el (subst-char-in-string): Define this in terms of
+ #'substitute, #'nsubstitute.
+ (string-width): Define this using #'reduce and #'char-width.
+ (char-width): Give this a simpler definition, it makes far more
+ sense to check for mule at load time and redefine, as we do in
+ iso8859-1.el.
+ (store-substring): Implement this in terms of #'replace, now
+ #'replace is cheap.
+
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
diff -r 31be2a3d121d -r 57a64ab2ae45 lisp/iso8859-1.el
--- a/lisp/iso8859-1.el Thu Dec 30 00:50:10 2010 +0000
+++ b/lisp/iso8859-1.el Thu Dec 30 01:00:40 2010 +0000
＠＠ -84,6 +84,17 ＠＠
;; by default.
(setq-default ctl-arrow #xA0)
+(when (and (compiled-function-p (symbol-function 'char-width))
+ (not (featurep 'mule)))
+ (defalias 'char-width
+ (let ((constantly (constantly 1)))
+ (make-byte-code (compiled-function-arglist constantly)
+ (compiled-function-instructions constantly)
+ (compiled-function-constants constantly)
+ (compiled-function-stack-depth constantly)
+ (compiled-function-doc-string
+ (symbol-function 'char-width))))))
+
;; Shouldn't be necessary, but one file in the packages uses it:
(provide 'iso8859-1)
diff -r 31be2a3d121d -r 57a64ab2ae45 lisp/simple.el
--- a/lisp/simple.el Thu Dec 30 00:50:10 2010 +0000
+++ b/lisp/simple.el Thu Dec 30 01:00:40 2010 +0000
＠＠ -3332,11 +3332,6 ＠＠
;; keyboard-quit
;; buffer-quit-function
;; keyboard-escape-quit
-
-(defun assoc-ignore-case (key alist)
- "Like `assoc', but assumes KEY is a string and ignores case when comparing."
- (assoc* key alist :test #'equalp))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mail composition code ;;
diff -r 31be2a3d121d -r 57a64ab2ae45 lisp/subr.el
--- a/lisp/subr.el Thu Dec 30 00:50:10 2010 +0000
+++ b/lisp/subr.el Thu Dec 30 01:00:40 2010 +0000
＠＠ -765,14 +765,8 ＠＠
(defun subst-char-in-string (fromchar tochar string &optional inplace)
"Replace FROMCHAR with TOCHAR in STRING each time it occurs.
Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr))
-
+ (funcall (if inplace #'nsubstitute #'substitute) tochar fromchar
+ (the string string) :test #'eq))
;; XEmacs addition:
(defun replace-in-string (str regexp newtext &optional literal)
＠＠ -961,23 +955,11 ＠＠
the characters in STRING, which may not accurately represent the actual
display width when using a window system. With no international support,
simply returns the length of the string."
- (if (featurep 'mule)
- (let ((col 0)
- (len (length string))
- (i 0))
- (with-fboundp '(charset-width char-charset)
- (while (< i len)
- (setq col (+ col (charset-width (char-charset (aref string i)))))
- (setq i (1+ i))))
- col)
- (length string)))
+ (reduce #'+ (the string string) :initial-value 0 :key #'char-width))
(defun char-width (character)
"Return number of columns a CHARACTER occupies when displayed."
- (if (featurep 'mule)
- (with-fboundp '(charset-width char-charset)
- (charset-width (char-charset character)))
- 1))
+ (charset-width (char-charset character)))
;; The following several functions are useful in GNU Emacs 20 because
;; of the multibyte "characters" the internal representation of which
＠＠ -1003,18 +985,9 ＠＠
(defun store-substring (string idx obj)
"Embed OBJ (string or character) at index IDX of STRING."
- (let* ((str (cond ((stringp obj) obj)
- ((characterp obj) (char-to-string obj))
- (t (error
- "Invalid argument (should be string or character): %s"
- obj))))
- (string-len (length string))
- (len (length str))
- (i 0))
- (while (and (< i len) (< idx string-len))
- (aset string idx (aref str i))
- (setq idx (1+ idx) i (1+ i)))
- string))
+ (if (stringp obj)
+ (replace (the string string) obj :start1 idx)
+ (prog1 string (aset string idx obj))))
;; From FSF 21.1; ELLIPSES is XEmacs addition.
--
“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
[COMMIT] Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293670210 0
# Node ID 31be2a3d121d6c2795ab0eb45fbc782be88f14c1
# Parent ed5d4f081fa9f5a2183fa34b45fb7ac8bb237eb2
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* elhash.c (syms_of_elhash):
* chartab.c (syms_of_chartab):
* abbrev.c (syms_of_abbrev):
* general-slots.h:
Move Qcount, Q_default, Q_test to general-slots.h, they're about
to be used by other files. Rename Q_default to Q_default_, for the
sake of the PARSE_KEYWORDS macro (given that default is a reserved
identifier in C). Add SYMBOL_KEYWORD_GENERAL(), analogous to
SYMBOL_GENERAL() to make this easier.
diff -r ed5d4f081fa9 -r 31be2a3d121d src/ChangeLog
--- a/src/ChangeLog Thu Dec 30 00:18:50 2010 +0000
+++ b/src/ChangeLog Thu Dec 30 00:50:10 2010 +0000
＠＠ -1,3 +1,15 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * elhash.c (syms_of_elhash):
+ * chartab.c (syms_of_chartab):
+ * abbrev.c (syms_of_abbrev):
+ * general-slots.h:
+ Move Qcount, Q_default, Q_test to general-slots.h, they're about
+ to be used by other files. Rename Q_default to Q_default_, for the
+ sake of the PARSE_KEYWORDS macro (given that default is a reserved
+ identifier in C). Add SYMBOL_KEYWORD_GENERAL(), analogous to
+ SYMBOL_GENERAL() to make this easier.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* floatfns.c (Ffloat): If we've been handed a bigfloat here, it's
diff -r ed5d4f081fa9 -r 31be2a3d121d src/abbrev.c
--- a/src/abbrev.c Thu Dec 30 00:18:50 2010 +0000
+++ b/src/abbrev.c Thu Dec 30 00:50:10 2010 +0000
＠＠ -75,7 +75,7 ＠＠
/* Hook to run before expanding any abbrev. */
Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
-Lisp_Object Qsystem_type, Qcount;
+Lisp_Object Qsystem_type;
struct abbrev_match_mapper_closure
{
＠＠ -558,9 +558,6 ＠＠
void
syms_of_abbrev (void)
{
- DEFSYMBOL(Qcount);
- Qcount = intern ("count");
- staticpro (&Qcount);
DEFSYMBOL(Qsystem_type);
Qsystem_type = intern ("system-type");
DEFSYMBOL (Qpre_abbrev_expand_hook);
diff -r ed5d4f081fa9 -r 31be2a3d121d src/chartab.c
--- a/src/chartab.c Thu Dec 30 00:18:50 2010 +0000
+++ b/src/chartab.c Thu Dec 30 00:50:10 2010 +0000
＠＠ -42,7 +42,7 ＠＠
#include "chartab.h"
#include "syntax.h"
-Lisp_Object Qchar_tablep, Qchar_table, Q_default;
+Lisp_Object Qchar_tablep, Qchar_table;
Lisp_Object Vall_syntax_tables;
＠＠ -1581,7 +1581,7 ＠＠
{
type = value;
}
- else if (EQ (key, Q_default))
+ else if (EQ (key, Q_default_))
{
default_ = value;
}
＠＠ -1626,7 +1626,11 ＠＠
check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab),
ERROR_ME);
set_char_table_default (chartab, default_);
- set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, default_);
+ if (!NILP (XCHAR_TABLE (chartab)->mirror_table))
+ {
+ set_char_table_default (XCHAR_TABLE (chartab)->mirror_table,
+ default_);
+ }
}
while (!NILP (dataval))
＠＠ -1902,7 +1906,6 ＠＠
DEFSYMBOL (Qchar_table);
DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep);
- DEFKEYWORD (Q_default);
DEFSUBR (Fchar_table_p);
DEFSUBR (Fchar_table_type_list);
＠＠ -1957,7 +1960,7 ＠＠
define_structure_type_keyword (st, Q_type, chartab_type_validate);
define_structure_type_keyword (st, Q_data, chartab_data_validate);
- define_structure_type_keyword (st, Q_default, chartab_default_validate);
+ define_structure_type_keyword (st, Q_default_, chartab_default_validate);
}
void
diff -r ed5d4f081fa9 -r 31be2a3d121d src/elhash.c
--- a/src/elhash.c Thu Dec 30 00:18:50 2010 +0000
+++ b/src/elhash.c Thu Dec 30 00:50:10 2010 +0000
＠＠ -93,7 +93,7 ＠＠
static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
static Lisp_Object Vall_weak_hash_tables;
static Lisp_Object Qrehash_size, Qrehash_threshold;
-static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold;
+static Lisp_Object Q_size, Q_weakness, Q_rehash_size, Q_rehash_threshold;
static Lisp_Object Vhash_table_test_eq, Vhash_table_test_eql;
static Lisp_Object Vhash_table_test_weak_list;
＠＠ -2291,7 +2291,6 ＠＠
DEFSYMBOL (Qnon_weak); /* obsolete */
DEFKEYWORD (Q_data);
- DEFKEYWORD (Q_test);
DEFKEYWORD (Q_size);
DEFKEYWORD (Q_rehash_size);
DEFKEYWORD (Q_rehash_threshold);
diff -r ed5d4f081fa9 -r 31be2a3d121d src/general-slots.h
--- a/src/general-slots.h Thu Dec 30 00:18:50 2010 +0000
+++ b/src/general-slots.h Thu Dec 30 00:50:10 2010 +0000
＠＠ -32,6 +32,8 ＠＠
SYMBOL_KEYWORD (Q_foo); declares a keyword symbol ":foo"
SYMBOL_GENERAL (Qfoo, "bar"); declares a symbol named "bar" but stored in
the variable Qfoo
+ SYMBOL_KEYWORD_GENERAL (Q_foo_, ":bar"); declares a keyword named ":bar"
+ but stored in the variable Q_foo_.
To sort the crap in this file, use the following:
＠＠ -92,6 +94,7 ＠＠
SYMBOL (Qconsole);
SYMBOL (Qcontrol_1);
SYMBOL (Qcopies);
+SYMBOL (Qcount);
SYMBOL_MODULE_API (Qcritical);
SYMBOL (Qctext);
SYMBOL (Qcurrent);
＠＠ -102,6 +105,9 ＠＠
SYMBOL (Qdead);
SYMBOL (Qdebug);
SYMBOL (Qdefault);
+/* We name the C variable corresponding to the keyword Q_default_, not
+ Q_default, to allow it to be useful with PARSE_KEYWORDS (). */
+SYMBOL_KEYWORD_GENERAL (Q_default_, ":default");
SYMBOL_MODULE_API (Qdelete);
SYMBOL (Qdelq);
SYMBOL (Qdescription);
＠＠ -270,6 +276,7 ＠＠
SYMBOL_KEYWORD (Q_start);
SYMBOL (Qstream);
SYMBOL (Qstring);
+SYMBOL (Qstring_match);
SYMBOL_KEYWORD (Q_style);
SYMBOL_KEYWORD (Q_suffix);
SYMBOL (Qsubtype);
＠＠ -279,6 +286,7 ＠＠
SYMBOL (Qsystem_default);
SYMBOL (Qterminal);
SYMBOL (Qtest);
+SYMBOL_KEYWORD (Q_test);
SYMBOL (Qtext);
SYMBOL_KEYWORD (Q_text);
SYMBOL (Qthis_command);
diff -r ed5d4f081fa9 -r 31be2a3d121d src/general.c
--- a/src/general.c Thu Dec 30 00:18:50 2010 +0000
+++ b/src/general.c Thu Dec 30 00:50:10 2010 +0000
＠＠ -29,8 +29,9 ＠＠
#define SYMBOL(fou) Lisp_Object fou
#define SYMBOL_MODULE_API(fou) Lisp_Object fou
-#define SYMBOL_KEYWORD(la_cle_est_fou) Lisp_Object la_cle_est_fou
+#define SYMBOL_KEYWORD(la_cle_est_folle) Lisp_Object la_cle_est_folle
#define SYMBOL_GENERAL(tout_le_monde, est_fou) Lisp_Object tout_le_monde
+#define SYMBOL_KEYWORD_GENERAL(ponle, la_clave) Lisp_Object ponle
#include "general-slots.h"
＠＠ -38,6 +39,7 ＠＠
#undef SYMBOL_MODULE_API
#undef SYMBOL_KEYWORD
#undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
void
syms_of_general (void)
＠＠ -46,10 +48,13 ＠＠
#define SYMBOL_MODULE_API(loco) DEFSYMBOL (loco)
#define SYMBOL_KEYWORD(meshugeneh) DEFKEYWORD (meshugeneh)
#define SYMBOL_GENERAL(vachement, fou) defsymbol (&vachement, fou)
+#define SYMBOL_KEYWORD_GENERAL(bescheuert, gaaanz_bescheuert) \
+ defkeyword (&bescheuert, gaaanz_bescheuert)
#include "general-slots.h"
#undef SYMBOL
#undef SYMBOL_KEYWORD
#undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
}
diff -r ed5d4f081fa9 -r 31be2a3d121d src/lisp.h
--- a/src/lisp.h Thu Dec 30 00:18:50 2010 +0000
+++ b/src/lisp.h Thu Dec 30 00:50:10 2010 +0000
＠＠ -5305,9 +5305,11 ＠＠
/* Defined in general.c */
#define SYMBOL(fou) extern Lisp_Object fou
#define SYMBOL_MODULE_API(fou) extern MODULE_API Lisp_Object fou
-#define SYMBOL_KEYWORD(la_cle_est_fou) extern Lisp_Object la_cle_est_fou
+#define SYMBOL_KEYWORD(la_cle_est_folle) extern Lisp_Object la_cle_est_folle
#define SYMBOL_GENERAL(tout_le_monde, est_fou) \
extern Lisp_Object tout_le_monde
+#define SYMBOL_KEYWORD_GENERAL(y_compris_ben, mais_que_peut_on_faire) \
+ extern Lisp_Object y_compris_ben
#include "general-slots.h"
＠＠ -5315,6 +5317,7 ＠＠
#undef SYMBOL_MODULE_API
#undef SYMBOL_KEYWORD
#undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
extern Lisp_Object Qeq;
extern Lisp_Object Qeql;
--
“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
[COMMIT] cl-macs belongs in lisp-files-needed-for-byte-compilation.
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293668330 0
# Node ID ed5d4f081fa9f5a2183fa34b45fb7ac8bb237eb2
# Parent 203dcac81daeb1697be1f3286e248846713f61de
cl-macs belongs in lisp-files-needed-for-byte-compilation.
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
diff -r 203dcac81dae -r ed5d4f081fa9 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Dec 30 00:15:37 2010 +0000
+++ b/lisp/ChangeLog Thu Dec 30 00:18:50 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * update-elc.el (lisp-files-needed-for-byte-compilation)
+ (lisp-files-needing-early-byte-compilation):
+ cl-macs belongs in the former, not the latter, it is as
+ fundamental as bytecomp.el.
+
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* cl.el:
diff -r 203dcac81dae -r ed5d4f081fa9 lisp/update-elc.el
--- a/lisp/update-elc.el Thu Dec 30 00:15:37 2010 +0000
+++ b/lisp/update-elc.el Thu Dec 30 00:18:50 2010 +0000
＠＠ -102,6 +102,7 ＠＠
;; .elc's.
(defvar lisp-files-needed-for-byte-compilation
'("bytecomp"
+ "cl-macs"
"byte-optimize"))
;; Lisp files not in `lisp-files-needed-for-byte-compilation' that need
＠＠ -110,8 +111,7 ＠＠
(defvar lisp-files-needing-early-byte-compilation
'("easy-mmode"
"autoload"
- "shadow"
- "cl-macs"))
+ "shadow"))
(defvar unbytecompiled-lisp-files
'("paths.el"
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
[COMMIT] Provide some milquetoast compatibility in our errors, type-error, program-error
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293668137 0
# Node ID 203dcac81daeb1697be1f3286e248846713f61de
# Parent 8aa511adfad6715a23c9ac7a8372537f41f098ef
Provide some milquetoast compatibility in our errors, type-error, program-error
2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
diff -r 8aa511adfad6 -r 203dcac81dae lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:56:57 2010 +0000
+++ b/lisp/ChangeLog Thu Dec 30 00:15:37 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl.el:
+ Provde the Common Lisp program-error, type-error as error
+ symbols. This doesn't nearly go far enough for anyone using the
+ Common Lisp errors.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (delete-duplicates):
diff -r 8aa511adfad6 -r 203dcac81dae lisp/cl.el
--- a/lisp/cl.el Wed Dec 29 23:56:57 2010 +0000
+++ b/lisp/cl.el Thu Dec 30 00:15:37 2010 +0000
＠＠ -603,6 +603,19 ＠＠
;; XEmacs change
(define-error 'cl-assertion-failed "Assertion failed")
+;; XEmacs; provide a milquetoast amount of compatibility in our error symbols.
+(define-error 'type-error "Wrong type" 'wrong-type-argument)
+(define-error 'program-error "Error in your program" 'invalid-argument)
+
+(map-plist
+ #'(lambda (key value)
+ (mapc #'(lambda (error)
+ (put error 'error-conditions
+ (cons key (get error 'error-conditions))))
+ value))
+ '(program-error (wrong-number-of-arguments invalid-keyword-argument)
+ type-error (wrong-type-argument malformed-list circular-list)))
+
;; XEmacs change: omit the autoload rules; we handle those a different way
;;; Define data for indentation and edebug.
--
“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
[COMMIT] #'delete-duplicates: don't attempt to compiler macroexpand with bad arguments
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293667017 0
# Node ID 8aa511adfad6715a23c9ac7a8372537f41f098ef
# Parent 9ac28212c75a3d96011a7ac7614dcddc261be3c3
#'delete-duplicates: don't attempt to compiler macroexpand with bad arguments
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
diff -r 9ac28212c75a -r 8aa511adfad6 lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:53:48 2010 +0000
+++ b/lisp/ChangeLog Wed Dec 29 23:56:57 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (delete-duplicates):
+ If the form has an incorrect number of arguments, don't attempt a
+ compiler macroexpansion.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (cl-safe-expr-p):
diff -r 9ac28212c75a -r 8aa511adfad6 lisp/cl-macs.el
--- a/lisp/cl-macs.el Wed Dec 29 23:53:48 2010 +0000
+++ b/lisp/cl-macs.el Wed Dec 29 23:56:57 2010 +0000
＠＠ -3487,56 +3487,60 ＠＠
;; XEmacs; inline delete-duplicates if it's called with one of the
;; common compile-time constant tests and an optional :from-end
;; argument, we want the speed in font-lock.el.
-(define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys)
- (if (not (or (memq (car-safe cl-seq)
- ;; No need to check for a list at runtime with
- ;; these. We could expand the list, but these are all
- ;; the functions in the relevant context at the moment.
- '(nreverse append nconc mapcan mapcar string-to-list))
- (and (listp cl-seq) (equal (butlast cl-seq) '(the list)))))
- form
- (cond
- ((or (plists-equal cl-keys '(:test 'eq) t)
- (plists-equal cl-keys '(:test #'eq) t))
- `(let* ((begin ,cl-seq)
- cl-seq)
- (while (memq (car begin) (cdr begin))
- (setq begin (cdr begin)))
- (setq cl-seq begin)
- (while (cddr cl-seq)
- (if (memq (cadr cl-seq) (cddr cl-seq))
- (setcdr (cdr cl-seq) (cddr cl-seq)))
- (setq cl-seq (cdr cl-seq)))
- begin))
- ((or (plists-equal cl-keys '(:test 'eq :from-end t) t)
- (plists-equal cl-keys '(:test #'eq :from-end t) t))
- `(let* ((begin ,cl-seq)
- (cl-seq begin))
- (while cl-seq
- (setq cl-seq (setcdr cl-seq
- (delq (car cl-seq) (cdr cl-seq)))))
- begin))
- ((or (plists-equal cl-keys '(:test 'equal) t)
- (plists-equal cl-keys '(:test #'equal) t))
- `(let* ((begin ,cl-seq)
- cl-seq)
- (while (member (car begin) (cdr begin))
- (setq begin (cdr begin)))
- (setq cl-seq begin)
- (while (cddr cl-seq)
- (if (member (cadr cl-seq) (cddr cl-seq))
- (setcdr (cdr cl-seq) (cddr cl-seq)))
- (setq cl-seq (cdr cl-seq)))
- begin))
- ((or (plists-equal cl-keys '(:test 'equal :from-end t) t)
- (plists-equal cl-keys '(:test #'equal :from-end t) t))
- `(let* ((begin ,cl-seq)
- (cl-seq begin))
- (while cl-seq
- (setq cl-seq (setcdr cl-seq (delete (car cl-seq)
- (cdr cl-seq)))))
- begin))
- (t form))))
+(define-compiler-macro delete-duplicates (&whole form &rest cl-keys)
+ (let ((cl-seq (if cl-keys (pop cl-keys))))
+ (if (or
+ (not (or (memq (car-safe cl-seq)
+ ;; No need to check for a list at runtime with
+ ;; these. We could expand the list, but these are all
+ ;; the functions in the relevant context at the moment.
+ '(nreverse append nconc mapcan mapcar string-to-list))
+ (and (listp cl-seq) (equal (butlast cl-seq) '(the list)))))
+ ;; Wrong number of arguments.
+ (not (cdr form)))
+ form
+ (cond
+ ((or (plists-equal cl-keys '(:test 'eq) t)
+ (plists-equal cl-keys '(:test #'eq) t))
+ `(let* ((begin ,cl-seq)
+ cl-seq)
+ (while (memq (car begin) (cdr begin))
+ (setq begin (cdr begin)))
+ (setq cl-seq begin)
+ (while (cddr cl-seq)
+ (if (memq (cadr cl-seq) (cddr cl-seq))
+ (setcdr (cdr cl-seq) (cddr cl-seq)))
+ (setq cl-seq (cdr cl-seq)))
+ begin))
+ ((or (plists-equal cl-keys '(:test 'eq :from-end t) t)
+ (plists-equal cl-keys '(:test #'eq :from-end t) t))
+ `(let* ((begin ,cl-seq)
+ (cl-seq begin))
+ (while cl-seq
+ (setq cl-seq (setcdr cl-seq
+ (delq (car cl-seq) (cdr cl-seq)))))
+ begin))
+ ((or (plists-equal cl-keys '(:test 'equal) t)
+ (plists-equal cl-keys '(:test #'equal) t))
+ `(let* ((begin ,cl-seq)
+ cl-seq)
+ (while (member (car begin) (cdr begin))
+ (setq begin (cdr begin)))
+ (setq cl-seq begin)
+ (while (cddr cl-seq)
+ (if (member (cadr cl-seq) (cddr cl-seq))
+ (setcdr (cdr cl-seq) (cddr cl-seq)))
+ (setq cl-seq (cdr cl-seq)))
+ begin))
+ ((or (plists-equal cl-keys '(:test 'equal :from-end t) t)
+ (plists-equal cl-keys '(:test #'equal :from-end t) t))
+ `(let* ((begin ,cl-seq)
+ (cl-seq begin))
+ (while cl-seq
+ (setq cl-seq (setcdr cl-seq (delete (car cl-seq)
+ (cdr cl-seq)))))
+ begin))
+ (t form)))))
;; XEmacs; it's perfectly reasonable, and often much clearer to those
;; reading the code, to call regexp-quote on a constant string, which is
--
“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
[COMMIT] #'cl-safe-expr-p, forms that start with the symbol lambda are also safe.
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293666828 0
# Node ID 9ac28212c75a3d96011a7ac7614dcddc261be3c3
# Parent 2a7b6ddb80637cc139c0cf301aacd3fd40bd4943
#'cl-safe-expr-p, forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
diff -r 2a7b6ddb8063 -r 9ac28212c75a lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:51:08 2010 +0000
+++ b/lisp/ChangeLog Wed Dec 29 23:53:48 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (cl-safe-expr-p):
+ Forms that start with the symbol lambda are also safe.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (= < > <= >=):
diff -r 2a7b6ddb8063 -r 9ac28212c75a lisp/cl-macs.el
--- a/lisp/cl-macs.el Wed Dec 29 23:51:08 2010 +0000
+++ b/lisp/cl-macs.el Wed Dec 29 23:53:48 2010 +0000
＠＠ -111,7 +111,8 ＠＠
;;; Check if no side effects.
(defun cl-safe-expr-p (x)
- (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
+ (or (not (and (consp x) (not (memq (car x)
+ '(quote function function* lambda)))))
(and (symbolp (car x))
(or (memq (car x) cl-simple-funcs)
(memq (car x) cl-safe-funcs)
--
“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
[COMMIT] #'float: if handed a bigfloat, give the same bigfloat back.
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293666668 0
# Node ID 2a7b6ddb80637cc139c0cf301aacd3fd40bd4943
# Parent 596011a8bf8f3213e57c83b56f3cffe3d237e043
#'float: if handed a bigfloat, give the same bigfloat back.
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* floatfns.c (Ffloat): If we've been handed a bigfloat here, it's
appropriate to give the same bigfloat back.
diff -r 596011a8bf8f -r 2a7b6ddb8063 src/ChangeLog
--- a/src/ChangeLog Wed Dec 29 23:47:30 2010 +0000
+++ b/src/ChangeLog Wed Dec 29 23:51:08 2010 +0000
＠＠ -1,3 +1,8 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * floatfns.c (Ffloat): If we've been handed a bigfloat here, it's
+ appropriate to give the same bigfloat back.
+
2010-11-30 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Ffill):
diff -r 596011a8bf8f -r 2a7b6ddb8063 src/floatfns.c
--- a/src/floatfns.c Wed Dec 29 23:47:30 2010 +0000
+++ b/src/floatfns.c Wed Dec 29 23:51:08 2010 +0000
＠＠ -789,6 +789,11 ＠＠
if (FLOATP (number)) /* give 'em the same float back */
return number;
+ if (BIGFLOATP (number))
+ {
+ return number;
+ }
+
return Ffloat (wrong_type_argument (Qnumberp, number));
}
--
“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
[COMMIT] = < > <= >=: it's OK to use the compiler macro when first, last args side effect
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293666450 0
# Node ID 596011a8bf8f3213e57c83b56f3cffe3d237e043
# Parent 5ed261fd2bd96afdcdd4a8e25802213ab9e79c0a
= < > <= >=: it's OK to use the compiler macro when first, last args side effect
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
diff -r 5ed261fd2bd9 -r 596011a8bf8f lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:43:10 2010 +0000
+++ b/lisp/ChangeLog Wed Dec 29 23:47:30 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (= < > <= >=):
+ For these functions' compiler macros, the optimisation is safe
+ even if the first and the last arguments have side effects, since
+ they're only used the once.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
diff -r 5ed261fd2bd9 -r 596011a8bf8f lisp/cl-macs.el
--- a/lisp/cl-macs.el Wed Dec 29 23:43:10 2010 +0000
+++ b/lisp/cl-macs.el Wed Dec 29 23:47:30 2010 +0000
＠＠ -3752,7 +3752,7 ＠＠
(put function 'cl-compiler-macro
#'(lambda (form &rest arguments)
(if (or (null (nthcdr 3 form))
- (notevery #'cl-safe-expr-p (cdr form)))
+ (notevery #'cl-safe-expr-p (butlast (cdr arguments))))
form
(cons 'and (mapcon
#'(lambda (rest)
--
“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
[COMMIT] Unroll a load-time loop at macro expansion time, cl-macs.el
14 years
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1293666190 0
# Node ID 5ed261fd2bd96afdcdd4a8e25802213ab9e79c0a
# Parent f6471e4ae703ecb5f712c9dfcaabdc2a15f3bd65
Unrool a load-time loop at macro expansion time, cl-macs.el
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
diff -r f6471e4ae703 -r 5ed261fd2bd9 lisp/ChangeLog
--- a/lisp/ChangeLog Wed Dec 29 23:38:38 2010 +0000
+++ b/lisp/ChangeLog Wed Dec 29 23:43:10 2010 +0000
＠＠ -1,3 +1,10 ＠＠
+2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (inline-side-effect-free-compiler-macros):
+ Unroll a loop here at macro-expansion time, so these compiler
+ macros are compiled. Use #'eql instead of #'eq in a couple of
+ places for better style.
+
2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
diff -r f6471e4ae703 -r 5ed261fd2bd9 lisp/cl-macs.el
--- a/lisp/cl-macs.el Wed Dec 29 23:38:38 2010 +0000
+++ b/lisp/cl-macs.el Wed Dec 29 23:43:10 2010 +0000
＠＠ -3762,22 +3762,28 ＠＠
(cdr form)))))))
'(= < > <= >=))
-(mapc
- #'(lambda (y)
- (put (car y) 'side-effect-free t)
- (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
- (put (car y) 'cl-compiler-macro
- (list 'lambda '(w x)
- (if (symbolp (cadr y))
- (list 'list (list 'quote (cadr y))
- (list 'list (list 'quote (caddr y)) 'x))
- (cons 'list (cdr y))))))
- '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
+;; XEmacs; unroll this loop at macro-expansion time, so the compiler macros
+;; are byte-compiled.
+(macrolet
+ ((inline-side-effect-free-compiler-macros (&rest details)
+ (cons
+ 'progn
+ (loop
+ for (function . details) in details
+ nconc `((put ',function 'side-effect-free t)
+ (define-compiler-macro ,function (&whole form x)
+ ,(if (symbolp (car details))
+ (reduce #'(lambda (object1 object2)
+ `(list ',object1 ,object2))
+ details :from-end t :initial-value 'x)
+ (cons 'list details))))))))
+ (inline-side-effect-free-compiler-macros
+ (first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
(fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
(eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
(rest 'cdr x) (plusp '> x 0) (minusp '< x 0)
- (oddp 'eq (list 'logand x 1) 1)
- (evenp 'eq (list 'logand x 1) 0)
+ (oddp 'eql (list 'logand x 1) 1)
+ (evenp 'eql (list 'logand x 1) 0)
(caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr)
(caaar car caar) (caadr car cadr) (cadar car cdar)
(caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
--
“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