carbon2-commit: Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe
kehoea at parhasard.net
Fri Mar 5 12:48:15 EST 2010
changeset: 5134:6afe991b8135
user: Aidan Kehoe <kehoea at parhasard.net>
date: Mon Mar 01 21:05:33 2010 +0000
files: lisp/ChangeLog lisp/cl-macs.el lisp/cl-seq.el src/ChangeLog src/data.c src/elhash.c src/eval.c src/general-slots.h src/lisp.h
description:
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
lisp/ChangeLog addition:
2010-03-01 Aidan Kehoe <kehoea at parhasard.net>
* cl-seq.el (cl-parsing-keywords):
* cl-macs.el (cl-do-arglist):
Use the new invalid-keyword-argument error here.
src/ChangeLog addition:
2010-03-01 Aidan Kehoe <kehoea at parhasard.net>
* lisp.h (PARSE_KEYWORDS): New macro, for parsing keyword
arguments from C subrs.
* elhash.c (Fmake_hash_table): Use it.
* general-slots.h (Q_allow_other_keys): Add this symbol.
* eval.c (non_nil_allow_other_keys_p):
(invalid_keyword_argument):
New functions, called from the keyword argument parsing code.
* data.c (init_errors_once_early):
Add the new invalid-keyword-argument error here.
diff -r 88f955fa5a7f -r 6afe991b8135 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Feb 26 15:52:24 2010 +0000
+++ b/lisp/ChangeLog Mon Mar 01 21:05:33 2010 +0000
@@ -1,3 +1,9 @@
+2010-03-01 Aidan Kehoe <kehoea at parhasard.net>
+
+ * cl-seq.el (cl-parsing-keywords):
+ * cl-macs.el (cl-do-arglist):
+ Use the new invalid-keyword-argument error here.
+
2010-02-26 Aidan Kehoe <kehoea at parhasard.net>
Back out Ben's revision c673987f5f3d.
diff -r 88f955fa5a7f -r 6afe991b8135 lisp/cl-macs.el
--- a/lisp/cl-macs.el Fri Feb 26 15:52:24 2010 +0000
+++ b/lisp/cl-macs.el Mon Mar 01 21:05:33 2010 +0000
@@ -494,8 +494,7 @@
(list t
(list
'error
- (format "Keyword argument %%s not one of %s"
- keys)
+ ''invalid-keyword-argument
(list 'car var)))))))
(push (list 'let (list (list var restarg)) check) bind-forms)))
(while (and (eq (car args) '&aux) (pop args))
diff -r 88f955fa5a7f -r 6afe991b8135 lisp/cl-seq.el
--- a/lisp/cl-seq.el Fri Feb 26 15:52:24 2010 +0000
+++ b/lisp/cl-seq.el Mon Mar 01 21:05:33 2010 +0000
@@ -107,7 +107,7 @@
other-keys))))
'(car (cdr (memq (quote :allow-other-keys)
cl-keys)))
- '(error "Bad keyword argument %s"
+ '(error 'invalid-keyword-argument
(car cl-keys-temp)))
'(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
body))))
diff -r 88f955fa5a7f -r 6afe991b8135 src/ChangeLog
--- a/src/ChangeLog Fri Feb 26 15:52:24 2010 +0000
+++ b/src/ChangeLog Mon Mar 01 21:05:33 2010 +0000
@@ -1,3 +1,15 @@
+2010-03-01 Aidan Kehoe <kehoea at parhasard.net>
+
+ * lisp.h (PARSE_KEYWORDS): New macro, for parsing keyword
+ arguments from C subrs.
+ * elhash.c (Fmake_hash_table): Use it.
+ * general-slots.h (Q_allow_other_keys): Add this symbol.
+ * eval.c (non_nil_allow_other_keys_p):
+ (invalid_keyword_argument):
+ New functions, called from the keyword argument parsing code.
+ * data.c (init_errors_once_early):
+ Add the new invalid-keyword-argument error here.
+
2010-02-26 Aidan Kehoe <kehoea at parhasard.net>
* file-coding.c (Fmake_coding_system_internal):
diff -r 88f955fa5a7f -r 6afe991b8135 src/data.c
--- a/src/data.c Fri Feb 26 15:52:24 2010 +0000
+++ b/src/data.c Mon Mar 01 21:05:33 2010 +0000
@@ -41,7 +41,8 @@
Lisp_Object Qcircular_list, Qcircular_property_list;
Lisp_Object Qinvalid_argument, Qinvalid_constant, Qwrong_type_argument;
Lisp_Object Qargs_out_of_range;
-Lisp_Object Qwrong_number_of_arguments, Qinvalid_function, Qno_catch;
+Lisp_Object Qwrong_number_of_arguments, Qinvalid_function;
+Lisp_Object Qinvalid_keyword_argument, Qno_catch;
Lisp_Object Qinternal_error, Qinvalid_state, Qstack_overflow, Qout_of_memory;
Lisp_Object Qvoid_variable, Qcyclic_variable_indirection;
Lisp_Object Qvoid_function, Qcyclic_function_indirection;
@@ -3472,6 +3473,7 @@
DEFERROR_STANDARD (Qwrong_number_of_arguments, Qinvalid_argument);
DEFERROR_STANDARD (Qinvalid_function, Qinvalid_argument);
DEFERROR_STANDARD (Qinvalid_constant, Qinvalid_argument);
+ DEFERROR_STANDARD (Qinvalid_keyword_argument, Qinvalid_argument);
DEFERROR (Qno_catch, "No catch for tag", Qinvalid_argument);
DEFERROR_STANDARD (Qinvalid_state, Qerror);
diff -r 88f955fa5a7f -r 6afe991b8135 src/elhash.c
--- a/src/elhash.c Fri Feb 26 15:52:24 2010 +0000
+++ b/src/elhash.c Mon Mar 01 21:05:33 2010 +0000
@@ -84,7 +84,7 @@
#include "opaque.h"
Lisp_Object Qhash_tablep;
-static Lisp_Object Qhashtable, Qhash_table;
+static Lisp_Object Qhashtable, Qhash_table, Qmake_hash_table;
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;
@@ -993,29 +993,27 @@
*/
(int nargs, Lisp_Object *args))
{
- int i = 0;
- Lisp_Object test = Qnil;
- Lisp_Object size = Qnil;
- Lisp_Object rehash_size = Qnil;
- Lisp_Object rehash_threshold = Qnil;
- Lisp_Object weakness = Qnil;
+#ifdef NO_NEED_TO_HANDLE_21_4_CODE
+ PARSE_KEYWORDS (Qmake_hash_table, nargs, args, 0, 5,
+ (test, size, rehash_size, rehash_threshold, weakness),
+ NULL, weakness = Qunbound), 0);
+#else
+ PARSE_KEYWORDS (Qmake_hash_table, nargs, args, 0, 6,
+ (test, size, rehash_size, rehash_threshold, weakness,
+ type), (type = Qunbound, weakness = Qunbound), 0);
- while (i + 1 < nargs)
+ if (EQ (weakness, Qunbound))
{
- Lisp_Object keyword = args[i++];
- Lisp_Object value = args[i++];
-
- if (EQ (keyword, Q_test)) test = value;
- else if (EQ (keyword, Q_size)) size = value;
- else if (EQ (keyword, Q_rehash_size)) rehash_size = value;
- else if (EQ (keyword, Q_rehash_threshold)) rehash_threshold = value;
- else if (EQ (keyword, Q_weakness)) weakness = value;
- else if (EQ (keyword, Q_type))/*obsolete*/ weakness = value;
- else invalid_constant ("Invalid hash table property keyword", keyword);
+ if (EQ (weakness, Qunbound) && !EQ (type, Qunbound))
+ {
+ weakness = type;
+ }
+ else
+ {
+ weakness = Qnil;
+ }
}
-
- if (i < nargs)
- sferror ("Hash table property requires a value", args[i]);
+#endif
#define VALIDATE_VAR(var) \
if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME);
@@ -1854,6 +1852,7 @@
DEFSYMBOL_MULTIWORD_PREDICATE (Qhash_tablep);
DEFSYMBOL (Qhash_table);
DEFSYMBOL (Qhashtable);
+ DEFSYMBOL (Qmake_hash_table);
DEFSYMBOL (Qweakness);
DEFSYMBOL (Qvalue);
DEFSYMBOL (Qkey_or_value);
diff -r 88f955fa5a7f -r 6afe991b8135 src/eval.c
--- a/src/eval.c Fri Feb 26 15:52:24 2010 +0000
+++ b/src/eval.c Mon Mar 01 21:05:33 2010 +0000
@@ -418,6 +418,29 @@
static Lisp_Object maybe_get_trapping_problems_backtrace (void);
+
+/* When parsing keyword arguments; is some element of NARGS
+:allow-other-keys, and is that element followed by a non-nil Lisp
+ object? */
+
+Boolint
+non_nil_allow_other_keys_p (Elemcount offset, int nargs, Lisp_Object *args)
+{
+ Lisp_Object key, value;
+ while (offset + 1 < nargs)
+ {
+ key = args[offset++];
+ value = args[offset++];
+ if (EQ (key, Q_allow_other_keys))
+ {
+ /* The ANSI Common Lisp standard says the first value for a given
+ keyword overrides. */
+ return !NILP (value);
+ }
+ }
+ return 0;
+}
+
/************************************************************************/
/* The subr object type */
/************************************************************************/
@@ -3047,6 +3070,12 @@
Lisp_Object class_, Error_Behavior errb)
{
maybe_signal_error (Qinvalid_argument, reason, frob, class_, errb);
+}
+
+DOESNT_RETURN
+invalid_keyword_argument (Lisp_Object function, Lisp_Object keyword)
+{
+ signal_error_1 (Qinvalid_keyword_argument, list2 (function, keyword));
}
DOESNT_RETURN
diff -r 88f955fa5a7f -r 6afe991b8135 src/general-slots.h
--- a/src/general-slots.h Fri Feb 26 15:52:24 2010 +0000
+++ b/src/general-slots.h Mon Mar 01 21:05:33 2010 +0000
@@ -49,6 +49,7 @@
SYMBOL (Qactually_requested);
SYMBOL (Qafter);
SYMBOL (Qall);
+SYMBOL_KEYWORD (Q_allow_other_keys);
SYMBOL (Qand);
SYMBOL (Qappend);
SYMBOL (Qascii);
diff -r 88f955fa5a7f -r 6afe991b8135 src/lisp.h
--- a/src/lisp.h Fri Feb 26 15:52:24 2010 +0000
+++ b/src/lisp.h Mon Mar 01 21:05:33 2010 +0000
@@ -4041,6 +4041,136 @@
while (NILP (Ffunctionp (fun))) \
signal_invalid_function_error (fun); \
} while (0)
+
+/************************************************************************/
+/* Parsing keyword arguments */
+/************************************************************************/
+
+/* 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.
+
+ 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.
+
+ KEYWORDS is a parenthesised list of those keywords, without the initial
+ Q_.
+
+ KEYWORD_DEFAULTS allows you to set non-nil defaults. Put (keywordname =
+ 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.
+
+ If you want to check whether a given keyword argument was set (as in the
+ SVAR argument to defun*), supply Qunbound as its default in
+ KEYWORD_DEFAULTS, and examine it once PARSE_KEYWORDS is done. Lisp code
+ cannot supply Qunbound as an argument, so if it is still Qunbound, it was
+ not set.
+
+ There is no elegant way with this macro to have one name for the keyword
+ 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) \
+ DECLARE_N_KEYWORDS_##keyword_count keywords; \
+ \
+ do \
+ { \
+ Lisp_Object pk_key, pk_value; \
+ Elemcount pk_i = nargs - 1; \
+ Boolint pk_allow_other_keys = allow_other_keys; \
+ \
+ if ((nargs - keywords_offset) & 1) \
+ { \
+ if (!allow_other_keys \
+ && !(pk_allow_other_keys \
+ = non_nil_allow_other_keys_p (keywords_offset, \
+ nargs, args))) \
+ { \
+ signal_wrong_number_of_arguments_error (function, nargs); \
+ } \
+ else \
+ { \
+ /* Ignore the trailing arg; so below always sees an even \
+ number of arguments. */ \
+ pk_i -= 1; \
+ } \
+ } \
+ \
+ (void)(keyword_defaults); \
+ \
+ /* Start from the end, because the leftmost element overrides. */ \
+ while (pk_i > keywords_offset) \
+ { \
+ pk_value = args[pk_i--]; \
+ pk_key = args[pk_i--]; \
+ \
+ if (0) {} \
+ CHECK_N_KEYWORDS_##keyword_count keywords \
+ else if (allow_other_keys || pk_allow_other_keys) \
+ { \
+ continue; \
+ } \
+ else if (!(pk_allow_other_keys \
+ = non_nil_allow_other_keys_p (keywords_offset, \
+ nargs, args))) \
+ { \
+ invalid_keyword_argument (function, pk_key); \
+ } \
+ } \
+ } while (0)
+
+#define DECLARE_N_KEYWORDS_1(a) \
+ Lisp_Object a = Qnil
+#define DECLARE_N_KEYWORDS_2(a,b) \
+ DECLARE_N_KEYWORDS_1(a), b = Qnil
+#define DECLARE_N_KEYWORDS_3(a,b,c) \
+ DECLARE_N_KEYWORDS_2(a,b), c = Qnil
+#define DECLARE_N_KEYWORDS_4(a,b,c,d) \
+ DECLARE_N_KEYWORDS_3(a,b,c), d = Qnil
+#define DECLARE_N_KEYWORDS_5(a,b,c,d,e) \
+ DECLARE_N_KEYWORDS_4(a,b,c,d), e = Qnil
+#define DECLARE_N_KEYWORDS_6(a,b,c,d,e,f) \
+ 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 CHECK_N_KEYWORDS_1(a) \
+ else if (EQ (pk_key, Q_##a)) { a = pk_value; }
+#define CHECK_N_KEYWORDS_2(a,b) CHECK_N_KEYWORDS_1(a) \
+ else if (EQ (pk_key, Q_##b)) { b = pk_value; }
+#define CHECK_N_KEYWORDS_3(a,b,c) CHECK_N_KEYWORDS_2(a,b) \
+ else if (EQ (pk_key, Q_##c)) { c = pk_value; }
+#define CHECK_N_KEYWORDS_4(a,b,c,d) CHECK_N_KEYWORDS_3(a,b,c) \
+ else if (EQ (pk_key, Q_##d)) { d = pk_value; }
+#define CHECK_N_KEYWORDS_5(a,b,c,d,e) CHECK_N_KEYWORDS_4(a,b,c,d) \
+ else if (EQ (pk_key, Q_##e)) { e = pk_value; }
+#define CHECK_N_KEYWORDS_6(a,b,c,d,e,f) CHECK_N_KEYWORDS_5(a,b,c,d,e) \
+ 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; }
+
+Boolint non_nil_allow_other_keys_p (Elemcount offset, int nargs,
+ Lisp_Object *args);
/************************************************************************/
@@ -4898,7 +5028,8 @@
Qcircular_list, Qcircular_property_list, Qconversion_error,
Qcyclic_variable_indirection, Qdomain_error, Qediting_error,
Qend_of_buffer, Qend_of_file, Qerror, Qfile_error, Qinternal_error,
- Qinvalid_change, Qinvalid_constant, Qinvalid_function, Qinvalid_operation,
+ Qinvalid_change, Qinvalid_constant, Qinvalid_function,
+ Qinvalid_keyword_argument, Qinvalid_operation,
Qinvalid_read_syntax, Qinvalid_state, Qio_error, Qlist_formation_error,
Qmalformed_list, Qmalformed_property_list, Qno_catch, Qout_of_memory,
Qoverflow_error, Qprinting_unreadable_object, Qquit, Qrange_error,
@@ -5126,6 +5257,8 @@
Lisp_Object frob2));
void maybe_invalid_argument (const Ascbyte *, Lisp_Object, Lisp_Object,
Error_Behavior);
+MODULE_API DECLARE_DOESNT_RETURN (invalid_keyword_argument (Lisp_Object fun,
+ Lisp_Object kw));
MODULE_API DECLARE_DOESNT_RETURN (invalid_operation (const Ascbyte *reason,
Lisp_Object frob));
MODULE_API DECLARE_DOESNT_RETURN (invalid_operation_2 (const Ascbyte *reason,
More information about the XEmacs-Patches
mailing list