Mercurial > hg > xemacs-beta
changeset 5084:6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
lisp/ChangeLog addition:
2010-03-01 Aidan Kehoe <kehoea@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@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.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 01 Mar 2010 21:05:33 +0000 |
| parents | 88f955fa5a7f |
| children | 1ee30d3f9dd0 |
| 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 |
| diffstat | 9 files changed, 208 insertions(+), 27 deletions(-) [+] |
line wrap: on
line diff
--- 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@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@parhasard.net> Back out Ben's revision c673987f5f3d.
--- 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))
--- 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))))
--- 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@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@parhasard.net> * file-coding.c (Fmake_coding_system_internal):
--- 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);
--- 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; - - while (i + 1 < nargs) - { - Lisp_Object keyword = args[i++]; - Lisp_Object value = args[i++]; +#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); - 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)) + { + 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);
--- 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 */ /************************************************************************/ @@ -3050,6 +3073,12 @@ } DOESNT_RETURN +invalid_keyword_argument (Lisp_Object function, Lisp_Object keyword) +{ + signal_error_1 (Qinvalid_keyword_argument, list2 (function, keyword)); +} + +DOESNT_RETURN invalid_constant (const Ascbyte *reason, Lisp_Object frob) { signal_error (Qinvalid_constant, reason, frob);
--- 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);
--- 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,