commit: Have #'sort*, #'merge use the same test approach as functions from cl-seq.el

changeset: 5350:94bbd4792049 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Sat Feb 05 12:04:34 2011 +0000 files: src/ChangeLog src/abbrev.c src/dired.c src/fileio.c src/fns.c src/fontcolor-msw.c src/keymap.c src/lisp.h description: Have #'sort*, #'merge use the same test approach as functions from cl-seq.el 2011-02-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; * fns.c: * fns.c (check_lss_key, check_lss_key_car): New. * fns.c (check_string_lessp_key check_string_lessp_key_car): New. * fns.c (get_merge_predicate): New. * fns.c (list_merge): * fns.c (array_merge): * fns.c (list_array_merge_into_list): * fns.c (list_list_merge_into_array): * fns.c (list_array_merge_into_array): * fns.c (Fmerge): * fns.c (list_sort): * fns.c (array_sort): * fns.c (FsortX): * fns.c (syms_of_fns): * lisp.h: Move #'sort, #'merge to using the same test approach as is used in the functions that take TEST, TEST-NOT and KEY arguments. This allows us to avoid the Ffuncall() overhead when the most common PREDICATE arguments are supplied, in particular #'< and #'string-lessp. * fontcolor-msw.c (sort_font_list_function): * fontcolor-msw.c (mswindows_enumerate_fonts): * dired.c: * dired.c (Fdirectory_files): * fileio.c: * fileio.c (build_annotations): * fileio.c (syms_of_fileio): * keymap.c: * keymap.c (keymap_submaps): * keymap.c (map_keymap_sort_predicate): * keymap.c (describe_map_sort_predicate): * keymap.c (describe_map): Change the various C predicates passed to list_sort () and list_merge () to fit the new calling convention, returning non-zero if the first argument is less than the second, zero otherwise. diff -r 239193591765 -r 94bbd4792049 src/ChangeLog --- a/src/ChangeLog Sun Jan 30 14:27:31 2011 +0100 +++ b/src/ChangeLog Sat Feb 05 12:04:34 2011 +0000 ＠＠ -1,3 +1,43 ＠＠ +2011-02-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * fns.c: + * fns.c (check_lss_key, check_lss_key_car): New. + * fns.c (check_string_lessp_key check_string_lessp_key_car): New. + * fns.c (get_merge_predicate): New. + * fns.c (list_merge): + * fns.c (array_merge): + * fns.c (list_array_merge_into_list): + * fns.c (list_list_merge_into_array): + * fns.c (list_array_merge_into_array): + * fns.c (Fmerge): + * fns.c (list_sort): + * fns.c (array_sort): + * fns.c (FsortX): + * fns.c (syms_of_fns): + * lisp.h: + Move #'sort, #'merge to using the same test approach as is used in + the functions that take TEST, TEST-NOT and KEY arguments. This + allows us to avoid the Ffuncall() overhead when the most common + PREDICATE arguments are supplied, in particular #'< and + #'string-lessp. + + * fontcolor-msw.c (sort_font_list_function): + * fontcolor-msw.c (mswindows_enumerate_fonts): + * dired.c: + * dired.c (Fdirectory_files): + * fileio.c: + * fileio.c (build_annotations): + * fileio.c (syms_of_fileio): + * keymap.c: + * keymap.c (keymap_submaps): + * keymap.c (map_keymap_sort_predicate): + * keymap.c (describe_map_sort_predicate): + * keymap.c (describe_map): + Change the various C predicates passed to list_sort () and + list_merge () to fit the new calling convention, returning + non-zero if the first argument is less than the second, zero + otherwise. + 2011-01-30 Michael Sperber <mike(a)xemacs.org&gt; * redisplay.h: diff -r 239193591765 -r 94bbd4792049 src/abbrev.c --- a/src/abbrev.c Sun Jan 30 14:27:31 2011 +0100 +++ b/src/abbrev.c Sat Feb 05 12:04:34 2011 +0000 ＠＠ -524,7 +524,7 ＠＠ map_obarray (table, record_symbol, &symbols); /* map_obarray (table, record_symbol, &closure); */ symbols = XCDR (symbols); - symbols = list_sort (symbols, NULL, Qstring_lessp, Qidentity); + symbols = list_sort (symbols, check_string_lessp_nokey, Qnil, Qnil); if (!NILP (readable)) { diff -r 239193591765 -r 94bbd4792049 src/dired.c --- a/src/dired.c Sun Jan 30 14:27:31 2011 +0100 +++ b/src/dired.c Sat Feb 05 12:04:34 2011 +0000 ＠＠ -181,7 +181,7 ＠＠ unbind_to (speccount); /* This will close the dir */ if (NILP (nosort)) - list = list_sort (Fnreverse (list), NULL, Qstring_lessp, Qidentity); + list = list_sort (Fnreverse (list), check_string_lessp_nokey, Qnil, Qnil); RETURN_UNGCPRO (list); } diff -r 239193591765 -r 94bbd4792049 src/fileio.c --- a/src/fileio.c Sun Jan 30 14:27:31 2011 +0100 +++ b/src/fileio.c Sat Feb 05 12:04:34 2011 +0000 ＠＠ -131,8 +131,6 ＠＠ Lisp_Object Qauto_save_hook; Lisp_Object Qauto_save_error; Lisp_Object Qauto_saving; - -Lisp_Object Qcar_less_than_car; Lisp_Object Qcompute_buffer_file_truename; ＠＠ -3677,7 +3675,8 ＠＠ annotations = Qnil; } Flength (res); /* Check basic validity of return value */ - annotations = list_merge (annotations, res, NULL, Qlss, Qcar); + annotations = list_merge (annotations, res, check_lss_key_car, Qnil, + Qnil); p = Fcdr (p); } ＠＠ -3708,7 +3707,8 ＠＠ annotations = Qnil; } Flength (res); - annotations = list_merge (annotations, res, NULL, Qlss, Qcar); + annotations = list_merge (annotations, res, check_lss_key_car, Qnil, + Qnil); p = Fcdr (p); } ＠＠ -4381,7 +4381,6 ＠＠ DEFSYMBOL (Qwrite_region); DEFSYMBOL (Qverify_visited_file_modtime); DEFSYMBOL (Qset_visited_file_modtime); - DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */ DEFSYMBOL (Qexcl); DEFSYMBOL (Qauto_save_hook); diff -r 239193591765 -r 94bbd4792049 src/fns.c --- a/src/fns.c Sun Jan 30 14:27:31 2011 +0100 +++ b/src/fns.c Sat Feb 05 12:04:34 2011 +0000 ＠＠ -63,7 +63,7 ＠＠ Lisp_Object Q_test_not, Q_count, Qnsubstitute, Qdelete_duplicates, Qmismatch; Lisp_Object Qintersection, Qset_difference, Qnset_difference; -Lisp_Object Qnunion, Qnintersection, Qsubsetp; +Lisp_Object Qnunion, Qnintersection, Qsubsetp, Qcar_less_than_car; Lisp_Object Qbase64_conversion_error; ＠＠ -210,9 +210,6 ＠＠ /* Various test functions for #'member*, #'assoc* and the other functions that take both TEST and KEY arguments. */ -typedef Boolint (*check_test_func_t) (Lisp_Object test, Lisp_Object key, - Lisp_Object item, Lisp_Object elt); - static Boolint check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), Lisp_Object item, Lisp_Object elt) ＠＠ -439,7 +436,84 ＠＠ return !NILP (elt1); } - + +static Boolint +check_lss_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + return bytecode_arithcompare (elt1, elt2) < 0; +} + +static Boolint +check_lss_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + UNGCPRO; + + return bytecode_arithcompare (args[0], args[1]) < 0; +} + +Boolint +check_lss_key_car (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + struct gcpro gcpro1, gcpro2; + + GCPRO2 (elt1, elt2); + elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1); + elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2); + UNGCPRO; + + return bytecode_arithcompare (elt1, elt2) < 0; +} + +Boolint +check_string_lessp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + return !NILP (Fstring_lessp (elt1, elt2)); +} + +static Boolint +check_string_lessp_key (Lisp_Object UNUSED (test), Lisp_Object key, + Lisp_Object elt1, Lisp_Object elt2) +{ + Lisp_Object args[] = { key, elt1, elt2 }; + struct gcpro gcpro1; + + GCPRO1 (args[0]); + gcpro1.nvars = countof (args); + args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); + args[1] = key; + args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1)); + UNGCPRO; + + return !NILP (Fstring_lessp (args[0], args[1])); +} + +static Boolint +check_string_lessp_key_car (Lisp_Object UNUSED (test), + Lisp_Object UNUSED (key), + Lisp_Object elt1, Lisp_Object elt2) +{ + struct gcpro gcpro1, gcpro2; + + GCPRO2 (elt1, elt2); + elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1); + elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2); + UNGCPRO; + + return !NILP (Fstring_lessp (elt1, elt2)); +} + static check_test_func_t get_check_match_function_1 (Lisp_Object item, Lisp_Object *test_inout, Lisp_Object test_not, ＠＠ -646,6 +720,72 ＠＠ test_not_unboundp_out, test_func_out); } +/* Given PREDICATE and KEY, return a C function pointer appropriate for use + in deciding whether one given elements of a sequence is less than + another. */ + +static check_test_func_t +get_merge_predicate (Lisp_Object predicate, Lisp_Object key) +{ + predicate = indirect_function (predicate, 1); + + if (NILP (key)) + { + key = Qidentity; + } + else + { + key = indirect_function (key, 1); + if (EQ (key, XSYMBOL_FUNCTION (Qidentity))) + { + key = Qidentity; + } + } + + if (EQ (key, Qidentity) && EQ (predicate, + XSYMBOL_FUNCTION (Qcar_less_than_car))) + { + key = XSYMBOL_FUNCTION (Qcar); + predicate = XSYMBOL_FUNCTION (Qlss); + } + + if (EQ (predicate, XSYMBOL_FUNCTION (Qlss))) + { + if (EQ (key, Qidentity)) + { + return check_lss_nokey; + } + + if (EQ (key, XSYMBOL_FUNCTION (Qcar))) + { + return check_lss_key_car; + } + + return check_lss_key; + } + + if (EQ (predicate, XSYMBOL_FUNCTION (Qstring_lessp))) + { + if (EQ (key, Qidentity)) + { + return check_string_lessp_nokey; + } + + if (EQ (key, XSYMBOL_FUNCTION (Qcar))) + { + return check_string_lessp_key_car; + } + + return check_string_lessp_key; + } + + if (EQ (key, Qidentity)) + { + return check_other_nokey; + } + + return check_match_other_key; +}  DEFUN ("identity", Fidentity, 1, 1, 0, /* Return the argument unchanged. ＠＠ -4694,58 +4834,10 ＠＠ return result; }  -static Lisp_Object -c_merge_predicate_key (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object pred, Lisp_Object key_func) -{ - struct gcpro gcpro1; - Lisp_Object args[3]; - - /* We could use call2() and call3() here, but we're called O(nlogn) times - for a sequence of length n, it make some sense to inline them. */ - args[0] = key_func; - args[1] = obj1; - args[2] = Qnil; - - GCPRO1 (args[0]); - gcpro1.nvars = countof (args); - - obj1 = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); - - args[1] = obj2; - obj2 = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); - - args[0] = pred; - args[1] = obj1; - args[2] = obj2; - - RETURN_UNGCPRO (IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args))); -} - -static Lisp_Object -c_merge_predicate_nokey (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object pred, Lisp_Object UNUSED (key_func)) -{ - struct gcpro gcpro1; - Lisp_Object args[3]; - - /* This is (almost) the implementation of call2, it makes some sense to - inline it here. */ - args[0] = pred; - args[1] = obj1; - args[2] = obj2; - - GCPRO1 (args[0]); - gcpro1.nvars = countof (args); - - RETURN_UNGCPRO (IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args))); -} - Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2, - Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object), - Lisp_Object predicate, Lisp_Object key_func) + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) { Lisp_Object value; Lisp_Object tail; ＠＠ -4762,15 +4854,8 ＠＠ tortoises[0] = org_l1; tortoises[1] = org_l2; - if (NULL == c_predicate) - { - c_predicate = EQ (key_func, Qidentity) ? - c_merge_predicate_nokey : c_merge_predicate_key; - } - - /* It is sufficient to protect org_l1 and org_l2. - When l1 and l2 are updated, we copy the new values - back into the org_ vars. */ + /* It is sufficient to protect org_l1 and org_l2. When l1 and l2 are + updated, we copy the new values back into the org_ vars. */ GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]); gcpro5.nvars = 2; ＠＠ -4794,7 +4879,7 ＠＠ return value; } - if (NILP (c_predicate (Fcar (l2), Fcar (l1), predicate, key_func))) + if (check_merge (predicate, key, Fcar (l2), Fcar (l1)) == 0) { tem = l1; l1 = Fcdr (l1); ＠＠ -4856,9 +4941,8 ＠＠ array_merge (Lisp_Object *dest, Elemcount dest_len, Lisp_Object *front, Elemcount front_len, Lisp_Object *back, Elemcount back_len, - Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object), - Lisp_Object predicate, Lisp_Object key_func) + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) { Elemcount ii, fronting, backing; Lisp_Object *front_staging = front; ＠＠ -4920,8 +5004,8 ＠＠ return; } - if (NILP (c_predicate (back_staging[backing], front_staging[fronting], - predicate, key_func))) + if (check_merge (predicate, key, back_staging[backing], + front_staging[fronting]) == 0) { dest[ii] = front_staging[fronting]; ++fronting; ＠＠ -4939,11 +5023,8 ＠＠ static Lisp_Object list_array_merge_into_list (Lisp_Object list, Lisp_Object *array, Elemcount array_len, - Lisp_Object (*c_predicate) (Lisp_Object, - Lisp_Object, - Lisp_Object, - Lisp_Object), - Lisp_Object predicate, Lisp_Object key_func, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key, Boolint reverse_order) { Lisp_Object tail = Qnil, value = Qnil, tortoise = list; ＠＠ -4982,10 +5063,8 ＠＠ if (reverse_order ? - !NILP (c_predicate (Fcar (list), array [array_index], predicate, - key_func)) : - NILP (c_predicate (array [array_index], Fcar (list), predicate, - key_func))) + check_merge (predicate, key, Fcar (list), array [array_index]) + : !check_merge (predicate, key, array [array_index], Fcar (list))) { if (NILP (tail)) { ＠＠ -5031,11 +5110,8 ＠＠ static void list_list_merge_into_array (Lisp_Object *output, Elemcount output_len, Lisp_Object list_one, Lisp_Object list_two, - Lisp_Object (*c_predicate) (Lisp_Object, - Lisp_Object, - Lisp_Object, - Lisp_Object), - Lisp_Object predicate, Lisp_Object key_func) + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) { Elemcount output_index = 0; ＠＠ -5061,8 +5137,8 ＠＠ return; } - if (NILP (c_predicate (Fcar (list_two), Fcar (list_one), predicate, - key_func))) + if (check_merge (predicate, key, Fcar (list_two), Fcar (list_one)) + == 0) { output [output_index] = XCAR (list_one); list_one = XCDR (list_one); ＠＠ -5083,11 +5159,8 ＠＠ list_array_merge_into_array (Lisp_Object *output, Elemcount output_len, Lisp_Object list, Lisp_Object *array, Elemcount array_len, - Lisp_Object (*c_predicate) (Lisp_Object, - Lisp_Object, - Lisp_Object, - Lisp_Object), - Lisp_Object predicate, Lisp_Object key_func, + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key, Boolint reverse_order) { Elemcount output_index = 0, array_index = 0; ＠＠ -5121,10 +5194,8 ＠＠ } if (reverse_order ? - !NILP (c_predicate (Fcar (list), array [array_index], predicate, - key_func)) : - NILP (c_predicate (array [array_index], Fcar (list), predicate, - key_func))) + check_merge (predicate, key, Fcar (list), array [array_index]) : + !check_merge (predicate, key, array [array_index], Fcar (list))) { output [output_index] = XCAR (list); list = XCDR (list); ＠＠ -5172,8 +5243,7 ＠＠ { Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2], predicate = args[3], result = Qnil; - Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object); + check_test_func_t check_merge = NULL; PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL); ＠＠ -5182,8 +5252,7 ＠＠ CHECK_KEY_ARGUMENT (key); - c_predicate = EQ (key, Qidentity) ? - c_merge_predicate_nokey : c_merge_predicate_key; + check_merge = get_merge_predicate (predicate, key); if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two))) { ＠＠ -5199,7 +5268,7 ＠＠ } else if (CONSP (sequence_one) && CONSP (sequence_two)) { - result = list_merge (sequence_one, sequence_two, c_predicate, + result = list_merge (sequence_one, sequence_two, check_merge, predicate, key); } else ＠＠ -5241,8 +5310,7 ＠＠ result = list_array_merge_into_list (sequence_one, array_storage, array_length, - c_predicate, - predicate, key, + check_merge, predicate, key, reverse_order); } } ＠＠ -5306,8 +5374,7 ＠＠ { list_list_merge_into_array (output + 1, output_len - 1, sequence_one, sequence_two, - c_predicate, predicate, - key); + check_merge, predicate, key); } else if (LISTP (sequence_one)) { ＠＠ -5315,8 +5382,7 ＠＠ sequence_one, sequence_two_storage, sequence_two_len, - c_predicate, predicate, - key, 0); + check_merge, predicate, key, 0); } else if (LISTP (sequence_two)) { ＠＠ -5324,15 +5390,14 ＠＠ sequence_two, sequence_one_storage, sequence_one_len, - c_predicate, predicate, - key, 1); + check_merge, predicate, key, 1); } else { array_merge (output + 1, output_len - 1, sequence_one_storage, sequence_one_len, sequence_two_storage, sequence_two_len, - c_predicate, predicate, + check_merge, predicate, key); } ＠＠ -5349,13 +5414,9 ＠＠ return result; }  -/* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise. - NOTE: This is backwards from the way qsort() works. */ -Lisp_Object -list_sort (Lisp_Object list, - Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object), - Lisp_Object predicate, Lisp_Object key_func) +Lisp_Object +list_sort (Lisp_Object list, check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) { struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; Lisp_Object back, tem; ＠＠ -5365,29 +5426,22 ＠＠ if (XINT (len) < 2) return list; - if (NULL == c_predicate) - { - c_predicate = EQ (key_func, Qidentity) ? c_merge_predicate_nokey : - c_merge_predicate_key; - } - len = make_int (XINT (len) / 2 - 1); tem = Fnthcdr (len, list); back = Fcdr (tem); Fsetcdr (tem, Qnil); - GCPRO4 (front, back, predicate, key_func); - front = list_sort (front, c_predicate, predicate, key_func); - back = list_sort (back, c_predicate, predicate, key_func); - - RETURN_UNGCPRO (list_merge (front, back, c_predicate, predicate, key_func)); + GCPRO4 (front, back, predicate, key); + front = list_sort (front, check_merge, predicate, key); + back = list_sort (back, check_merge, predicate, key); + + RETURN_UNGCPRO (list_merge (front, back, check_merge, predicate, key)); } static void array_sort (Lisp_Object *array, Elemcount array_len, - Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object), - Lisp_Object predicate, Lisp_Object key_func) + check_test_func_t check_merge, + Lisp_Object predicate, Lisp_Object key) { Elemcount split; ＠＠ -5396,11 +5450,11 ＠＠ split = array_len / 2; - array_sort (array, split, c_predicate, predicate, key_func); - array_sort (array + split, array_len - split, c_predicate, predicate, - key_func); + array_sort (array, split, check_merge, predicate, key); + array_sort (array + split, array_len - split, check_merge, predicate, + key); array_merge (array, array_len, array, split, array + split, - array_len - split, c_predicate, predicate, key_func); + array_len - split, check_merge, predicate, key); } DEFUN ("sort*", FsortX, 2, MANY, 0, /* ＠＠ -5423,8 +5477,7 ＠＠ { Lisp_Object sequence = args[0], predicate = args[1]; Lisp_Object *sequence_carray; - Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object); + check_test_func_t check_merge = NULL; Elemcount sequence_len, i; PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL); ＠＠ -5433,17 +5486,16 ＠＠ CHECK_KEY_ARGUMENT (key); - c_predicate = EQ (key, Qidentity) ? - c_merge_predicate_nokey : c_merge_predicate_key; + check_merge = get_merge_predicate (predicate, key); if (LISTP (sequence)) { - sequence = list_sort (sequence, c_predicate, predicate, key); + sequence = list_sort (sequence, check_merge, predicate, key); } else if (VECTORP (sequence)) { array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence), - c_predicate, predicate, key); + check_merge, predicate, key); } else if (STRINGP (sequence)) { ＠＠ -5454,7 +5506,7 ＠＠ STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len); /* No GCPRO necessary, characters are immediate. */ - array_sort (sequence_carray, sequence_len, c_predicate, predicate, key); + array_sort (sequence_carray, sequence_len, check_merge, predicate, key); strdata = XSTRING_DATA (sequence); ＠＠ -5476,7 +5528,7 ＠＠ BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len); /* No GCPRO necessary, bits are immediate. */ - array_sort (sequence_carray, sequence_len, c_predicate, predicate, key); + array_sort (sequence_carray, sequence_len, check_merge, predicate, key); for (i = 0; i < sequence_len; ++i) { ＠＠ -11698,6 +11750,7 ＠＠ DEFSYMBOL (Qintersection); DEFSYMBOL (Qnintersection); DEFSYMBOL (Qsubsetp); + DEFSYMBOL (Qcar_less_than_car); DEFSYMBOL (Qset_difference); DEFSYMBOL (Qnset_difference); DEFSYMBOL (Qnunion); diff -r 239193591765 -r 94bbd4792049 src/fontcolor-msw.c --- a/src/fontcolor-msw.c Sun Jan 30 14:27:31 2011 +0100 +++ b/src/fontcolor-msw.c Sat Feb 05 12:04:34 2011 +0000 ＠＠ -1198,10 +1198,9 ＠＠ "family::::charset" for TrueType fonts, "family::size::charset" otherwise. */ -static Lisp_Object -sort_font_list_function (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object UNUSED (pred), - Lisp_Object UNUSED (key_function)) +static Boolint +sort_font_list_function (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key), + Lisp_Object obj1, Lisp_Object obj2) { Ibyte *font1, *font2; Ibyte *c1, *c2; ＠＠ -1215,16 +1214,16 ＠＠ 5. Courier New over other families. */ - /* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise. - NOTE: This is backwards from the way qsort() works. */ + /* The sort function should return non-zero if OBJ1 < OBJ2, zero + otherwise. */ t1 = !NILP (XCDR (obj1)); t2 = !NILP (XCDR (obj2)); if (t1 && !t2) - return Qt; + return 1; if (t2 && !t1) - return Qnil; + return 0; font1 = XSTRING_DATA (XCAR (obj1)); font2 = XSTRING_DATA (XCAR (obj2)); ＠＠ -1236,9 +1235,9 ＠＠ t2 = !qxestrcasecmp_ascii (c2 + 1, "western"); if (t1 && !t2) - return Qt; + return 1; if (t2 && !t1) - return Qnil; + return 0; c1 -= 2; c2 -= 2; ＠＠ -1246,9 +1245,9 ＠＠ t2 = *c2 == ':'; if (t1 && !t2) - return Qt; + return 1; if (t2 && !t1) - return Qnil; + return 0; if (!t1 && !t2) { ＠＠ -1261,25 +1260,25 ＠＠ t2 = qxeatoi (c2 + 1) - 10; if (abs (t1) < abs (t2)) - return Qt; + return 1; else if (abs (t2) < abs (t1)) - return Qnil; + return 0; else if (t1 < t2) /* Prefer a smaller font over a larger one just as far away because the smaller one won't upset the total line height if it's just a few chars. */ - return Qt; + return 1; } t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12); t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12); if (t1 && !t2) - return Qt; + return 1; if (t2 && !t1) - return Qnil; + return 0; - return Qnil; + return 0; } /* diff -r 239193591765 -r 94bbd4792049 src/keymap.c --- a/src/keymap.c Sun Jan 30 14:27:31 2011 +0100 +++ b/src/keymap.c Sat Feb 05 12:04:34 2011 +0000 ＠＠ -737,10 +737,9 ＠＠ return 0; } -static Lisp_Object map_keymap_sort_predicate (Lisp_Object obj1, - Lisp_Object obj2, - Lisp_Object pred, - Lisp_Object key_func); +static Boolint map_keymap_sort_predicate (Lisp_Object pred, Lisp_Object key, + Lisp_Object obj1, Lisp_Object obj2); + static Lisp_Object keymap_submaps (Lisp_Object keymap) ＠＠ -764,7 +763,7 ＠＠ &keymap_submaps_closure); /* keep it sorted so that the result of accessible-keymaps is ordered */ k->sub_maps_cache = list_sort (result, map_keymap_sort_predicate, - Qnil, Qidentity); + Qnil, Qnil); UNGCPRO; } return k->sub_maps_cache; ＠＠ -2896,10 +2895,9 ＠＠ /* used by map_keymap_sorted(), describe_map_sort_predicate(), and keymap_submaps(). */ -static Lisp_Object -map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object UNUSED (pred), - Lisp_Object UNUSED (key_func)) +static Boolint +map_keymap_sort_predicate (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key), + Lisp_Object obj1, Lisp_Object obj2) { /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. */ ＠＠ -2912,12 +2910,12 ＠＠ obj2 = XCAR (obj2); if (EQ (obj1, obj2)) - return Qnil; + return 0; bit1 = MODIFIER_HASH_KEY_BITS (obj1); bit2 = MODIFIER_HASH_KEY_BITS (obj2); - /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by - that code instead of alphabetically. + /* If either is a symbol with a Qcharacter_of_keysym property, then sort + it by that code instead of alphabetically. */ if (! bit1 && SYMBOLP (obj1)) { ＠＠ -2942,7 +2940,7 ＠＠ /* all symbols (non-ASCIIs) come after characters (ASCIIs) */ if (XTYPE (obj1) != XTYPE (obj2)) - return SYMBOLP (obj2) ? Qt : Qnil; + return SYMBOLP (obj2); if (! bit1 && CHARP (obj1)) /* they're both ASCII */ { ＠＠ -2950,24 +2948,24 ＠＠ int o2 = XCHAR (obj2); if (o1 == o2 && /* If one started out as a symbol and the */ sym1_p != sym2_p) /* other didn't, the symbol comes last. */ - return sym2_p ? Qt : Qnil; - - return o1 < o2 ? Qt : Qnil; /* else just compare them */ + return sym2_p; + + return o1 < o2; /* else just compare them */ } /* else they're both symbols. If they're both buckys, then order them. */ if (bit1 && bit2) - return bit1 < bit2 ? Qt : Qnil; + return bit1 < bit2; /* if only one is a bucky, then it comes later */ if (bit1 || bit2) - return bit2 ? Qt : Qnil; + return bit2; /* otherwise, string-sort them. */ { Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name); Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name); - return 0 > qxestrcmp (s1, s2) ? Qt : Qnil; + return 0 > qxestrcmp (s1, s2); } } ＠＠ -4087,10 +4085,10 ＠＠ *(closure->list)); } - -static Lisp_Object -describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object pred, Lisp_Object key_func) +static Boolint +describe_map_sort_predicate (Lisp_Object pred, Lisp_Object key_func, + Lisp_Object obj1, Lisp_Object obj2) + { /* obj1 and obj2 are conses of the form ( ( <keysym> . <modifiers> ) . <binding> ) ＠＠ -4102,7 +4100,7 ＠＠ bit1 = XINT (XCDR (obj1)); bit2 = XINT (XCDR (obj2)); if (bit1 != bit2) - return bit1 < bit2 ? Qt : Qnil; + return bit1 < bit2; else return map_keymap_sort_predicate (obj1, obj2, pred, key_func); } ＠＠ -4212,7 +4210,7 ＠＠ if (!NILP (list)) { - list = list_sort (list, describe_map_sort_predicate, Qnil, Qidentity); + list = list_sort (list, describe_map_sort_predicate, Qnil, Qnil); buffer_insert_ascstring (buf, "\n"); while (!NILP (list)) { diff -r 239193591765 -r 94bbd4792049 src/lisp.h --- a/src/lisp.h Sun Jan 30 14:27:31 2011 +0100 +++ b/src/lisp.h Sat Feb 05 12:04:34 2011 +0000 ＠＠ -5248,15 +5248,19 ＠＠ EXFUN (Fsubseq, 3); EXFUN (Fvalid_plist_p, 1); +extern Boolint check_lss_key_car (Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object); +extern Boolint check_string_lessp_nokey (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); + +typedef Boolint (*check_test_func_t) (Lisp_Object test, Lisp_Object key, + Lisp_Object item, Lisp_Object elt); + Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2, - Lisp_Object (*c_predicate) (Lisp_Object o1, - Lisp_Object o2, - Lisp_Object pred, - Lisp_Object keyf), + check_test_func_t check_merge, Lisp_Object predicate, Lisp_Object key_func); Lisp_Object list_sort (Lisp_Object list, - Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object), + check_test_func_t check_merge, Lisp_Object predicate, Lisp_Object key_func); void bump_string_modiff (Lisp_Object); _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches