Mercurial > hg > xemacs-beta
changeset 5253:b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
src/ChangeLog addition:
2010-09-01 Aidan Kehoe <kehoea@parhasard.net>
* fns.c (list_merge, list_array_merge_into_list)
(list_array_merge_into_array):
Avoid algorithmic complexity surprises when checking for
circularity in these functions.
(Freduce): Fix some formatting, in passing.
(mapcarX): Drop the SOME_OR_EVERY argument to this function;
instead, take CALLER, a symbol reflecting the Lisp-visible
function that called mapcarX(). Use CALLER with
mapping_interaction_error() when sequences are modified
illegally. Don't cons with #'some, #'every, not even a little.
(Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
(Fmap_into, Fsome, Fevery): Call mapcarX() with its new
arguments.
(Fmapcan): Don't unnecessarily complicate the nconc call.
(maplist): Take CALLER, a symbol reflecting the Lisp-visible
function that called maplist(), rather than having separate
arguments to indicate mapl vs. mapcon.
Avoid algorithmic complexity surprises when checking for
circularity. In #'mapcon, check a given stretch of
result for well-formedness once, which was not previously the
case, despite what the comments said.
(Fmaplist, Fmapl, Fmapcon):
Call maplist() with its new arguments.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Wed, 01 Sep 2010 12:51:32 +0100 |
parents | 378a34562cbe |
children | 1537701f08a1 |
files | src/ChangeLog src/fns.c |
diffstat | 2 files changed, 289 insertions(+), 238 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Mon Aug 30 15:23:42 2010 +0100 +++ b/src/ChangeLog Wed Sep 01 12:51:32 2010 +0100 @@ -1,3 +1,31 @@ +2010-09-01 Aidan Kehoe <kehoea@parhasard.net> + + * fns.c (list_merge, list_array_merge_into_list) + (list_array_merge_into_array): + Avoid algorithmic complexity surprises when checking for + circularity in these functions. + (Freduce): Fix some formatting, in passing. + + (mapcarX): Drop the SOME_OR_EVERY argument to this function; + instead, take CALLER, a symbol reflecting the Lisp-visible + function that called mapcarX(). Use CALLER with + mapping_interaction_error() when sequences are modified + illegally. Don't cons with #'some, #'every, not even a little. + (Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap) + (Fmap_into, Fsome, Fevery): Call mapcarX() with its new + arguments. + (Fmapcan): Don't unnecessarily complicate the nconc call. + + (maplist): Take CALLER, a symbol reflecting the Lisp-visible + function that called maplist(), rather than having separate + arguments to indicate mapl vs. mapcon. + Avoid algorithmic complexity surprises when checking for + circularity. In #'mapcon, check a given stretch of + result for well-formedness once, which was not previously the + case, despite what the comments said. + (Fmaplist, Fmapl, Fmapcon): + Call maplist() with its new arguments. + 2010-08-30 Aidan Kehoe <kehoea@parhasard.net> * floatfns.c (ceiling_one_mundane_arg, floor_one_mundane_arg)
--- a/src/fns.c Mon Aug 30 15:23:42 2010 +0100 +++ b/src/fns.c Wed Sep 01 12:51:32 2010 +0100 @@ -56,7 +56,9 @@ Lisp_Object Qstring_lessp, Qsort, Qmerge, Qfill; Lisp_Object Qidentity; -Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Qreduce, Q_from_end, Q_initial_value; +Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Q_from_end, Q_initial_value; +Lisp_Object Qmapconcat, QmapcarX, Qmapvector, Qmapcan, Qmapc, Qmap, Qmap_into; +Lisp_Object Qsome, Qevery, Qmaplist, Qmapl, Qmapcon, Qreduce; Lisp_Object Qbase64_conversion_error; @@ -2063,13 +2065,16 @@ Lisp_Object tail; Lisp_Object tem; Lisp_Object l1, l2; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Lisp_Object tortoises[2]; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; int looped = 0; l1 = org_l1; l2 = org_l2; tail = Qnil; value = Qnil; + tortoises[0] = org_l1; + tortoises[1] = org_l2; if (NULL == c_predicate) { @@ -2081,7 +2086,8 @@ When l1 and l2 are updated, we copy the new values back into the org_ vars. */ - GCPRO4 (org_l1, org_l2, predicate, value); + GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]); + gcpro5.nvars = 2; while (1) { @@ -2120,19 +2126,24 @@ Fsetcdr (tail, tem); tail = tem; - if (++looped % CIRCULAR_LIST_SUSPICION_LENGTH) continue; - - /* Just check the lists aren't circular:*/ - { - EXTERNAL_LIST_LOOP_1 (l1) - { - } - } - { - EXTERNAL_LIST_LOOP_1 (l2) - { - } - } + if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (looped & 1) + { + tortoises[0] = XCDR (tortoises[0]); + tortoises[1] = XCDR (tortoises[1]); + } + + if (EQ (org_l1, tortoises[0])) + { + signal_circular_list_error (org_l1); + } + + if (EQ (org_l2, tortoises[1])) + { + signal_circular_list_error (org_l2); + } + } } } @@ -2230,12 +2241,12 @@ Lisp_Object predicate, Lisp_Object key_func, Boolint reverse_order) { - Lisp_Object tail = Qnil, value = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object tail = Qnil, value = Qnil, tortoise = list; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; Elemcount array_index = 0; int looped = 0; - GCPRO3 (list, tail, value); + GCPRO4 (list, tail, value, tortoise); while (1) { @@ -2297,13 +2308,18 @@ ++array_index; } - if (++looped % CIRCULAR_LIST_SUSPICION_LENGTH) continue; - - { - EXTERNAL_LIST_LOOP_1 (list) - { - } - } + if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (looped & 1) + { + tortoise = XCDR (tortoise); + } + + if (EQ (list, tortoise)) + { + signal_circular_list_error (list); + } + } } } @@ -2377,7 +2393,7 @@ { if (array_len - array_index != output_len - output_index) { - invalid_state ("List length modified during merge", Qunbound); + mapping_interaction_error (Qmerge, list); } while (array_index < array_len) @@ -4105,35 +4121,34 @@ so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off mapcarX. - Otherwise, mapcarX signals a wrong-type-error if it encounters a - non-cons, non-array when traversing SEQUENCES. Common Lisp specifies in + Otherwise, mapcarX signals an invalid state error (see + mapping_interaction_error(), above) if it encounters a non-cons, + non-array when traversing SEQUENCES. Common Lisp specifies in MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION destructively modifies SEQUENCES in a way that might affect the ongoing traversal operation. - If SOME_OR_EVERY is SOME_OR_EVERY_SOME, return the (possibly multiple) - values given by FUNCTION the first time it is non-nil, and abandon the - iterations. LISP_VALS must be a cons, and the return value will be - stored in its car. If SOME_OR_EVERY is SOME_OR_EVERY_EVERY, store Qnil - in the car of LISP_VALS if FUNCTION gives nil; otherwise leave it - alone. */ - -#define SOME_OR_EVERY_NEITHER 0 -#define SOME_OR_EVERY_SOME 1 -#define SOME_OR_EVERY_EVERY 2 + CALLER is a symbol describing the Lisp-visible function that was called, + and any errors thrown because SEQUENCES was modified will reflect it. + + If CALLER is Qsome, return the (possibly multiple) values given by + FUNCTION the first time it is non-nil, and abandon the iterations. + LISP_VALS must be the result of calling STORE_VOID_IN_LISP on the address + of a Lisp object, and the return value will be stored at that address. + If CALLER is Qevery, LISP_VALS must also reflect a pointer to a Lisp + object, and Qnil will be stored at that address if FUNCTION gives nil; + otherwise it will be left alone. */ static void mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals, Lisp_Object function, int nsequences, Lisp_Object *sequences, - int some_or_every) + Lisp_Object caller) { Lisp_Object called, *args; struct gcpro gcpro1, gcpro2; int i, j; - enum lrecord_type lisp_vals_type; - - assert (LRECORDP (lisp_vals)); - lisp_vals_type = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type; + + assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1); args = alloca_array (Lisp_Object, nsequences + 1); args[0] = function; @@ -4177,12 +4192,21 @@ } else { + enum lrecord_type lisp_vals_type; Binbyte *sequence_types = alloca_array (Binbyte, nsequences); for (j = 0; j < nsequences; ++j) { sequence_types[j] = XRECORD_LHEADER (sequences[j])->type; } + if (!EQ (caller, Qsome) && !EQ (caller, Qevery)) + { + assert (LRECORDP (lisp_vals)); + lisp_vals_type + = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type; + assert (NILP (lisp_vals) || lisp_vals_type != lrecord_type_symbol); + } + for (i = 0; i < call_count; ++i) { for (j = 0; j < nsequences; ++j) @@ -4193,13 +4217,12 @@ { if (!CONSP (sequences[j])) { - /* This means FUNCTION has probably messed - around with a cons in one of the sequences, - since we checked the type - (CHECK_SEQUENCE()) and the length and + /* This means FUNCTION has messed around with a cons + in one of the sequences, since we checked the + type (CHECK_SEQUENCE()) and the length and structure (with Flength()) correctly in our callers. */ - dead_wrong_type_argument (Qconsp, sequences[j]); + mapping_interaction_error (caller, sequences[j]); } args[j + 1] = XCAR (sequences[j]); sequences[j] = XCDR (sequences[j]); @@ -4232,91 +4255,82 @@ vals[i] = IGNORE_MULTIPLE_VALUES (called); gcpro2.nvars += 1; } - else - { - switch (lisp_vals_type) - { - case lrecord_type_symbol: - break; - case lrecord_type_cons: - { - if (SOME_OR_EVERY_NEITHER == some_or_every) - { - called = IGNORE_MULTIPLE_VALUES (called); - if (!CONSP (lisp_vals)) - { - /* If FUNCTION has inserted a non-cons non-nil - cdr into the list before we've processed the - relevant part, error. */ - dead_wrong_type_argument (Qconsp, lisp_vals); - } - - XSETCAR (lisp_vals, called); - lisp_vals = XCDR (lisp_vals); - break; - } - - if (SOME_OR_EVERY_SOME == some_or_every) - { - if (!NILP (IGNORE_MULTIPLE_VALUES (called))) - { - XCAR (lisp_vals) = called; - UNGCPRO; - return; - } - break; - } - - if (SOME_OR_EVERY_EVERY == some_or_every) - { - called = IGNORE_MULTIPLE_VALUES (called); - if (NILP (called)) - { - XCAR (lisp_vals) = Qnil; - UNGCPRO; - return; - } - break; - } - - goto bad_some_or_every_flag; - } - case lrecord_type_vector: - { - called = IGNORE_MULTIPLE_VALUES (called); - i < XVECTOR_LENGTH (lisp_vals) ? - (XVECTOR_DATA (lisp_vals)[i] = called) : - /* Let #'aset error. */ - Faset (lisp_vals, make_int (i), called); - break; - } - case lrecord_type_string: - { - /* If this ever becomes a code hotspot, we can keep - around pointers into the data of the string, checking - each time that it hasn't been relocated. */ - called = IGNORE_MULTIPLE_VALUES (called); - Faset (lisp_vals, make_int (i), called); - break; - } - case lrecord_type_bit_vector: - { - called = IGNORE_MULTIPLE_VALUES (called); - (BITP (called) && - i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ? - set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i, - XINT (called)) : - (void) Faset (lisp_vals, make_int (i), called); - break; - } - bad_some_or_every_flag: - default: - { - ABORT(); - break; - } - } - } + else if (EQ (Qsome, caller)) + { + if (!NILP (IGNORE_MULTIPLE_VALUES (called))) + { + Lisp_Object *result + = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals); + *result = called; + UNGCPRO; + return; + } + } + else if (EQ (Qevery, caller)) + { + if (NILP (IGNORE_MULTIPLE_VALUES (called))) + { + Lisp_Object *result + = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals); + *result = Qnil; + UNGCPRO; + return; + } + } + else + { + called = IGNORE_MULTIPLE_VALUES (called); + switch (lisp_vals_type) + { + case lrecord_type_symbol: + /* This is #'mapc; the result of the funcall is + discarded. */ + break; + case lrecord_type_cons: + { + if (!CONSP (lisp_vals)) + { + /* If FUNCTION has inserted a non-cons non-nil + cdr into the list before we've processed the + relevant part, error. */ + mapping_interaction_error (caller, lisp_vals); + } + XSETCAR (lisp_vals, called); + lisp_vals = XCDR (lisp_vals); + break; + } + case lrecord_type_vector: + { + i < XVECTOR_LENGTH (lisp_vals) ? + (XVECTOR_DATA (lisp_vals)[i] = called) : + /* Let #'aset error. */ + Faset (lisp_vals, make_int (i), called); + break; + } + case lrecord_type_string: + { + /* If this ever becomes a code hotspot, we can keep + around pointers into the data of the string, checking + each time that it hasn't been relocated. */ + Faset (lisp_vals, make_int (i), called); + break; + } + case lrecord_type_bit_vector: + { + (BITP (called) && + i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ? + set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i, + XINT (called)) : + (void) Faset (lisp_vals, make_int (i), called); + break; + } + default: + { + ABORT(); + break; + } + } + } } } UNGCPRO; @@ -4373,8 +4387,7 @@ } else { - mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, - SOME_OR_EVERY_NEITHER); + mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmapconcat); } for (i = len - 1; i >= 0; i--) @@ -4412,8 +4425,7 @@ } args0 = alloca_array (Lisp_Object, len); - mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, - SOME_OR_EVERY_NEITHER); + mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX); return Flist ((int) len, args0); } @@ -4449,10 +4461,8 @@ /* Don't pass result as the lisp_object argument, we want mapcarX to protect a single list argument's elements from being garbage-collected. */ mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1, - SOME_OR_EVERY_NEITHER); - UNGCPRO; - - return result; + Qmapvector); + RETURN_UNGCPRO (result); } DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /* @@ -4470,40 +4480,21 @@ */ (int nargs, Lisp_Object *args)) { - Lisp_Object function = args[0], nconcing; - Elemcount len = EMACS_INT_MAX; - Lisp_Object *args0; - struct gcpro gcpro1; + Lisp_Object function = args[0], *result; + Elemcount result_len = EMACS_INT_MAX; 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 + 1); - mapcarX (len, args0 + 1, Qnil, function, nargs - 1, args + 1, - SOME_OR_EVERY_NEITHER); - - if (len < 2) - { - return len ? args0[1] : Qnil; + result_len = min (result_len, XINT (Flength (args[i]))); } - /* bytecode_nconc2 can signal and return, we need to GCPRO the args, since - mapcarX is no longer doing this for us. */ - args0[0] = Fcons (Qnil, Qnil); - GCPRO1 (args0[0]); - gcpro1.nvars = len + 1; - - for (i = 0; i < len; ++i) - { - nconcing = bytecode_nconc2 (args0 + i); - args0[i + 1] = nconcing; - } - - RETURN_UNGCPRO (XCDR (nconcing)); + result = alloca_array (Lisp_Object, result_len); + mapcarX (result_len, result, Qnil, function, nargs - 1, args + 1, Qmapcan); + + /* #'nconc GCPROs its args in case of signals and error. */ + return Fnconc (result_len, result); } DEFUN ("mapc", Fmapc, 2, MANY, 0, /* @@ -4539,8 +4530,7 @@ elements of the args array handed to it, and this may involve elements of sequence getting garbage collected. */ GCPRO1 (sequence); - mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, - SOME_OR_EVERY_NEITHER); + mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, Qmapc); RETURN_UNGCPRO (sequence); } @@ -4580,8 +4570,7 @@ args0 = alloca_array (Lisp_Object, len); } - mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, - SOME_OR_EVERY_NEITHER); + mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmap); if (EQ (type, Qnil)) { @@ -4646,7 +4635,7 @@ } mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2, - SOME_OR_EVERY_NEITHER); + Qmap_into); return result_sequence; } @@ -4663,23 +4652,20 @@ */ (int nargs, Lisp_Object *args)) { - Lisp_Object result_box = Fcons (Qnil, Qnil); - struct gcpro gcpro1; + Lisp_Object result = Qnil, + result_ptr = STORE_VOID_IN_LISP ((void *) &result); Elemcount len = EMACS_INT_MAX; int i; - GCPRO1 (result_box); - for (i = 1; i < nargs; ++i) { CHECK_SEQUENCE (args[i]); len = min (len, XINT (Flength (args[i]))); } - mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1, - SOME_OR_EVERY_SOME); - - RETURN_UNGCPRO (XCAR (result_box)); + mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome); + + return result; } DEFUN ("every", Fevery, 2, MANY, 0, /* @@ -4694,43 +4680,42 @@ */ (int nargs, Lisp_Object *args)) { - Lisp_Object result_box = Fcons (Qt, Qnil); - struct gcpro gcpro1; + Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result); Elemcount len = EMACS_INT_MAX; int i; - GCPRO1 (result_box); - for (i = 1; i < nargs; ++i) { CHECK_SEQUENCE (args[i]); len = min (len, XINT (Flength (args[i]))); } - mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1, - SOME_OR_EVERY_EVERY); - - RETURN_UNGCPRO (XCAR (result_box)); + mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery); + + return result; } /* Call FUNCTION with NLISTS arguments repeatedly, each Nth argument corresponding to the result of calling (nthcdr ITERATION-COUNT LISTS[N]), until that #'nthcdr expression gives nil for some element of LISTS. - If MAPLP is zero, return LISTS[0]. Otherwise, return a list of the return - values from FUNCTION; if NCONCP is non-zero, nconc them together. + CALLER is a symbol reflecting the Lisp-visible function that was called, + and any errors thrown because SEQUENCES was modified will reflect it. + + If CALLER is Qmapl, return LISTS[0]. Otherwise, return a list of the + return values from FUNCTION; if caller is Qmapcan, nconc them together. In contrast to mapcarX, we don't require our callers to check LISTS for well-formedness, we signal wrong-type-argument if it's not a list, or circular-list if it's circular. */ static Lisp_Object -maplist (Lisp_Object function, int nlists, Lisp_Object *lists, int maplp, - int nconcp) -{ - Lisp_Object result = maplp ? lists[0] : Fcons (Qnil, Qnil), funcalled; - Lisp_Object nconcing[2], accum = result, *args; - struct gcpro gcpro1, gcpro2, gcpro3; +maplist (Lisp_Object function, int nlists, Lisp_Object *lists, + Lisp_Object caller) +{ + Lisp_Object nconcing[2], accum = Qnil, *args, *tortoises, funcalled; + Lisp_Object result = EQ (caller, Qmapl) ? lists[0] : Qnil; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int i, j, continuing = (nlists > 0), called_count = 0; args = alloca_array (Lisp_Object, nlists + 1); @@ -4740,18 +4725,23 @@ args[i] = Qnil; } - if (nconcp) + tortoises = alloca_array (Lisp_Object, nlists); + memcpy (tortoises, lists, nlists * sizeof (Lisp_Object)); + + if (EQ (caller, Qmapcon)) { - nconcing[0] = result; + nconcing[0] = Qnil; nconcing[1] = Qnil; - GCPRO3 (args[0], nconcing[0], result); + GCPRO4 (args[0], nconcing[0], tortoises[0], result); gcpro1.nvars = 1; gcpro2.nvars = 2; + gcpro3.nvars = nlists; } else { - GCPRO2 (args[0], result); + GCPRO3 (args[0], tortoises[0], result); gcpro1.nvars = 1; + gcpro2.nvars = nlists; } while (continuing) @@ -4770,45 +4760,64 @@ } else { - dead_wrong_type_argument (Qlistp, lists[j]); + lists[j] = wrong_type_argument (Qlistp, lists[j]); } } if (!continuing) break; funcalled = IGNORE_MULTIPLE_VALUES (Ffuncall (nlists + 1, args)); - if (!maplp) + + if (EQ (caller, Qmapl)) { - if (nconcp) - { - /* This order of calls means we check that each list is - well-formed once and once only. The last result does - not have to be a list. */ - nconcing[1] = funcalled; - nconcing[0] = bytecode_nconc2 (nconcing); - } - else - { - /* Add to the end, avoiding the need to call nreverse - once we're done: */ - XSETCDR (accum, Fcons (funcalled, Qnil)); - accum = XCDR (accum); - } + DO_NOTHING; + } + else if (EQ (caller, Qmapcon)) + { + nconcing[1] = funcalled; + accum = bytecode_nconc2 (nconcing); + if (NILP (result)) + { + result = accum; + } + /* Only check a given stretch of result for well-formedness + once: */ + nconcing[0] = funcalled; + } + else if (NILP (accum)) + { + accum = result = Fcons (funcalled, Qnil); + } + else + { + /* Add to the end, avoiding the need to call nreverse + once we're done: */ + XSETCDR (accum, Fcons (funcalled, Qnil)); + accum = XCDR (accum); } - if (++called_count % CIRCULAR_LIST_SUSPICION_LENGTH) continue; - - for (j = 0; j < nlists; ++j) - { - EXTERNAL_LIST_LOOP_1 (lists[j]) - { - /* Just check the lists aren't circular, using the - EXTERNAL_LIST_LOOP_1 macro. */ - } - } - } - - if (!maplp) - { - result = XCDR (result); + if (++called_count > CIRCULAR_LIST_SUSPICION_LENGTH) + { + if (called_count & 1) + { + for (j = 0; j < nlists; ++j) + { + tortoises[j] = XCDR (tortoises[j]); + if (EQ (lists[j], tortoises[j])) + { + signal_circular_list_error (lists[j]); + } + } + } + else + { + for (j = 0; j < nlists; ++j) + { + if (EQ (lists[j], tortoises[j])) + { + signal_circular_list_error (lists[j]); + } + } + } + } } RETURN_UNGCPRO (result); @@ -4823,7 +4832,7 @@ */ (int nargs, Lisp_Object *args)) { - return maplist (args[0], nargs - 1, args + 1, 0, 0); + return maplist (args[0], nargs - 1, args + 1, Qmaplist); } DEFUN ("mapl", Fmapl, 2, MANY, 0, /* @@ -4833,7 +4842,7 @@ */ (int nargs, Lisp_Object *args)) { - return maplist (args[0], nargs - 1, args + 1, 1, 0); + return maplist (args[0], nargs - 1, args + 1, Qmapl); } DEFUN ("mapcon", Fmapcon, 2, MANY, 0, /* @@ -4846,7 +4855,7 @@ */ (int nargs, Lisp_Object *args)) { - return maplist (args[0], nargs - 1, args + 1, 0, 1); + return maplist (args[0], nargs - 1, args + 1, Qmapcon); } /* Extra random functions */ @@ -5149,7 +5158,8 @@ Elemcount counting = 0, len = 0; struct gcpro gcpro1; - if (ending - starting && starting < ending && EMACS_INT_MAX == ending) + if (ending - starting && starting < ending + && EMACS_INT_MAX == ending) { ending = XINT (Flength (sequence)); } @@ -5916,6 +5926,19 @@ defsymbol (&QsortX, "sort*"); DEFSYMBOL (Qreduce); + DEFSYMBOL (Qmapconcat); + defsymbol (&QmapcarX, "mapcar*"); + DEFSYMBOL (Qmapvector); + DEFSYMBOL (Qmapcan); + DEFSYMBOL (Qmapc); + DEFSYMBOL (Qmap); + DEFSYMBOL (Qmap_into); + DEFSYMBOL (Qsome); + DEFSYMBOL (Qevery); + DEFSYMBOL (Qmaplist); + DEFSYMBOL (Qmapl); + DEFSYMBOL (Qmapcon); + DEFKEYWORD (Q_from_end); DEFKEYWORD (Q_initial_value);