From 0a49f158f1598fb92989f3cbdc238a7e5f1bd8a3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 22 Jan 2017 00:18:40 -0800 Subject: [PATCH] Improve uses of CHECK_LIST etc. MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit * src/eval.c (FletX): Report an error for invalid constructs like ‘(let* (a . 0))’, so that ‘let*’ is more consistent with ‘let’. (lambda_arity): Use plain CHECK_CONS. * src/fns.c (CHECK_LIST_END): Move from here to lisp.h. (Fcopy_alist): Remove unnecessary CHECK_LIST call, since concat does that for us. (Fnthcdr, Fmember, Fmemql, Fdelete, Fnreverse): Use CHECK_LIST_END, not CHECK_LIST_CONS. This hoists a runtime check out of the loop. (Fmemq): Simplify and use CHECK_LIST_END instead of CHECK_LIST. (Fassq, Fassoc, Frassq, Frassoc): Simplify and use CHECK_LIST_END instead of CAR. (assq_no_quit, assoc_no_quit): Simplify and assume proper list. (Fnconc): Use plain CHECK_CONS, and do-while instead of while loop. * src/fontset.c (Fnew_fontset): * src/frame.c (Fmodify_frame_parameters): Use CHECK_LIST_END at end, rather than CHECK_LIST at start, for a more-complete check. * src/gfilenotify.c (Fgfile_add_watch): Omit unnecessary CHECK_LIST, since Fmember does that for us. * src/lisp.h (lisp_h_CHECK_LIST_CONS, CHECK_LIST_CONS): Remove; no longer used. (CHECK_LIST_END): New inline function. --- src/eval.c | 9 +- src/fns.c | 248 +++++++++++++++------------------------------- src/fontset.c | 8 +- src/frame.c | 5 +- src/gfilenotify.c | 8 +- src/lisp.h | 6 +- 6 files changed, 94 insertions(+), 190 deletions(-) diff --git a/src/eval.c b/src/eval.c index c05c8d8f8de..01e3db44082 100644 --- a/src/eval.c +++ b/src/eval.c @@ -856,9 +856,7 @@ usage: (let* VARLIST BODY...) */) lexenv = Vinternal_interpreter_environment; - varlist = XCAR (args); - CHECK_LIST (varlist); - while (CONSP (varlist)) + for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist)) { QUIT; @@ -894,9 +892,8 @@ usage: (let* VARLIST BODY...) */) } else specbind (var, val); - - varlist = XCDR (varlist); } + CHECK_LIST_END (varlist, XCAR (args)); val = Fprogn (XCDR (args)); return unbind_to (count, val); @@ -3098,7 +3095,7 @@ lambda_arity (Lisp_Object fun) if (EQ (XCAR (fun), Qclosure)) { fun = XCDR (fun); /* Drop `closure'. */ - CHECK_LIST_CONS (fun, fun); + CHECK_CONS (fun); } syms_left = XCDR (fun); if (CONSP (syms_left)) diff --git a/src/fns.c b/src/fns.c index 00fa65886f0..c65a731f325 100644 --- a/src/fns.c +++ b/src/fns.c @@ -89,12 +89,6 @@ enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; /* Random data-structure functions. */ -static void -CHECK_LIST_END (Lisp_Object x, Lisp_Object y) -{ - CHECK_TYPE (NILP (x), Qlistp, y); -} - DEFUN ("length", Flength, Slength, 1, 1, 0, doc: /* Return the length of vector, list or string SEQUENCE. A byte-code function object is also allowed. @@ -1202,17 +1196,12 @@ are shared, however. Elements of ALIST that are not conses are also shared. */) (Lisp_Object alist) { - register Lisp_Object tem; - - CHECK_LIST (alist); if (NILP (alist)) return alist; - alist = concat (1, &alist, Lisp_Cons, 0); - for (tem = alist; CONSP (tem); tem = XCDR (tem)) + alist = concat (1, &alist, Lisp_Cons, false); + for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem)) { - register Lisp_Object car; - car = XCAR (tem); - + Lisp_Object car = XCAR (tem); if (CONSP (car)) XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); } @@ -1356,16 +1345,20 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, doc: /* Take cdr N times on LIST, return the result. */) (Lisp_Object n, Lisp_Object list) { - EMACS_INT i, num; CHECK_NUMBER (n); - num = XINT (n); - for (i = 0; i < num && !NILP (list); i++) + EMACS_INT num = XINT (n); + Lisp_Object tail = list; + for (EMACS_INT i = 0; i < num; i++) { + if (! CONSP (tail)) + { + CHECK_LIST_END (tail, list); + return Qnil; + } + tail = XCDR (tail); QUIT; - CHECK_LIST_CONS (list, list); - list = XCDR (list); } - return list; + return tail; } DEFUN ("nth", Fnth, Snth, 2, 2, 0, @@ -1392,66 +1385,52 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, DEFUN ("member", Fmember, Smember, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. The value is actually the tail of LIST whose car is ELT. */) - (register Lisp_Object elt, Lisp_Object list) + (Lisp_Object elt, Lisp_Object list) { - register Lisp_Object tail; - for (tail = list; !NILP (tail); tail = XCDR (tail)) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - register Lisp_Object tem; - CHECK_LIST_CONS (tail, list); - tem = XCAR (tail); - if (! NILP (Fequal (elt, tem))) + if (! NILP (Fequal (elt, XCAR (tail)))) return tail; QUIT; } + CHECK_LIST_END (tail, list); return Qnil; } DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT. */) - (register Lisp_Object elt, Lisp_Object list) + (Lisp_Object elt, Lisp_Object list) { - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) || EQ (XCAR (list), elt)) - break; - - list = XCDR (list); - if (!CONSP (list) || EQ (XCAR (list), elt)) - break; - - list = XCDR (list); - if (!CONSP (list) || EQ (XCAR (list), elt)) - break; - - list = XCDR (list); + if (EQ (XCAR (tail), elt)) + return tail; QUIT; } - - CHECK_LIST (list); - return list; + CHECK_LIST_END (tail, list); + return Qnil; } DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. The value is actually the tail of LIST whose car is ELT. */) - (register Lisp_Object elt, Lisp_Object list) + (Lisp_Object elt, Lisp_Object list) { - register Lisp_Object tail; - if (!FLOATP (elt)) return Fmemq (elt, list); - for (tail = list; !NILP (tail); tail = XCDR (tail)) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - register Lisp_Object tem; - CHECK_LIST_CONS (tail, list); - tem = XCAR (tail); + Lisp_Object tem = XCAR (tail); if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) return tail; QUIT; } + CHECK_LIST_END (tail, list); return Qnil; } @@ -1461,44 +1440,27 @@ The value is actually the first element of LIST whose car is KEY. Elements of LIST that are not conses are ignored. */) (Lisp_Object key, Lisp_Object list) { - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCAR (XCAR (list)), key))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCAR (XCAR (list)), key))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCAR (XCAR (list)), key))) - break; - - list = XCDR (list); + if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) + return XCAR (tail); QUIT; } - - return CAR (list); + CHECK_LIST_END (tail, list); + return Qnil; } /* Like Fassq but never report an error and do not allow quits. - Use only on lists known never to be circular. */ + Use only on objects known to be non-circular lists. */ Lisp_Object assq_no_quit (Lisp_Object key, Lisp_Object list) { - while (CONSP (list) - && (!CONSP (XCAR (list)) - || !EQ (XCAR (XCAR (list)), key))) - list = XCDR (list); - - return CAR_SAFE (list); + for (; ! NILP (list); list = XCDR (list)) + if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key)) + return XCAR (list); + return Qnil; } DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, @@ -1506,81 +1468,49 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, The value is actually the first element of LIST whose car equals KEY. */) (Lisp_Object key, Lisp_Object list) { - Lisp_Object car; - - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (car = XCAR (XCAR (list)), - EQ (car, key) || !NILP (Fequal (car, key))))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (car = XCAR (XCAR (list)), - EQ (car, key) || !NILP (Fequal (car, key))))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (car = XCAR (XCAR (list)), - EQ (car, key) || !NILP (Fequal (car, key))))) - break; - - list = XCDR (list); + Lisp_Object car = XCAR (tail); + if (CONSP (car) + && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) + return car; QUIT; } - - return CAR (list); + CHECK_LIST_END (tail, list); + return Qnil; } /* Like Fassoc but never report an error and do not allow quits. - Use only on lists known never to be circular. */ + Use only on objects known to be non-circular lists. */ Lisp_Object assoc_no_quit (Lisp_Object key, Lisp_Object list) { - while (CONSP (list) - && (!CONSP (XCAR (list)) - || (!EQ (XCAR (XCAR (list)), key) - && NILP (Fequal (XCAR (XCAR (list)), key))))) - list = XCDR (list); - - return CONSP (list) ? XCAR (list) : Qnil; + for (; ! NILP (list); list = XCDR (list)) + { + Lisp_Object car = XCAR (list); + if (CONSP (car) + && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) + return car; + } + return Qnil; } DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. The value is actually the first element of LIST whose cdr is KEY. */) - (register Lisp_Object key, Lisp_Object list) + (Lisp_Object key, Lisp_Object list) { - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCDR (XCAR (list)), key))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCDR (XCAR (list)), key))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCDR (XCAR (list)), key))) - break; - - list = XCDR (list); + if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) + return XCAR (tail); QUIT; } - - return CAR (list); + CHECK_LIST_END (tail, list); + return Qnil; } DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, @@ -1588,35 +1518,17 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, The value is actually the first element of LIST whose cdr equals KEY. */) (Lisp_Object key, Lisp_Object list) { - Lisp_Object cdr; - - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (cdr = XCDR (XCAR (list)), - EQ (cdr, key) || !NILP (Fequal (cdr, key))))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (cdr = XCDR (XCAR (list)), - EQ (cdr, key) || !NILP (Fequal (cdr, key))))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (cdr = XCDR (XCAR (list)), - EQ (cdr, key) || !NILP (Fequal (cdr, key))))) - break; - - list = XCDR (list); + Lisp_Object car = XCAR (tail); + if (CONSP (car) + && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) + return car; QUIT; } - - return CAR (list); + CHECK_LIST_END (tail, list); + return Qnil; } DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, @@ -1756,10 +1668,8 @@ changing the value of a sequence `foo'. */) { Lisp_Object tail, prev; - for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) + for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail)) { - CHECK_LIST_CONS (tail, seq); - if (!NILP (Fequal (elt, XCAR (tail)))) { if (NILP (prev)) @@ -1771,6 +1681,7 @@ changing the value of a sequence `foo'. */) prev = tail; QUIT; } + CHECK_LIST_END (tail, seq); } return seq; @@ -1790,14 +1701,14 @@ This function may destructively modify SEQ to produce the value. */) { Lisp_Object prev, tail, next; - for (prev = Qnil, tail = seq; !NILP (tail); tail = next) + for (prev = Qnil, tail = seq; CONSP (tail); tail = next) { QUIT; - CHECK_LIST_CONS (tail, tail); next = XCDR (tail); Fsetcdr (tail, prev); prev = tail; } + CHECK_LIST_END (tail, seq); seq = prev; } else if (VECTORP (seq)) @@ -2498,14 +2409,15 @@ usage: (nconc &rest LISTS) */) if (argnum + 1 == nargs) break; - CHECK_LIST_CONS (tem, tem); + CHECK_CONS (tem); - while (CONSP (tem)) + do { tail = tem; tem = XCDR (tail); QUIT; } + while (CONSP (tem)); tem = args[argnum + 1]; Fsetcdr (tail, tem); diff --git a/src/fontset.c b/src/fontset.c index 33d1d24e5b3..850558b08a0 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1677,11 +1677,10 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of `set-fontset-font' for the meaning. */) (Lisp_Object name, Lisp_Object fontlist) { - Lisp_Object fontset; + Lisp_Object fontset, tail; int id; CHECK_STRING (name); - CHECK_LIST (fontlist); name = Fdowncase (name); id = fs_query_fontset (name, 0); @@ -1714,11 +1713,11 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of Fset_char_table_range (fontset, Qt, Qnil); } - for (; CONSP (fontlist); fontlist = XCDR (fontlist)) + for (tail = fontlist; CONSP (tail); tail = XCDR (tail)) { Lisp_Object elt, script; - elt = XCAR (fontlist); + elt = XCAR (tail); script = Fcar (elt); elt = Fcdr (elt); if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt)))) @@ -1727,6 +1726,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of else Fset_fontset_font (name, script, elt, Qnil, Qappend); } + CHECK_LIST_END (tail, fontlist); return name; } diff --git a/src/frame.c b/src/frame.c index 2c2c1e150d4..d0f653fc762 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2691,9 +2691,7 @@ list, but are otherwise ignored. */) (Lisp_Object frame, Lisp_Object alist) { struct frame *f = decode_live_frame (frame); - register Lisp_Object prop, val; - - CHECK_LIST (alist); + Lisp_Object prop, val; /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM @@ -3142,6 +3140,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail)) size++; + CHECK_LIST_END (tail, alist); USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (parms, 2 * size); diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 6ec5c642825..285a253733d 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -178,20 +178,18 @@ will be reported only in case of the `moved' event. */) if (NILP (Ffile_exists_p (file))) report_file_error ("File does not exist", file); - CHECK_LIST (flags); - if (!FUNCTIONP (callback)) wrong_type_argument (Qinvalid_function, callback); - /* Create GFile name. */ - gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file))); - /* Assemble flags. */ if (!NILP (Fmember (Qwatch_mounts, flags))) gflags |= G_FILE_MONITOR_WATCH_MOUNTS; if (!NILP (Fmember (Qsend_moved, flags))) gflags |= G_FILE_MONITOR_SEND_MOVED; + /* Create GFile name. */ + gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file))); + /* Enable watch. */ monitor = g_file_monitor (gfile, gflags, NULL, &gerror); g_object_unref (gfile); diff --git a/src/lisp.h b/src/lisp.h index e7747563085..7e918249935 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -310,7 +310,6 @@ error !; # define lisp_h_XLI(o) (o) # define lisp_h_XIL(i) (i) #endif -#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ @@ -367,7 +366,6 @@ error !; #if DEFINE_KEY_OPS_AS_MACROS # define XLI(o) lisp_h_XLI (o) # define XIL(i) lisp_h_XIL (i) -# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y) # define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) @@ -2751,9 +2749,9 @@ CHECK_LIST (Lisp_Object x) } INLINE void -(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) +CHECK_LIST_END (Lisp_Object x, Lisp_Object y) { - lisp_h_CHECK_LIST_CONS (x, y); + CHECK_TYPE (NILP (x), Qlistp, y); } INLINE void -- 2.39.2