annotate src/sequence.c @ 5753:dbd8305e13cb

Warn about non-string non-integer ARG to #'gensym, bytecomp.el. lisp/ChangeLog addition: 2013-08-21 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: * bytecomp.el (gensym): * bytecomp.el (byte-compile-gensym): New. Warn that gensym called in a for-effect context is unlikely to be useful. Warn about non-string non-integer ARGs, this is incorrect. Am not changing the function to error with same, most code that makes the mistake is has no problems, which is why it has survived so long. * window-xemacs.el (save-window-excursion/mapping): * window.el (save-window-excursion): Call #'gensym with a string, not a symbol.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 21 Aug 2013 19:02:59 +0100
parents 70a3f4ff8da8
children cd4f5f1f1f4c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1 /* Various functions that operate on sequences, split out from fns.c
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2 Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2010 Ben Wing.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5 This file is part of XEmacs.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7 XEmacs is free software: you can redistribute it and/or modify it
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
9 Free Software Foundation, either version 3 of the License, or (at your
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
10 option) any later version.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
11
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
15 for more details.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
16
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
19
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
20 #include <config.h>
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
21 #include "lisp.h"
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
22 #include "extents.h"
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
23
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
24 Lisp_Object Qadjoin, Qarray, QassocX, Qbit_vector, Qcar_less_than_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
25 Lisp_Object QdeleteX, Qdelete_duplicates, Qevery, Qfill, Qfind, Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
26 Lisp_Object Qintersection, Qmap, Qmap_into, Qmapc, Qmapcan, QmapcarX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
27 Lisp_Object Qmapconcat, Qmapvector, Qmerge, Qmismatch, Qnintersection;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
28 Lisp_Object Qnset_difference, Qnsubstitute, Qnunion, Qposition, QrassocX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
29 Lisp_Object Qreduce, QremoveX, Qreplace, Qset_difference, Qsome, QsortX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
30 Lisp_Object Qstring_lessp, Qsubsetp, Qsubstitute, Qvector;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
31
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
32 Lisp_Object Q_count, Q_descend_structures, Q_end1, Q_end2, Q_from_end;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
33 Lisp_Object Q_if_, Q_if_not, Q_initial_value, Q_stable, Q_start1, Q_start2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
34 Lisp_Object Q_test_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
35
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
36 extern Fixnum max_lisp_eval_depth;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
37 extern int lisp_eval_depth;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
38
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
39 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
40
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
41 static DOESNT_RETURN
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
42 mapping_interaction_error (Lisp_Object func, Lisp_Object object)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
43 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
44 invalid_state_2 ("object modified while traversing it", func, object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
45 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
46
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
47 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
48 check_sequence_range (Lisp_Object sequence, Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
49 Lisp_Object end, Lisp_Object length)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
50 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
51 Lisp_Object args[] = { Qzero, start, NILP (end) ? length : end, length };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
52
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
53 if (NILP (Fleq (countof (args), args)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
54 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
55 args_out_of_range_3 (sequence, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
56 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
57 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
58
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
59 DEFUN ("length", Flength, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
60 Return the length of vector, bit vector, list or string SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
61 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
62 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
63 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
64 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
65 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
66 return make_fixnum (string_char_length (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
67 else if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
68 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
69 Elemcount len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
70 GET_EXTERNAL_LIST_LENGTH (sequence, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
71 return make_fixnum (len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
72 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
73 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
74 return make_fixnum (XVECTOR_LENGTH (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
75 else if (NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
76 return Qzero;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
77 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
78 return make_fixnum (bit_vector_length (XBIT_VECTOR (sequence)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
79 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
80 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
81 check_losing_bytecode ("length", sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
82 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
83 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
84 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
85 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
86
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
87 /* Various test functions for #'member*, #'assoc* and the other functions
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
88 that take both TEST and KEY arguments. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
89
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
90 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
91 check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
92 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
93 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
94 return EQ (item, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
95 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
96
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
97 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
98 check_eq_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
99 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
101 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
102 return EQ (item, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
105 /* The next two are not used by #'member* and #'assoc*, since we can decide
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
106 on #'eq vs. #'equal when we have the type of ITEM. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
107 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
108 check_eql_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
109 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
111 return EQ (elt1, elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
112 || (NON_FIXNUM_NUMBER_P (elt1) && internal_equal (elt1, elt2, 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
113 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
114
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
115 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
116 check_eql_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
117 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
119 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
120 return EQ (item, elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
121 || (NON_FIXNUM_NUMBER_P (item) && internal_equal (item, elt, 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
122 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
123
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
124 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
125 check_equal_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
126 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
127 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
128 return internal_equal (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
129 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
130
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
131 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
132 check_equal_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
133 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
135 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
136 return internal_equal (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
137 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
138
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
139 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
140 check_equalp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
141 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
142 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
143 return internal_equalp (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
144 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
145
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
146 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
147 check_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
148 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
149 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
150 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
151 return internal_equalp (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
153
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
154 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
155 check_string_match_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
156 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
158 return !NILP (Fstring_match (item, elt, Qnil, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
159 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
160
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
161 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
162 check_string_match_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
163 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
164 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
165 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
166 return !NILP (Fstring_match (item, elt, Qnil, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
168
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
169 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
170 check_other_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
171 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
172 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
173 Lisp_Object args[] = { test, item, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
174 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
175
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
176 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
177 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
178 item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
179 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
181 return !NILP (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
182 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
183
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
184 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
185 check_other_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
186 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
187 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
188 Lisp_Object args[] = { item, key, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
189 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
190
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
191 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
192 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
193 args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args) - 1, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
194 args[1] = item;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
195 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
196 item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
197 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
199 return !NILP (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
202 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
203 check_if_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
204 Lisp_Object UNUSED (item), Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
205 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
206 elt = IGNORE_MULTIPLE_VALUES (call1 (test, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
207 return !NILP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
208 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
209
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
210 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
211 check_if_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
212 Lisp_Object UNUSED (item), Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
213 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
214 Lisp_Object args[] = { key, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
215 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
216
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
217 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
218 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
219 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
220 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
221 elt = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
222 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
223
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
224 return !NILP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
225 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
227 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
228 check_match_eq_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
229 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
230 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
231 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
232 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
234 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
235 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
236 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
237 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
238 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
239 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
240
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
241 return EQ (args[0], args[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
242 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
243
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
244 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
245 check_match_eql_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
246 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
248 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
249 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
250
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
251 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
252 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
253 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
254 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
255 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
256 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
257
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
258 return EQ (args[0], args[1]) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
259 (NON_FIXNUM_NUMBER_P (args[0]) && internal_equal (args[0], args[1], 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
262 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
263 check_match_equal_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
264 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
266 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
267 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
269 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
270 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
271 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
272 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
273 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
274 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
276 return internal_equal (args[0], args[1], 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
277 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
278
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
279 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
280 check_match_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
281 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
283 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
284 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
285
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
286 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
287 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
288 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
289 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
290 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
291 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
293 return internal_equalp (args[0], args[1], 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
294 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
295
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
296 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
297 check_match_other_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
298 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
300 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
301 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
302
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
303 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
304 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
305 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
306 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
307 args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
308 args[1] = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
309 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
310
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
311 elt1 = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
312 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
314 return !NILP (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
316
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
317 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
318 check_lss_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
319 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
320 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
321 return bytecode_arithcompare (elt1, elt2) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
324 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
325 check_lss_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
326 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
327 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
328 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
329 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
331 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
332 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
333 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
334 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
335 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
336 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
337
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
338 return bytecode_arithcompare (args[0], args[1]) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
339 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
340
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
341 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
342 check_lss_key_car (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
343 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
344 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
345 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
346
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
347 GCPRO2 (elt1, elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
348 elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
349 elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
350 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
351
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
352 return bytecode_arithcompare (elt1, elt2) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
353 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
354
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
355 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
356 check_string_lessp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
357 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
359 return !NILP (Fstring_lessp (elt1, elt2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
360 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
362 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
363 check_string_lessp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
364 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
365 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
366 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
367 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
369 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
370 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
371 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
372 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
373 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
374 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
376 return !NILP (Fstring_lessp (args[0], args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
377 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
378
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
379 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
380 check_string_lessp_key_car (Lisp_Object UNUSED (test),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
381 Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
382 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
384 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
386 GCPRO2 (elt1, elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
387 elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
388 elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
389 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
391 return !NILP (Fstring_lessp (elt1, elt2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
394 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
395 get_check_match_function_1 (Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
396 Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
397 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
398 Lisp_Object key, Boolint *test_not_unboundp_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
399 check_test_func_t *test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
401 Lisp_Object test = *test_inout;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
402 check_test_func_t result = NULL, test_func = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
403 Boolint force_if = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
405 if (!NILP (if_))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
406 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
407 if (!(NILP (test) && NILP (test_not) && NILP (if_not)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
408 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
409 invalid_argument ("only one keyword among :test :test-not "
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
410 ":if :if-not allowed", if_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
411 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
412
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
413 test = *test_inout = if_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
414 force_if = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
416 else if (!NILP (if_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
417 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
418 if (!(NILP (test) && NILP (test_not)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
419 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
420 invalid_argument ("only one keyword among :test :test-not "
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
421 ":if :if-not allowed", if_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
422 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
423
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
424 test_not = if_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
425 force_if = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
426 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
427
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
428 if (NILP (test))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
429 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
430 if (!NILP (test_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
431 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
432 test = *test_inout = test_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
433 if (NULL != test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
435 *test_not_unboundp_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
436 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
437 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
438 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
439 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
440 test = Qeql;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
441 if (NULL != test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
443 *test_not_unboundp_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
444 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
445 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
446 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
447 else if (!NILP (test_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
448 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
449 invalid_argument_2 ("conflicting :test and :test-not keyword arguments",
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
450 test, test_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
452
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
453 test = indirect_function (test, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
455 if (NILP (key) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
456 EQ (indirect_function (key, 1), XSYMBOL_FUNCTION (Qidentity)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
458 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
461 if (force_if)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
462 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
463 result = EQ (key, Qidentity) ? check_if_nokey : check_if_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
465 if (NULL != test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
466 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
467 *test_func_out = result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
468 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
470 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
473 if (!UNBOUNDP (item) && EQ (test, XSYMBOL_FUNCTION (Qeql)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
474 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
475 test = XSYMBOL_FUNCTION (NON_FIXNUM_NUMBER_P (item) ? Qequal : Qeq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
476 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
477
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
478 #define FROB(known_test, eq_condition) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
479 if (EQ (test, XSYMBOL_FUNCTION (Q##known_test))) do \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
480 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
481 if (eq_condition) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
482 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
483 test = XSYMBOL_FUNCTION (Qeq); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
484 goto force_eq_check; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
485 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
486 \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
487 if (!EQ (Qidentity, key)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
488 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
489 test_func = check_##known_test##_key; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
490 result = check_match_##known_test##_key; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
491 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
492 else \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
493 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
494 result = test_func = check_##known_test##_nokey; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
495 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
496 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
498 FROB (eql, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
499 else if (SUBRP (test))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
500 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
501 force_eq_check:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
502 FROB (eq, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
503 else FROB (equal, (SYMBOLP (item) || FIXNUMP (item) || CHARP (item)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
504 else FROB (equalp, (SYMBOLP (item)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
505 else if (EQ (test, XSYMBOL_FUNCTION (Qstring_match)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
506 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
507 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
508 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
509 test_func = result = check_string_match_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
511 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
512 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
513 test_func = check_string_match_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
514 result = check_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
515 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
517 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
519 if (NULL == result)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
521 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
522 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
523 test_func = result = check_other_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
524 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
525 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
526 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
527 test_func = check_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
528 result = check_match_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
529 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
530 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
532 if (NULL != test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
533 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
534 *test_func_out = test_func;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
535 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
537 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
538 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
539 #undef FROB
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
541 /* Given TEST, TEST_NOT, IF, IF_NOT, KEY, and ITEM, return a C function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
542 pointer appropriate for use in deciding whether a given element of a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
543 sequence satisfies TEST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
545 Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
546 if it was bound, and set *test_inout to the value it was bound to. If
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
547 TEST was not bound, leave *test_inout alone; the value is not used by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
548 check_eq_*key() or check_equal_*key(), which are the defaults, depending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
549 on the type of ITEM.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
550
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
551 The returned function takes arguments (TEST, KEY, ITEM, ELT), where ITEM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
552 is the item being searched for and ELT is the element of the sequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
553 being examined.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
554
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
555 Error if both TEST and TEST_NOT were specified, which Common Lisp says is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
556 undefined behaviour. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
558 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
559 get_check_test_function (Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
560 Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
561 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
562 Lisp_Object key, Boolint *test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
563 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
564 check_test_func_t result = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
565 get_check_match_function_1 (item, test_inout, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
566 key, test_not_unboundp_out, &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
567 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
568 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
569
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
570 /* Given TEST, TEST_NOT, IF, IF_NOT and KEY, return a C function pointer
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
571 appropriate for use in deciding whether two given elements of a sequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
572 satisfy TEST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
574 Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
575 if it was bound, and set *test_inout to the value it was bound to. If
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
576 TEST was not bound, leave *test_inout alone; the value is not used by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
577 check_eql_*key().
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
578
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
579 The returned function takes arguments (TEST, KEY, ELT1, ELT2), where ELT1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
580 and ELT2 are elements of the sequence being examined.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
582 The value that would be given by get_check_test_function() is returned in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
583 *TEST_FUNC_OUT, which allows calling functions to do their own key checks
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
584 if they're processing one element at a time.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
585
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
586 Error if both TEST and TEST_NOT were specified, which Common Lisp says is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
587 undefined behaviour. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
589 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
590 get_check_match_function (Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
591 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
592 Lisp_Object key, Boolint *test_not_unboundp_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
593 check_test_func_t *test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
595 return get_check_match_function_1 (Qunbound, test_inout, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
596 if_, if_not, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
597 test_not_unboundp_out, test_func_out);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
599
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
600 /* Given PREDICATE and KEY, return a C function pointer appropriate for use
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
601 in deciding whether one given element of a sequence is less than
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
602 another. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
604 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
605 get_merge_predicate (Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
606 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
607 predicate = indirect_function (predicate, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
608
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
609 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
610 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
611 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
612 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
613 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
614 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
615 key = indirect_function (key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
616 if (EQ (key, XSYMBOL_FUNCTION (Qidentity)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
617 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
618 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
619 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
620 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
621
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
622 if (EQ (key, Qidentity) && EQ (predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
623 XSYMBOL_FUNCTION (Qcar_less_than_car)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
624 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
625 key = XSYMBOL_FUNCTION (Qcar);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
626 predicate = XSYMBOL_FUNCTION (Qlss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
627 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
628
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
629 if (EQ (predicate, XSYMBOL_FUNCTION (Qlss)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
631 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
633 return check_lss_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
634 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
635
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
636 if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
637 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
638 return check_lss_key_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
640
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
641 return check_lss_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
643
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
644 if (EQ (predicate, XSYMBOL_FUNCTION (Qstring_lessp)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
645 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
646 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
647 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
648 return check_string_lessp_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
649 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
651 if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
653 return check_string_lessp_key_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
655
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
656 return check_string_lessp_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
657 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
658
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
659 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
661 return check_other_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
664 return check_match_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
666
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
667
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
668 static Lisp_Object string_count_from_end (Lisp_Object, Lisp_Object ,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
669 check_test_func_t, Boolint,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
670 Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
671 Lisp_Object, Lisp_Object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
672
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
673 static Lisp_Object list_count_from_end (Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
674 check_test_func_t, Boolint,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
675 Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
676 Lisp_Object, Lisp_Object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
677
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
678 /* Count the number of occurrences of ITEM in SEQUENCE; if SEQUENCE is a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
679 list, store the cons cell of which the car is the last ITEM in SEQUENCE,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
680 at the address given by tail_out. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
682 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
683 count_with_tail (Lisp_Object *tail_out, int nargs, Lisp_Object *args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
684 Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
686 Lisp_Object item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
687 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
688 Elemcount len, ii = 0, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
689 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
690 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
692 PARSE_KEYWORDS_8 (caller, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
693 (test, key, start, end, from_end, test_not, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
694 if_, if_not), (start = Qzero), 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
696 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
697 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
698 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
700 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
701 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
702 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
703 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
706 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
707 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
708 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
709 counting = BIGNUMP (count) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
711 /* Our callers should have filtered out non-positive COUNT. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
712 assert (counting >= 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
713 /* And we're not prepared to handle COUNT from any other caller at the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
714 moment. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
715 assert (EQ (caller, QremoveX)|| EQ (caller, QdeleteX));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
716 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
718 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
719 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
721 *tail_out = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
722
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
723 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
724 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
725 if (EQ (caller, Qcount) && !NILP (from_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
726 && (!EQ (key, Qnil) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
727 check_test == check_other_nokey || check_test == check_if_nokey))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
728 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
729 /* #'count, #'count-if, and #'count-if-not are documented to have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
730 a given traversal order if :from-end t is passed in, even
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
731 though forward traversal of the sequence has the same result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
732 and is algorithmically less expensive for lists and strings.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
733 This order isn't necessary for other callers, though. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
734 return list_count_from_end (item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
735 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
736 start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
738
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
739 /* If COUNT is non-nil and FROM-END is t, we can give the tail
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
740 containing the last match, since that's what #'remove* is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
741 interested in (a zero or negative COUNT won't ever reach
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
742 count_with_tail(), our callers will return immediately on seeing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
743 it). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
744 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
745 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
746 counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
747 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
749 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
750 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
751 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
752 if (!(ii < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
753 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
754 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
755 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
756
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
757 if (starting <= ii &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
758 check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
759 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
760 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
761 *tail_out = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
763 if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
764 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
765 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
766 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
767 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
768
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
769 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
770 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
771 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
772 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
774 if ((ii < starting || (ii < ending && !NILP (end))) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
775 encountered != counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
776 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
777 check_sequence_range (args[1], start, end, Flength (args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
778 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
779 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
780 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
781 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
782 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
783 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
784 Lisp_Object character = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
785
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
786 if (EQ (caller, Qcount) && !NILP (from_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
787 && (!EQ (key, Qnil) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
788 check_test == check_other_nokey || check_test == check_if_nokey))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
789 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
790 /* See comment above in the list code. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
791 return string_count_from_end (item, sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
792 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
793 test, key, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
794 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
796 while (cursor_offset < byte_len && ii < ending && encountered < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
797 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
798 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
799 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
800 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
801
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
802 if (check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
803 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
804 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
805 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
806 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
807
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
808 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
809 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
810 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
811 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
812 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
813 mapping_interaction_error (caller, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
814 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
815 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
817 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
818 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
819 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
820 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
821
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
822 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
823 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
824 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
825 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
827 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
829 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
831 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
832 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
834 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
835 if (0 == len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
836 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
837 /* Catches the case where we have nil. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
838 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
839 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
840
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
841 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
842 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
843 for (ii = starting; ii < ending && encountered < counting; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
845 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
846 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
847 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
848 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
849 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
850 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
851 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
852 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
853 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
854 for (ii = ending - 1; ii >= starting && encountered < counting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
855 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
856 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
857 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
858 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
859 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
860 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
861 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
862 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
863 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
864
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
865 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
866 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
867
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
868 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
869 list_count_from_end (Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
870 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
871 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
872 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
873 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
874 Elemcount length = XFIXNUM (Flength (sequence)), ii = 0, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
875 Elemcount ending = NILP (end) ? length : XFIXNUM (end), encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
876 Lisp_Object *storage;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
877 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
878
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
879 check_sequence_range (sequence, start, end, make_integer (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
880
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
881 storage = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
882
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
883 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
884 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
885 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
886 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
887 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
888 storage[ii - starting] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
889 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
890 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
891 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
892 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
893
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
894 GCPRO1 (storage[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
895 gcpro1.nvars = ending - starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
897 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
898 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
899 if (check_test (test, key, item, storage[ii - starting])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
900 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
901 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
902 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
903 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
904 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
905
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
906 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
908 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
909 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
910
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
911 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
912 string_count_from_end (Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
913 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
914 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
915 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
917 Elemcount length = string_char_length (sequence), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
918 Elemcount starting = XFIXNUM (start), ending = NILP (end) ? length : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
919 Elemcount encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
920 Ibyte *cursor = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
921 Ibyte *endp = cursor + XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
922 Ichar *storage;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
923
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
924 check_sequence_range (sequence, start, end, make_integer (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
925
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
926 storage = alloca_array (Ichar, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
927
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
928 while (cursor < endp && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
929 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
930 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
931 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
932 storage [ii - starting] = itext_ichar (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
933 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
935 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
936 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
937 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
938
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
939 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
941 if (check_test (test, key, item, make_char (storage [ii - starting]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
942 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
944 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
945 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
946 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
947
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
948 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
949 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
951 DEFUN ("count", Fcount, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
952 Count the number of occurrences of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
954 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
955
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
956 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
957 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
958 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
959 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
960 Lisp_Object tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
961
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
962 /* count_with_tail() accepts more keywords than we do, check those we've
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
963 been given. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
964 PARSE_KEYWORDS (Fcount, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
965 (test, test_not, if_, if_not, key, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
966 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
968 return count_with_tail (&tail, nargs, args, Qcount);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
969 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
970
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
971 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
972 Return the subsequence of SEQUENCE starting at START and ending before END.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
973 END may be omitted; then the subsequence runs to the end of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
974
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
975 If START or END is negative, it counts from the end, in contravention of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
976 Common Lisp.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
977 The returned subsequence is always of the same type as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
978 If SEQUENCE is a string, relevant parts of the string-extent-data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
979 are copied to the new string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
980
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
981 See also `substring-no-properties', which only operates on strings, and does
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
982 not copy extent data.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
983 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
984 (sequence, start, end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
985 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
986 Elemcount len, ss, ee = MOST_POSITIVE_FIXNUM, ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
987 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
988
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
989 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
990 CHECK_FIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
991 ss = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
992
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
993 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
994 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
995 CHECK_FIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
996 ee = XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
997 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
998
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
999 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1000 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1001 Bytecount bstart, blen;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1002
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1003 get_string_range_char (sequence, start, end, &ss, &ee,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1004 GB_HISTORICAL_STRING_BEHAVIOR);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1005 bstart = string_index_char_to_byte (sequence, ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1006 blen = string_offset_char_to_byte_len (sequence, bstart, ee - ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1007
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1008 result = make_string (XSTRING_DATA (sequence) + bstart, blen);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1009 /* Copy any applicable extent information into the new string. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1010 copy_string_extents (result, sequence, 0, bstart, blen);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1012 else if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1013 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1014 Lisp_Object result_tail, saved = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1016 if (ss < 0 || ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1017 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1018 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1019 if (ss < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1020 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1021 ss = len + ss;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1022 start = make_integer (ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1023 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1025 if (ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1026 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1027 ee = len + ee;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1028 end = make_integer (ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1029 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1030 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1031 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1032 ee = min (ee, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1033 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1034 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1036 if (0 != ss)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1037 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1038 sequence = Fnthcdr (make_fixnum (ss), sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1039 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1041 ii = ss + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1043 if (ss < ee && !NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1045 result = result_tail = Fcons (Fcar (sequence), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1046 sequence = Fcdr (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1047
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1048 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1049 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1050 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1051 if (!(ii < ee))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1052 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1053 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1054 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1055
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1056 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1057 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1058 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1059 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1060 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1061 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1062
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1063 if (NILP (result) || (ii < ee && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1064 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1065 /* We were handed a cons, which definitely has elements. nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1066 result means either ss >= ee or SEQUENCE was nil after the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1067 nthcdr; in both cases that means START and END were incorrectly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1068 specified for this sequence. ii < ee with a non-nil end means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1069 the user handed us a bogus end value. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1070 check_sequence_range (saved, start, end, Flength (saved));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1071 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1072 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1073 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1074 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1075 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1076 if (ss < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1077 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1078 ss = len + ss;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1079 start = make_integer (ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1080 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1081
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1082 if (ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1083 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1084 ee = len + ee;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1085 end = make_integer (ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1086 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1087 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1088 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1089 ee = min (len, ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1090 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1091
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1092 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1093
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1094 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1095 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1096 result = Fvector (ee - ss, XVECTOR_DATA (sequence) + ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1097 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1098 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1099 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1100 result = make_bit_vector (ee - ss, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1101
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1102 for (ii = ss; ii < ee; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1103 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1104 set_bit_vector_bit (XBIT_VECTOR (result), ii - ss,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1105 bit_vector_bit (XBIT_VECTOR (sequence), ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1106 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1107 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1108 else if (NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1109 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1110 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1111 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1112 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1113 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1114 /* Won't happen, since CHECK_SEQUENCE didn't error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1115 ABORT ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1116 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1117 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1118
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1119 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1120 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1121
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1122 DEFUN ("elt", Felt, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1123 Return element of SEQUENCE at index N.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1124 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1125 (sequence, n))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1127 /* This function can GC */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1128 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1129 CHECK_FIXNUM_COERCE_CHAR (n); /* yuck! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1130 if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1131 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1132 Lisp_Object tem = Fnthcdr (n, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1133 /* #### Utterly, completely, fucking disgusting.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1134 * #### The whole point of "elt" is that it operates on
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1135 * #### sequences, and does error- (bounds-) checking.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1136 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1137 if (CONSP (tem))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1138 return XCAR (tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1139 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1140 #if 1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1141 /* This is The Way It Has Always Been. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1142 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1143 #else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1144 /* This is The Way Mly and Cltl2 say It Should Be. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1145 args_out_of_range (sequence, n);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1146 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1148 else if (STRINGP (sequence) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1149 VECTORP (sequence) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1150 BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1151 return Faref (sequence, n);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1152 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1153 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1154 check_losing_bytecode ("elt", sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1155 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1156 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1157 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1158 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1159
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1160 DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1161 Return a copy of a list and substructures.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1162 The argument is copied, and any lists contained within it are copied
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1163 recursively. Circularities and shared substructures are not preserved.
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1164 Second arg VECTORP causes vectors to be copied, too. Strings and bit
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1165 vectors are not copied.
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1166 */
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1167 (arg, vectorp))
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1168 {
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1169 return safe_copy_tree (arg, vectorp, 0);
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1170 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1171
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1172 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1173 safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1174 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1175 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1176 stack_overflow ("Stack overflow in copy-tree", arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1177
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1178 if (CONSP (arg))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1179 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1180 Lisp_Object rest;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1181 rest = arg = Fcopy_sequence (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1182 while (CONSP (rest))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1183 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1184 Lisp_Object elt = XCAR (rest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1185 QUIT;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1186 if (CONSP (elt) || VECTORP (elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1187 XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1188 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1189 XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1190 rest = XCDR (rest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1191 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1192 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1193 else if (VECTORP (arg) && ! NILP (vecp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1194 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1195 int i = XVECTOR_LENGTH (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1196 int j;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1197 arg = Fcopy_sequence (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1198 for (j = 0; j < i; j++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1199 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1200 Lisp_Object elt = XVECTOR_DATA (arg) [j];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1201 QUIT;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1202 if (CONSP (elt) || VECTORP (elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1203 XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1204 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1205 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1206 return arg;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1207 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1208
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1209 DEFUN ("member", Fmember, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1210 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1211 The value is actually the tail of LIST whose car is ELT.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1212 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1213 (elt, list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1214 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1215 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1216 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1217 if (internal_equal (elt, list_elt, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1218 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1219 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1220 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1221 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1222
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1223 DEFUN ("memq", Fmemq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1224 Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1225 The value is actually the tail of LIST whose car is ELT.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1226 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1227 (elt, list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1228 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1229 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1230 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1231 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1232 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1233 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1234 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1235 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1236
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1237 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1238 memq_no_quit (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1239 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1240 LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1241 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1242 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1243 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1244 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1245 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1246 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1247
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1248 /* Return the first index of ITEM in LIST. In CONS_OUT, return the cons cell
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1249 before that containing the element. If the element is in the first cons
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1250 cell, return Qnil in CONS_OUT. TEST, KEY, START, END are as in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1251 #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should have been initialized
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1252 with get_check_match_function() or get_check_test_function(). A non-zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1253 REVERSE_TEST_ORDER means call TEST with the element from LIST as its
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1254 first argument and ITEM as its second. Error if LIST is ill-formed, or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1255 circular. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1256 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1257 list_position_cons_before (Lisp_Object *cons_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1258 Lisp_Object item, Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1259 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1260 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1261 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1262 Boolint reverse_test_order,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1263 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1264 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1265 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1266 Lisp_Object tail_before = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1267 Elemcount ii = 0, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1268 Elemcount ending = NILP (end) ? MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1269
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1270 GCPRO1 (tail_before);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1271
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1272 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1273 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1274 /* TEST is #'eq, no need to call any C functions, and the test order
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1275 won't be visible. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1276 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1278 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1279 EQ (item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1280 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1281 *cons_out = tail_before;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1282 RETURN_UNGCPRO (make_integer (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1283 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1284 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1286 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1287 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1288 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1289 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1290 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1291 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1292 tail_before = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1293 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1294 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1295 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1296 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1297 GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1298 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1299 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1300 (reverse_test_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1301 check_test (test, key, elt, item) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1302 check_test (test, key, item, elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1303 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1304 *cons_out = tail_before;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1305 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1306 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1307 return make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1308 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1309 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1310 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1311 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1312 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1313 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1314 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1316 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1317 tail_before = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1318 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1319 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1320 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1321
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1322 RETURN_UNGCPRO (Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1323 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1324
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1325 DEFUN ("member*", FmemberX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1326 Return the first sublist of LIST with car ITEM, or nil if no such sublist.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1327
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1328 The keyword :test specifies a two-argument function that is used to compare
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1329 ITEM with elements in LIST; if omitted, it defaults to `eql'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1331 The keyword :test-not is similar, but specifies a negated function. That
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1332 is, ITEM is considered equal to an element in LIST if the given function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1333 returns nil. Common Lisp deprecates :test-not, and if both are specified,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1334 XEmacs signals an error.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1335
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1336 :key specifies a one-argument function that transforms elements of LIST into
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1337 \"comparison keys\" before the test predicate is applied. For example,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1338 if :key is #'car, then ITEM is compared with the car of elements from LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1339 The :key function, however, is not applied to ITEM, and does not affect the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1340 elements in the returned list, which are taken directly from the elements in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1341 LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1342
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1343 arguments: (ITEM LIST &key (TEST #'eql) TEST-NOT (KEY #'identity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1344 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1345 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1346 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1347 Lisp_Object item = args[0], list = args[1], result = Qnil, position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1348 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1349 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1350
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1351 PARSE_KEYWORDS (FmemberX, nargs, args, 5, (test, if_not, if_, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1352 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1353 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1354 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1355 position0
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1356 = list_position_cons_before (&result, item, list, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1357 test_not_unboundp, test, key, 0, Qzero, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1358
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1359 return CONSP (result) ? XCDR (result) : ZEROP (position0) ? list : Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1360 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1362 /* This macro might eventually find a better home than here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1363
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1364 #define CHECK_KEY_ARGUMENT(key) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1365 do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1366 if (NILP (key)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1367 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1368 key = Qidentity; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1369 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1370 \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1371 if (!EQ (key, Qidentity)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1372 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1373 key = indirect_function (key, 1); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1374 if (EQ (key, XSYMBOL_FUNCTION (Qidentity))) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1375 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1376 key = Qidentity; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1377 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1378 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1379 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1380
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1381 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1382 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1383
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1384 DEFUN ("adjoin", Fadjoin, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1385 Return ITEM consed onto the front of LIST, if not already in LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1387 Otherwise, return LIST unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1388
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1389 See `member*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1391 arguments: (ITEM LIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1392 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1393 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1395 Lisp_Object item = args[0], list = args[1], keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1396 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1397 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1398 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1399
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1400 PARSE_KEYWORDS (Fadjoin, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1401 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1402
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1403 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1405 keyed = KEY (key, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1406
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1407 GCPRO1 (keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1408 check_test = get_check_test_function (keyed, &test, test_not, Qnil, Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1409 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1410 if (NILP (list_position_cons_before (&ignore, keyed, list, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1411 test_not_unboundp, test, key, 0, Qzero,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1412 Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1413 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1414 RETURN_UNGCPRO (Fcons (item, list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1417 RETURN_UNGCPRO (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1418 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1419
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1420 DEFUN ("assoc", Fassoc, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1421 Return non-nil if KEY is `equal' to the car of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1422 The value is actually the element of ALIST whose car equals KEY.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1423 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1424 (key, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1425 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1426 /* This function can GC. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1427 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1428 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1429 if (internal_equal (key, elt_car, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1430 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1431 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1432 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1433 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1434
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1435 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1436 assoc_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1437 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1438 int speccount = specpdl_depth ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1439 specbind (Qinhibit_quit, Qt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1440 return unbind_to_1 (speccount, Fassoc (key, alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1441 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1442
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1443 DEFUN ("assq", Fassq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1444 Return non-nil if KEY is `eq' to the car of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1445 The value is actually the element of ALIST whose car is KEY.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1446 Elements of ALIST that are not conses are ignored.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1447 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1448 (key, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1450 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1451 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1452 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1453 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1454 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1455 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1456 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1458 /* Like Fassq but never report an error and do not allow quits.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1459 Use only on lists known never to be circular. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1461 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1462 assq_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1463 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1464 /* This cannot GC. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1465 LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1466 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1467 Lisp_Object elt_car = XCAR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1468 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1469 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1470 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1471 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1472 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1473
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1474 DEFUN ("assoc*", FassocX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1475 Find the first item whose car matches ITEM in ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1477 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1478
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1479 arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1480 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1481 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1482 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1483 Lisp_Object item = args[0], alist = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1484 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1485 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1486
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1487 PARSE_KEYWORDS (FassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1488 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1489
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1490 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1491 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1492
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1493 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1494 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1495 /* TEST is #'eq, no need to call any C functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1496 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1497 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1498 if (EQ (item, elt_car) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1499 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1500 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1501 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1502 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1503 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1504 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1505 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1506 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1507 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1508 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1509 check_test (test, key, item, XCAR (elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1510 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1511 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1512 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1513 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1514 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1515 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1518 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1519 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1520
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1521 DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1522 Return non-nil if VALUE is `equal' to the cdr of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1523 The value is actually the element of ALIST whose cdr equals VALUE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1524 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1525 (value, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1526 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1527 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1528 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1529 if (internal_equal (value, elt_cdr, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1530 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1531 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1532 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1533 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1534
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1535 DEFUN ("rassq", Frassq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1536 Return non-nil if VALUE is `eq' to the cdr of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1537 The value is actually the element of ALIST whose cdr is VALUE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1538 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1539 (value, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1540 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1541 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1542 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1543 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1544 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1545 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1546 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1547 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1548
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1549 /* Like Frassq, but caller must ensure that ALIST is properly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1550 nil-terminated and ebola-free. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1551 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1552 rassq_no_quit (Lisp_Object value, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1553 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1554 LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1555 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1556 Lisp_Object elt_cdr = XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1557 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1558 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1559 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1560 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1561 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1562
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1563 DEFUN ("rassoc*", FrassocX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1564 Find the first item whose cdr matches ITEM in ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1565
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1566 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1567
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1568 arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1569 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1570 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1571 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1572 Lisp_Object item = args[0], alist = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1573 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1574 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1575
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1576 PARSE_KEYWORDS (FrassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1577 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1578
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1579 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1580 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1582 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1583 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1584 /* TEST is #'eq, no need to call any C functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1585 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1586 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1587 if (EQ (item, elt_cdr) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1589 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1590 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1591 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1592 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1593 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1595 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1596 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1597 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1598 check_test (test, key, item, XCDR (elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1599 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1600 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1601 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1603 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1604 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1605 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1606
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1607 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1608 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1609
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1610 /* This is the implementation of both #'find and #'position. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1611 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1612 position (Lisp_Object *object_out, Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1613 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1614 Lisp_Object test, Lisp_Object key, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1615 Lisp_Object from_end, Lisp_Object default_, Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1616 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1617 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1618 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, len, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1619
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1620 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1621 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1622 starting = FIXNUMP (start) ? XFIXNUM (start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1623
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1624 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1626 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1627 ending = FIXNUMP (end) ? XFIXNUM (end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1628 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1629
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1630 *object_out = default_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1631
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1632 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1633 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1634 if (!(starting < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1635 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1636 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1637 /* starting could be equal to ending, in which case nil is what
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1638 we want to return. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1639 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1640 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1641
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1642 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1643 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1644 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1645 if (starting <= ii && ii < ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1646 && check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1647 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1648 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1649 *object_out = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1651 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1653 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1654 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1655 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1656 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1657 else if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1658 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1659 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1660 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1661
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1662 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1663 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1664 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1666
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1667 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1669 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1670 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1671 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1672 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1673 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1674 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1675 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1676 Lisp_Object character = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1677
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1678 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1679 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1680 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1681 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1682 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1683
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1684 if (check_test (test, key, item, character) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1686 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1687 *object_out = character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1688
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1689 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1690 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1691 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1692 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1693 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1695 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1696 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1697 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1698 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1699 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1700 mapping_interaction_error (caller, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1701 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1703
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1704 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1705 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1706 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1707 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1708
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1709 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1710 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1711 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1713 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1714 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1715 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1716 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1717 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1718 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1719
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1720 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1721 if (0 == len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1722 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1723 /* Catches the case where we have nil. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1724 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1725 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1726
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1727 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1728 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1729 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1730 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1731 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1732 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1733 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1734 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1735 *object_out = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1736 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1738 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1739 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1740 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1741 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1742 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1743 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1744 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1745 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1746 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1747 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1748 *object_out = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1749 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1750 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1751 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1752 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1753 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1754
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1755 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1756 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1757
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1758 DEFUN ("position", Fposition, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1759 Return the index of the first occurrence of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1760
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1761 Return nil if not found. See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1763 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1764 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1765 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1766 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1767 Lisp_Object object = Qnil, item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1768 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1769 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1770
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1771 PARSE_KEYWORDS (Fposition, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1772 (test, if_, test_not, if_not, key, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1773 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1775 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1776 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1777
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1778 return position (&object, item, sequence, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1779 test, key, start, end, from_end, Qnil, Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1780 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1781
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1782 DEFUN ("find", Ffind, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1783 Find the first occurrence of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1785 Return the matching ITEM, or nil if not found. See `remove*' for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1786 meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1787
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1788 The keyword :default, not specified by Common Lisp, designates an object to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1789 return instead of nil if ITEM is not found.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1790
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1791 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) DEFAULT FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1792 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1793 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1794 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1795 Lisp_Object object = Qnil, item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1796 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1797 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1798
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1799 PARSE_KEYWORDS (Ffind, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1800 (test, if_, test_not, if_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1801 default_),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1802 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1803
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1804 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1805 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1806
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1807 position (&object, item, sequence, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1808 test, key, start, end, from_end, default_, Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1810 return object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1811 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1812
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1813 /* Like #'delq, but caller must ensure that LIST is properly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1814 nil-terminated and ebola-free. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1815
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1816 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1817 delq_no_quit (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1818 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1819 LIST_LOOP_DELETE_IF (list_elt, list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1820 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1821 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1822 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1823
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1824 /* Be VERY careful with this. This is like delq_no_quit() but
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1825 also calls free_cons() on the removed conses. You must be SURE
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1826 that no pointers to the freed conses remain around (e.g.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1827 someone else is pointing to part of the list). This function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1828 is useful on internal lists that are used frequently and where
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1829 the actual list doesn't escape beyond known code bounds. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1831 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1832 delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1833 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1834 REGISTER Lisp_Object tail = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1835 REGISTER Lisp_Object prev = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1836
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1837 while (!NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1838 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1839 REGISTER Lisp_Object tem = XCAR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1840 if (EQ (elt, tem))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1841 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1842 Lisp_Object cons_to_free = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1843 if (NILP (prev))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1844 list = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1845 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1846 XCDR (prev) = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1847 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1848 free_cons (cons_to_free);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1849 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1850 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1851 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1852 prev = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1853 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1854 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1855 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1856 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1857 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1859 DEFUN ("delete*", FdeleteX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1860 Remove all occurrences of ITEM in SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1861
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1862 If SEQUENCE is a non-nil list, this modifies the list directly. A non-list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1863 SEQUENCE will not be destructively modified, rather, if ITEM occurs in it, a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1864 new SEQUENCE of the same type without ITEM will be returned.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1865
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1866 See `remove*' for a non-destructive alternative, and for explanation of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1867 keyword arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1868
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1869 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1870 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1871 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1872 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1873 Lisp_Object item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1874 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1875 Elemcount len, ii = 0, encountered = 0, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1876 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1877 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1878
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1879 PARSE_KEYWORDS (FdeleteX, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1880 (test, if_not, if_, test_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1881 count), (start = Qzero, count = Qunbound));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1882
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1883 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1884 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1885 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1886
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1887 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1888 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1889 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1890 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1891 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1892
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1893 if (!UNBOUNDP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1895 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1896 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1897 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1898 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1899 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1900 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1901 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1902 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1903 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1904 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1905 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1906 1 + MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1907 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1908 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1909
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1910 if (counting < 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1911 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1912 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1913 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1914
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1915 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1917 /* Sigh, this is inelegant. Force count_with_tail () to ignore
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1918 the count keyword, so we get the actual number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1919 elements, and can start removing from the beginning for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1920 from-end case. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1921 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FdeleteX))->min_args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1922 ii < nargs; ii += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1923 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1924 if (EQ (args[ii], Q_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1925 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1926 args[ii + 1] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1927 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1928 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1929 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1930 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1931 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1932 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1933 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1935 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1936 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1937
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1938 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1939 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1940 Lisp_Object prev_tail_list_elt = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1941 Elemcount list_len = 0, deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1942 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1944 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1945 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1946 /* Both COUNT and FROM-END were specified; we need to traverse the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1947 list twice. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1948 Lisp_Object present = count_with_tail (&ignore, nargs, args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1949 QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1951 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1952 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1953 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1954 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1955
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1956 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1957
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1958 /* If there are fewer items in the list than we have permission to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1959 delete, we don't need to differentiate between the :from-end
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1960 nil and :from-end t cases. Otherwise, presenting is the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1961 of matching items we need to ignore before we start to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1962 delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1963 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1965
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1966 GCPRO1 (prev_tail_list_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1967 ii = -1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1968
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1969 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1970 GC_EXTERNAL_LIST_LOOP_4 (list_elt, sequence, tail, list_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1971 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1972 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1973
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1974 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1975 (check_test (test, key, item, list_elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1976 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1977 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1978 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1979 if (NILP (prev_tail_list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1981 sequence = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1982 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1983 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1984 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1985 XSETCDR (prev_tail_list_elt, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1986 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1987
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1988 /* Keep tortoise from ever passing hare. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1989 list_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1990 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1992 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1993 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1994 prev_tail_list_elt = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1995 if (ii >= ending || (!presenting && encountered > counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1996 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1997 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1998 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2000 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2001 END_GC_EXTERNAL_LIST_LOOP (list_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2002 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2003
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2004 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2005
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2006 if ((ii < starting || (ii < ending && !NILP (end))) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2007 !(presenting ? encountered == presenting : encountered == counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2008 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2009 check_sequence_range (args[1], start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2010 make_fixnum (deleted + XFIXNUM (Flength (args[1]))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2013 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2014 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2015 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2016 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2017 Ibyte *staging = alloca_ibytes (XSTRING_LENGTH (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2018 Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2019 Ibyte *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2020 Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2021 Lisp_Object character, result = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2022
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2023 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2024 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2025 Lisp_Object present = count_with_tail (&character, nargs, args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2026 QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2027
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2028 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2029 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2030 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2031 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2032
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2033 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2034
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2035 /* If there are fewer items in the list than we have permission to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2036 delete, we don't need to differentiate between the :from-end
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2037 nil and :from-end t cases. Otherwise, presenting is the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2038 of matching items we need to ignore before we start to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2039 delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2040 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2041 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2043 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2044 while (cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2045 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2046 if (ii >= starting && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2047 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2048 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2049
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2050 if ((check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2051 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2052 && (presenting ? encountered++ >= presenting :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2053 encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2054 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2055 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2056 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2057 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2058 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2059 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2060 += set_itext_ichar (staging_cursor, XCHAR (character));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2061 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2062
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2063 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2064 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2065 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2066 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2067 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2068 mapping_interaction_error (QdeleteX, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2070 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2071 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2072 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2073 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2074 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2075
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2076 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2077 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2078 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2080
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2081 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2082 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2083 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2084 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2085
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2086 if (0 != encountered)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2087 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2088 result = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2089 copy_string_extents (result, sequence, 0, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2090 staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2091 sequence = result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2092 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2093
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2094 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2095 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2096 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2097 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2098 Lisp_Object position0 = Qnil, object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2099 Lisp_Object *staging = NULL, *staging_cursor, *staging_limit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2100 Elemcount positioning;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2101
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2102 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2103
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2104 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2105
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2106 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2107 test_not_unboundp, test, key, start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2108 from_end, Qnil, QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2109 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2111 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2112 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2113
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2114 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2115 positioning = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2116 encountered = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2117
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2118 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2119 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2120 staging = alloca_array (Lisp_Object, len - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2121 staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2122
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2123 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2124 while (ii < positioning)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2126 *staging_cursor++ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2127 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2129
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2130 ii = positioning + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2131 while (ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2132 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2133 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2134 if (encountered < counting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2135 && (check_test (test, key, item, object)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2136 == test_not_unboundp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2137 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2138 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2139 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2140 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2141 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2142 *staging_cursor++ = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2143 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2144 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2146
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2147 while (ii < len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2148 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2149 *staging_cursor++ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2150 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2151 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2153 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2154 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2155 staging = alloca_array (Lisp_Object, len - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2156 staging_cursor = staging_limit = staging + len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2157
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2158 ii = len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2159 while (ii > positioning)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2161 *--staging_cursor = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2162 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2163 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2164
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2165 ii = positioning - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2166 while (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2167 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2168 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2169 if (encountered < counting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2170 && (check_test (test, key, item, object) ==
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2171 test_not_unboundp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2172 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2173 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2174 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2175 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2176 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2177 *--staging_cursor = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2178 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2179
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2180 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2181 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2182
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2183 while (ii >= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2184 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2185 *--staging_cursor = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2186 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2187 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2188
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2189 staging = staging_cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2190 staging_cursor = staging_limit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2191 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2192
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2193 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2194 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2195 return Fvector (staging_cursor - staging, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2196 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2197 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2198 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2199 return Fbit_vector (staging_cursor - staging, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2202 /* A nil sequence will have given us a nil #'position,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2203 above. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2204 ABORT ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2206 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2207 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2208 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2209
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2210 DEFUN ("remove*", FremoveX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2211 Remove all occurrences of ITEM in SEQUENCE, non-destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2212
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2213 If SEQUENCE is a list, `remove*' makes a copy if that is necessary to avoid
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2214 corrupting the original SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2215
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2216 The keywords :test and :test-not specify two-argument test and negated-test
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2217 predicates, respectively; :test defaults to `eql'. :key specifies a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2218 one-argument function that transforms elements of SEQUENCE into \"comparison
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2219 keys\" before the test predicate is applied. See `member*' for more
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2220 information on these keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2221
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2222 :start and :end, if given, specify indices of a subsequence of SEQUENCE to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2223 be processed. Indices are 0-based and processing involves the subsequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2224 starting at the index given by :start and ending just before the index given
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2225 by :end.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2227 :count, if given, limits the number of items removed to the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2228 specified. :from-end, if given, causes processing to proceed starting from
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2229 the end instead of the beginning; in this case, this matters only if :count
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2230 is given.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2231
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2232 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2233 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2234 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2235 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2236 Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2237 tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2238 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2239 Elemcount ii = 0, encountered = 0, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2240 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2241 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2242
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2243 PARSE_KEYWORDS (FremoveX, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2244 (test, if_not, if_, test_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2245 count), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2246
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2247 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2248 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2249 return FdeleteX (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2250 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2251
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2252 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2253 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2254
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2255 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2256 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2257 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2258 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2259 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2260
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2261 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2262 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2263 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2264 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2266 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2267 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2268 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2269 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2270 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2271 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2272 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2273 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2274 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2276 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2278 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2279 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2280
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2281 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2283 /* Sigh, this is inelegant. Force count_with_tail () to ignore the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2284 count keyword, so we get the actual number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2285 elements, and can start removing from the beginning for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2286 from-end case. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2287 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FremoveX))->min_args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2288 ii < nargs; ii += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2289 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2290 if (EQ (args[ii], Q_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2291 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2292 args[ii + 1] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2293 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2294 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2295 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2296 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2297 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2298 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2299
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2300 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2301 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2302
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2303 matched_count = count_with_tail (&tail, nargs, args, QremoveX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2304
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2305 if (!ZEROP (matched_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2306 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2307 Lisp_Object result = Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2308 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2309
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2310 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2311 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2312 presenting = XFIXNUM (matched_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2314 /* If there are fewer matching elements in the list than we have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2315 permission to delete, we don't need to differentiate between
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2316 the :from-end nil and :from-end t cases. Otherwise, presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2317 is the number of matching items we need to ignore before we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2318 start to delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2319 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2320 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2321
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2322 GCPRO2 (result, tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2323 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2324 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2325 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2326 if (EQ (tail, tailing))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2327 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2328 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2329 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2331 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2332 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2333 return XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2334 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2335
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2336 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2337 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2338 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2339 else if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2340 (check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2341 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2342 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2344 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2345 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2346 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2347 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2348 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2349 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2350 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2351 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2352 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2353 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2354 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2355
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2356 if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2357 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2358 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2359 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2360
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2361 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2363 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2364 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2365 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2366
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2367 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2368 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2369 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2370 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2371
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2372 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2373 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2374
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2375 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2376 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2377
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2378 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2379 remassoc_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2380 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2381 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2382 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2383 internal_equal (key, XCAR (elt), 0)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2384 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2385 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2387 /* no quit, no errors; be careful */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2388
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2389 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2390 remassq_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2391 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2392 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2393 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2394 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2395 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2396 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2397
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2398 /* Like Fremrassq, fast and unsafe; be careful */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2399 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2400 remrassq_no_quit (Lisp_Object value, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2401 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2402 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2403 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2404 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2405 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2406 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2407
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2408 /* Remove duplicate elements between START and END from LIST, a non-nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2409 list; if COPY is zero, do so destructively. Items to delete are selected
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2410 according to the algorithm used when :from-end t is passed to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2411 #'delete-duplicates. Error if LIST is ill-formed or circular.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2412
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2413 TEST and KEY are as in #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2414 reflect them, having been initialised with get_check_match_function() or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2415 get_check_test_function(). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2416 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2417 list_delete_duplicates_from_end (Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2418 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2419 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2420 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2421 Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2422 Lisp_Object end, Boolint copy)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2423 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2424 Lisp_Object checking = Qnil, result = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2425 Lisp_Object keyed, positioned, position_cons = Qnil, result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2426 Elemcount len = XFIXNUM (Flength (list)), pos, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2427 Elemcount ending = (NILP (end) ? len : XFIXNUM (end)), greatest_pos_seen = -1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2428 Elemcount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2429 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2430
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2431 /* We can't delete (or remove) as we go, because that breaks START and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2432 END. We could if END were nil, and that would change an ON(N + 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2433 algorithm to an ON^2 algorithm. Here and now it doesn't matter, though,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2434 #'delete-duplicates is relatively expensive no matter what. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2435 struct Lisp_Bit_Vector *deleting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2436 = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2437 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2438 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2439 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2441 check_sequence_range (list, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2442
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2443 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2444 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2445 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2446
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2447 GCPRO1 (keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2448
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2450 GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2451 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2452 if (!(starting <= ii && ii <= ending) || bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2453 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2454 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2455 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2456 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2458 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2459 checking = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2460 pos = ii + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2461
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2462 while (!NILP ((positioned = list_position_cons_before
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2463 (&position_cons, keyed, checking, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2464 test_not_unboundp, test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2465 make_fixnum (max (starting - pos, 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2466 make_fixnum (ending - pos)))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2467 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2468 pos = XFIXNUM (positioned) + pos;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2469 set_bit_vector_bit (deleting, pos, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2470 greatest_pos_seen = max (greatest_pos_seen, pos);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2471 checking = NILP (position_cons) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2472 XCDR (checking) : XCDR (XCDR (position_cons));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2473 pos += 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2474 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2475 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2476 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2477 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2478 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2479
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2480 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2481
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2482 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2484 if (greatest_pos_seen > -1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2485 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2486 if (copy)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2487 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2488 result = result_tail = Fcons (XCAR (list), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2489 list = XCDR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2490 ii = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2492 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2493 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2494 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2495 if (ii == greatest_pos_seen)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2496 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2497 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2498 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2500 else if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2501 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2502 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2503 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2504 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2505 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2506 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2507 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2508 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2509 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2510 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2511 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2512 bit_vector_bit (deleting, ii++));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2513 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2514 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2515
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2516 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2517 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2519 DEFUN ("delete-duplicates", Fdelete_duplicates, 1, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2520 Remove all duplicate elements from SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2521
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2522 If SEQUENCE is a list and has duplicates, modify and return it. Note that
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2523 SEQUENCE may start with an element to be deleted; because of this, if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2524 modifying a variable, be sure to write `(setq VARIABLE (delete-duplicates
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2525 VARIABLE))' to be certain to have a list without duplicate elements.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2526
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2527 If SEQUENCE is an array and has duplicates, return a newly-allocated array
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2528 of the same type comprising all unique elements of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2529
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2530 If there are no duplicate elements in SEQUENCE, return it unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2532 See `remove*' for the meaning of the keywords. See `remove-duplicates' for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2533 a non-destructive version of this function.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2534
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2535 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2536 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2537 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2538 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2539 Lisp_Object sequence = args[0], keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2540 Lisp_Object positioned = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2541 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, len, ii = 0, jj = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2542 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2543 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2544 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2546 PARSE_KEYWORDS (Fdelete_duplicates, nargs, args, 6,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2547 (test, key, test_not, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2548 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2549
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2550 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2551 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2552 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2553
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2554 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2555 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2556 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2557 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2558 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2559
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2560 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2561
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2562 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2563 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2565 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2566 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2567 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2569 Lisp_Object prev_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2570 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2571
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2572 GCPRO2 (keyed, prev_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2574 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2575 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2576 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2577 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2578 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2579 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2580 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2581 = list_position_cons_before (&ignore, keyed,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2582 XCDR (tail), check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2583 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2584 0, make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2585 - (ii + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2586 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2587 make_fixnum (ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2588 - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2589 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2590 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2591 sequence = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2592 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2593 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2594 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2595 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2596 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2597 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2599 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2600 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2601 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2604 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2605 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2606 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2607 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2609 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2610 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2611 if (!(starting <= ii && ii <= ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2612 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2613 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2614 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2615 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2616 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2617
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2618 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2619 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2620 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2621 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2622 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2623 make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2624 - (ii + 1), 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2625 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2626 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2628 /* We know this isn't the first iteration of the loop,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2629 because we advanced above to the point where we have at
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2630 least one non-duplicate entry at the head of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2631 list. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2632 XSETCDR (prev_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2633 len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2634 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2635 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2636 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2637 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2638 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2639 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2640 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2641 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2643 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2644
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2645 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2646 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2647 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2648 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2649
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2650 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2651
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2652 if ((ii < starting || (ii < ending && !NILP (end))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2653 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2654 check_sequence_range (args[0], start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2655 make_fixnum (deleted
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2656 + XFIXNUM (Flength (args[0]))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2657 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2658 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2659 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2661 sequence = list_delete_duplicates_from_end (sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2662 test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2663 test, key, start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2664 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2667 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2669 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2670
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2671 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2672 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2673 /* We know all the elements will be characters; set check_test to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2674 reflect that. This isn't useful if KEY is not #'identity, since
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2675 it may return non-characters for the elements. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2676 check_test = get_check_test_function (make_char ('a'),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2677 &test, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2678 Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2679 &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2680 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2682 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2683 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2684 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2685 Ibyte *staging = alloca_ibytes (byte_len), *staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2686 Ibyte *cursor = XSTRING_DATA (sequence), *startp = cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2687 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2688
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2689 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2690
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2691 while (cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2692 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2693 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2694 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2695 Ibyte *cursor0 = cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2696 Bytecount cursor0_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2697 Boolint delete_this = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2698
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2699 elt = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2700 INC_IBYTEPTR (cursor0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2701 cursor0_offset = cursor0 - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2702
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2703 for (jj = ii + 1; jj < ending && cursor0_offset < byte_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2704 jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2705 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2706 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2707 make_char (itext_ichar (cursor0)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2708 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2709 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2710 delete_this = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2711 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2712 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2713 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2714
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2715 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2716 cursor0 = startp + cursor0_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2717 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2718 || !valid_ibyteptr_p (cursor0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2719 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2720 mapping_interaction_error (Qdelete_duplicates,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2721 sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2722 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2724 INC_IBYTEPTR (cursor0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2725 cursor0_offset = cursor0 - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2726 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2727
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2728 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2729 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2730
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2731 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2732 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2733 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2734 mapping_interaction_error (Qdelete_duplicates, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2735 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2736
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2737 if (!delete_this)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2739 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2740 += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2742 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2743 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2744 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2745 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2746 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2747 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2749 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2750 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2751 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2752 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2754 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2755
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2756 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2757 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2758 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2759 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2760
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2761 if (0 != deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2762 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2763 sequence = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2764 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2765 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2766 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2767 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2768 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2769 Ibyte *staging = alloca_ibytes ((len = string_char_length (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2770 * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2771 Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2772 Ibyte *endp = startp + XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2773 struct Lisp_Bit_Vector *deleting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2774 = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2775 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2776 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2777 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2778
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2779 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2781 /* For the from_end t case; transform contents to an array with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2782 elements addressable in constant time, use the same algorithm
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2783 as for vectors. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2784 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2785 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2786 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2787
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2788 while (startp < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2789 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2790 itext_copy_ichar (startp, staging + (ii * MAX_ICHAR_LEN));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2791 INC_IBYTEPTR (startp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2792 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2793 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2794
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2795 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2796
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2797 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2798
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2799 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2800 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2801 elt = KEY (key, make_char (itext_ichar (staging +
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2802 (ii * MAX_ICHAR_LEN))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2803 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2804 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2805 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2806 make_char (itext_ichar
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2807 (staging + (jj * MAX_ICHAR_LEN))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2808 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2809 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2810 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2811 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2812 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2813 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2814 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2815 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2817 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2819 if (0 != deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2820 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2821 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2823 for (ii = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2824 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2825 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2826 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2827 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2828 += itext_copy_ichar (startp, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2829 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2831 INC_IBYTEPTR (startp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2832 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2834 sequence = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2835 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2837 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2838 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2839 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2840 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2841 Lisp_Object *content = XVECTOR_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2842 struct Lisp_Bit_Vector *deleting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2843 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2844
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2845 len = XVECTOR_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2846 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2847
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2848 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2849 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2850 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2851 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2852 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2853 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2854 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2856 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2857
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2858 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2859
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2860 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2861 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2862 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2863 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2864 elt = KEY (key, content[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2865
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2866 for (jj = ii + 1; jj < ending; jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2867 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2868 if (check_test (test, key, elt, content[jj])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2869 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2870 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2871 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2872 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2873 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2874 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2875 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2876 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2877 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2878 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2879 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2880 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2881 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2882 elt = KEY (key, content[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2883
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2884 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2885 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2886 if (check_test (test, key, elt, content[jj])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2887 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2888 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2889 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2890 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2891 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2892 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2893 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2894 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2895 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2897 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2898
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2899 if (deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2900 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2901 Lisp_Object res = make_vector (len - deleted, Qnil),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2902 *res_content = XVECTOR_DATA (res);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2903
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2904 for (ii = jj = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2905 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2906 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2907 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2908 res_content[jj++] = content[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2909 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2910 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2911
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2912 sequence = res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2913 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2914 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2915 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2917 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2918 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2919 /* I'm a little irritated at this. Basically, the only reasonable
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2920 thing delete-duplicates should do if handed a bit vector is return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2921 something of maximum length two and minimum length 0 (because
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2922 that's the possible number of distinct elements if EQ is regarded
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2923 as identity, which it should be). But to support arbitrary TEST
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2924 and KEY arguments, which may be non-deterministic from our
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2925 perspective, we need the same algorithm as for vectors. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2926 struct Lisp_Bit_Vector *deleting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2927 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2928
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2929 len = bit_vector_length (bv);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2930
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2931 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2932 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2933 /* We know all the elements will be bits; set check_test to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2934 reflect that. This isn't useful if KEY is not #'identity, since
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2935 it may return non-bits for the elements. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2936 check_test = get_check_test_function (Qzero, &test, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2937 Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2938 &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2939 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2940
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2941 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2942
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2943 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2944 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2945 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2946 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2947 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2948 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2949 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2951 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2952
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2953 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2954
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2955 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2956 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2957 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2958 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2959 elt = KEY (key, make_fixnum (bit_vector_bit (bv, ii)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2961 for (jj = ii + 1; jj < ending; jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2963 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2964 make_fixnum (bit_vector_bit (bv, jj)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2965 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2966 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2967 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2968 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2969 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2970 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2971 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2972 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2973 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2974 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2975 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2976 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2977 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2978 elt = KEY (key, make_fixnum (bit_vector_bit (bv, ii)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2979
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2980 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2981 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2982 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2983 make_fixnum (bit_vector_bit (bv, jj)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2984 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2985 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2986 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2987 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2988 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2989 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2990 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2992 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2993
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2994 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2995
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2996 if (deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2998 Lisp_Object res = make_bit_vector (len - deleted, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2999 Lisp_Bit_Vector *resbv = XBIT_VECTOR (res);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3000
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3001 for (ii = jj = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3002 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3003 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3004 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3005 set_bit_vector_bit (resbv, jj++, bit_vector_bit (bv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3007 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3008
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3009 sequence = res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3010 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3013 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3014 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3016 DEFUN ("remove-duplicates", Fremove_duplicates, 1, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3017 Remove duplicate elements from SEQUENCE, non-destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3018
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3019 If there are no duplicate elements in SEQUENCE, return it unmodified;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3020 otherwise, return a new object. If SEQUENCE is a list, the new object may
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3021 share list structure with SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3022
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3023 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3025 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3026 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3027 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3028 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3029 Lisp_Object sequence = args[0], keyed, positioned = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3030 Lisp_Object result = sequence, result_tail = result, cursor = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3031 Lisp_Object cons_with_shared_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3032 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3033 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3034 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3035 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3036
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3037 PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3038 (test, key, test_not, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3039 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3041 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3043 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3045 return Fdelete_duplicates (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3046 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3047
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3048 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3049 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3050
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3051 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3052 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3053 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3054 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3055 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3056
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3057 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3058 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3059 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3060 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3061
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3062 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3063 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3064
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3065 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3066 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3067 Lisp_Object ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3068
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3069 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3070
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3071 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3072 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3073 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3074 if (starting <= ii && ii <= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3075 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3076 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3077 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3078 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3079 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3080 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3081 make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3082 - (ii + 1), 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3083 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3084 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3085 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3086 sequence = result = result_tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3087 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3088 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3089 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3090 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3091 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3092 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3093 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3094 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3095 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3096 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3097
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3098 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3099 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3100 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3101 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3102
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3103 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3104 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3105 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3106 if (!(starting <= ii && ii <= ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3107 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3108 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3109 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3110 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3111
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3112 /* For this algorithm, each time we encounter an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3113 removed, copy the output list from the tail beyond the last
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3114 removed cons to this one. Otherwise, the tail of the output list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3115 is shared with the input list, which is OK. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3116
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3117 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3118 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3119 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3120 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3121 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3122 make_fixnum (max (starting - (ii + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3123 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3124 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3125 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3127 if (EQ (result, sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3128 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3129 result = cons_with_shared_tail
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3130 = Fcons (XCAR (sequence), XCDR (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3131 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3132
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3133 result_tail = cons_with_shared_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3134 cursor = XCDR (cons_with_shared_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3135
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3136 while (!EQ (cursor, tail) && !NILP (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3137 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3138 XSETCDR (result_tail, Fcons (XCAR (cursor), Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3139 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3140 cursor = XCDR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3142
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3143 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3144 cons_with_shared_tail = result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3146
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3147 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3148 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3149 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3150 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3151
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3152 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3153
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3154 if ((ii < starting || (ii < ending && !NILP (end))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3155 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3156 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3157 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3158 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3159 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3161 result = list_delete_duplicates_from_end (sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3162 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3163 start, end, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3164 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3165
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3166 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3168 #undef KEY
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3169
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3170 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3171 Reverse SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3172
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3173 Return the beginning of the reversed sequence, which will be a distinct Lisp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3174 object if SEQUENCE is a list with length greater than one. See also
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3175 `reverse', the non-destructive version of this function.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3176 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3177 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3178 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3179 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3181 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3182 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3183 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3184 Lisp_Object prev = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3185 Lisp_Object tail = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3186
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3187 /* We gcpro our args; see `nconc' */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3188 GCPRO2 (prev, tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3189 while (!NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3190 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3191 REGISTER Lisp_Object next;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3192 CONCHECK_CONS (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3193 next = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3194 XCDR (tail) = prev;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3195 prev = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3196 tail = next;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3197 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3198 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3199 return prev;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3201 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3202 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3203 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3204 Elemcount half = length / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3205 Lisp_Object swap = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3206 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3207
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3208 while (ii > half)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3209 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3210 swap = XVECTOR_DATA (sequence) [length - ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3211 XVECTOR_DATA (sequence) [length - ii]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3212 = XVECTOR_DATA (sequence) [ii - 1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3213 XVECTOR_DATA (sequence) [ii - 1] = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3214 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3215 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3216 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3217 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3218 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3219 Elemcount length = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3220 Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3221 Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3222
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3223 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3224 while (cursor < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3225 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3226 staging_end -= itext_ichar_len (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3227 itext_copy_ichar (cursor, staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3228 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3229 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3230
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3231 assert (staging == staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3232
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3233 memcpy (XSTRING_DATA (sequence), staging, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3234 init_string_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3235 bump_string_modiff (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3236 sledgehammer_check_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3237 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3238 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3239 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3240 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3241 Elemcount length = bit_vector_length (bv), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3242 Elemcount half = length / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3243 int swap = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3244
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3245 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3246 while (ii > half)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3248 swap = bit_vector_bit (bv, length - ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3249 set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3250 set_bit_vector_bit (bv, ii - 1, swap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3251 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3252 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3253 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3254 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3255 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3256 assert (NILP (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3257 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3258
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3259 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3262 DEFUN ("reverse", Freverse, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3263 Reverse SEQUENCE, copying. Return the reversed sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3264 See also the function `nreverse', which is used more often.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3265 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3266 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3267 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3268 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3269
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3270 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3271
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3272 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3273 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3274 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3275 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3276 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3277 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3278 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3279 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3280 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3281 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3282 Lisp_Object *staging = alloca_array (Lisp_Object, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3283
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3284 while (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3286 staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3287 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3288 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3289
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3290 result = Fvector (length, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3291 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3292 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3293 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3294 Elemcount length = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3295 Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3296 Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3298 while (cursor < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3300 staging_end -= itext_ichar_len (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3301 itext_copy_ichar (cursor, staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3302 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3303 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3304
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3305 assert (staging == staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3306
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3307 result = make_string (staging, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3308 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3309 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3310 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3311 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence), *res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3312 Elemcount length = bit_vector_length (bv), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3314 result = make_bit_vector (length, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3315 res = XBIT_VECTOR (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3316
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3317 while (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3318 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3319 set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3320 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3321 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3323 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3324 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3325 assert (NILP (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3326 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3327
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3328 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3329 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3331 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3332 list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3333 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3334 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3335 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3336 Lisp_Object value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3337 Lisp_Object tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3338 Lisp_Object tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3339 Lisp_Object l1, l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3340 Lisp_Object tortoises[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3341 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3342 int l1_count = 0, l2_count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3343
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3344 l1 = org_l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3345 l2 = org_l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3346 tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3347 value = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3348 tortoises[0] = org_l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3349 tortoises[1] = org_l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3350
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3351 /* It is sufficient to protect org_l1 and org_l2. When l1 and l2 are
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3352 updated, we copy the new values back into the org_ vars. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3353
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3354 GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3355 gcpro5.nvars = 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3356
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3357 while (1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3359 if (NILP (l1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3360 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3361 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3362 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3363 return l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3364 Fsetcdr (tail, l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3365 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3366 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3367 if (NILP (l2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3368 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3369 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3370 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3371 return l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3372 Fsetcdr (tail, l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3373 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3374 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3376 if (check_merge (predicate, key, Fcar (l2), Fcar (l1)) == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3377 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3378 tem = l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3379 l1 = Fcdr (l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3380 org_l1 = l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3382 if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3384 if (l1_count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3385 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3386 if (!CONSP (tortoises[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3387 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3388 mapping_interaction_error (Qmerge, tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3389 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3391 tortoises[0] = XCDR (tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3394 if (EQ (org_l1, tortoises[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3395 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3396 signal_circular_list_error (org_l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3397 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3398 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3399 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3400 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3401 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3402 tem = l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3403 l2 = Fcdr (l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3404 org_l2 = l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3405
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3406 if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3407 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3408 if (l2_count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3409 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3410 if (!CONSP (tortoises[1]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3411 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3412 mapping_interaction_error (Qmerge, tortoises[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3413 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3414
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3415 tortoises[1] = XCDR (tortoises[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3416 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3417
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3418 if (EQ (org_l2, tortoises[1]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3419 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3420 signal_circular_list_error (org_l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3421 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3422 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3423 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3424
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3425 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3426 value = tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3427 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3428 Fsetcdr (tail, tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3429
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3430 tail = tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3431 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3432 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3433
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3434 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3435 array_merge (Lisp_Object *dest, Elemcount dest_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3436 Lisp_Object *front, Elemcount front_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3437 Lisp_Object *back, Elemcount back_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3438 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3439 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3440 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3441 Elemcount ii, fronting, backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3442 Lisp_Object *front_staging = front;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3443 Lisp_Object *back_staging = back;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3444 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3445
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3446 assert (dest_len == (back_len + front_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3447
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3448 if (0 == dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3450 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3452
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3453 if (front >= dest && front < (dest + dest_len))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3454 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3455 front_staging = alloca_array (Lisp_Object, front_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3456
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3457 for (ii = 0; ii < front_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3458 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3459 front_staging[ii] = front[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3460 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3461 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3462
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3463 if (back >= dest && back < (dest + dest_len))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3464 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3465 back_staging = alloca_array (Lisp_Object, back_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3467 for (ii = 0; ii < back_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3468 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3469 back_staging[ii] = back[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3470 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3473 GCPRO2 (front_staging[0], back_staging[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3474 gcpro1.nvars = front_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3475 gcpro2.nvars = back_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3477 for (ii = fronting = backing = 0; ii < dest_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3478 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3479 if (fronting >= front_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3480 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3481 while (ii < dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3482 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3483 dest[ii] = back_staging[backing];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3484 ++ii, ++backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3485 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3486 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3487 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3488 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3489
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3490 if (backing >= back_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3491 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3492 while (ii < dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3493 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3494 dest[ii] = front_staging[fronting];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3495 ++ii, ++fronting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3496 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3497 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3498 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3500
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3501 if (check_merge (predicate, key, back_staging[backing],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3502 front_staging[fronting]) == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3503 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3504 dest[ii] = front_staging[fronting];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3505 ++fronting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3506 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3507 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3508 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3509 dest[ii] = back_staging[backing];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3510 ++backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3511 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3512 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3513
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3514 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3515 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3516
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3517 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3518 list_array_merge_into_list (Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3519 Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3520 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3521 Lisp_Object predicate, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3522 Boolint reverse_order)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3523 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3524 Lisp_Object tail = Qnil, value = Qnil, tortoise = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3525 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3526 Elemcount array_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3527 int looped = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3528
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3529 GCPRO4 (list, tail, value, tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3530
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3531 while (1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3532 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3533 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3534 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3535 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3537 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3538 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3539 return Flist (array_len, array);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3540 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3541
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3542 Fsetcdr (tail, Flist (array_len - array_index, array + array_index));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3543 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3544 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3546 if (array_index >= array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3547 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3548 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3549 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3550 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3551 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3552 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3553
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3554 Fsetcdr (tail, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3555 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3556 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3558
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3559 if (reverse_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3560 check_merge (predicate, key, Fcar (list), array [array_index])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3561 : !check_merge (predicate, key, array [array_index], Fcar (list)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3562 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3563 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3564 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3565 value = tail = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3566 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3567 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3569 Fsetcdr (tail, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3570 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3571 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3572
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3573 list = Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3574 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3575 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3576 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3577 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3578 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3579 value = tail = Fcons (array [array_index], Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3580 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3581 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3582 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3583 Fsetcdr (tail, Fcons (array [array_index], tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3584 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3585 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3586 ++array_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3587 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3589 if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3590 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3591 if (looped & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3592 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3593 tortoise = XCDR (tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3594 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3595
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3596 if (EQ (list, tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3597 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3598 signal_circular_list_error (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3599 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3600 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3601 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3604 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3605 list_list_merge_into_array (Lisp_Object *output, Elemcount output_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3606 Lisp_Object list_one, Lisp_Object list_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3607 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3608 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3609 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3610 Elemcount output_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3611
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3612 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3613 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3614 if (NILP (list_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3615 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3616 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3617 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3618 output [output_index] = Fcar (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3619 list_two = Fcdr (list_two), ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3620 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3621 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3622 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3623
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3624 if (NILP (list_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3626 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3628 output [output_index] = Fcar (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3629 list_one = Fcdr (list_one), ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3630 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3631 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3632 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3633
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3634 if (check_merge (predicate, key, Fcar (list_two), Fcar (list_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3635 == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3636 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3637 output [output_index] = XCAR (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3638 list_one = XCDR (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3640 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3641 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3642 output [output_index] = XCAR (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3643 list_two = XCDR (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3644 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3645
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3646 ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3647
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3648 /* No need to check for circularity. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3649 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3650 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3651
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3652 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3653 list_array_merge_into_array (Lisp_Object *output, Elemcount output_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3654 Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3655 Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3656 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3657 Lisp_Object predicate, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3658 Boolint reverse_order)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3659 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3660 Elemcount output_index = 0, array_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3661
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3662 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3663 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3664 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3666 if (array_len - array_index != output_len - output_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3667 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3668 mapping_interaction_error (Qmerge, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3669 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3670
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3671 while (array_index < array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3672 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3673 output [output_index++] = array [array_index++];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3674 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3675
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3676 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3677 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3678
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3679 if (array_index >= array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3680 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3681 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3682 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3683 output [output_index++] = Fcar (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3684 list = Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3685 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3686
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3687 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3688 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3689
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3690 if (reverse_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3691 check_merge (predicate, key, Fcar (list), array [array_index]) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3692 !check_merge (predicate, key, array [array_index], Fcar (list)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3693 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3694 output [output_index] = XCAR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3695 list = XCDR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3696 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3697 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3698 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3699 output [output_index] = array [array_index];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3700 ++array_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3701 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3702
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3703 ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3705 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3706
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3707 #define STRING_DATA_TO_OBJECT_ARRAY(strdata, c_array, counter, len) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3708 do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3709 c_array = alloca_array (Lisp_Object, len); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3710 for (counter = 0; counter < len; ++counter) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3711 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3712 c_array[counter] = make_char (itext_ichar (strdata)); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3713 INC_IBYTEPTR (strdata); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3714 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3715 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3717 #define BIT_VECTOR_TO_OBJECT_ARRAY(v, c_array, counter, len) do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3718 c_array = alloca_array (Lisp_Object, len); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3719 for (counter = 0; counter < len; ++counter) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3720 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3721 c_array[counter] = make_fixnum (bit_vector_bit (v, counter)); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3722 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3723 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3724
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3725 DEFUN ("merge", Fmerge, 4, MANY, 0, /*
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
3726 Destructively merge SEQUENCE1 and SEQUENCE2, producing a new sequence.
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3727
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3728 TYPE is the type of sequence to return. PREDICATE is a `less-than'
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3729 predicate on the elements.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3730
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3731 Optional keyword argument KEY is a function used to extract an object to be
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
3732 used for comparison from each element of SEQUENCE1 and SEQUENCE2.
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
3733
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
3734 arguments: (TYPE SEQUENCE1 SEQUENCE2 PREDICATE &key (KEY #'IDENTITY))
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3735 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3736 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3737 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3738 Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3739 predicate = args[3], result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3740 check_test_func_t check_merge = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3742 PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3743
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3744 CHECK_SEQUENCE (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3745 CHECK_SEQUENCE (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3747 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3749 check_merge = get_merge_predicate (predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3750
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3751 if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3752 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3753 if (NILP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3754 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3755 result = Fappend (2, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3756 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3757 else if (NILP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3758 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3759 args[3] = Qnil; /* Overwriting PREDICATE, and losing its GC
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3760 protection, but that doesn't matter. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3761 result = Fappend (2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3762 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3763 else if (CONSP (sequence_one) && CONSP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3764 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3765 result = list_merge (sequence_one, sequence_two, check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3766 predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3767 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3768 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3769 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3770 Lisp_Object *array_storage, swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3771 Elemcount array_length, i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3772 Boolint reverse_order = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3774 if (!CONSP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3775 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3776 /* Make sequence_one the cons, sequence_two the array: */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3777 swap = sequence_one;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3778 sequence_one = sequence_two;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3779 sequence_two = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3780 reverse_order = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3781 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3782
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3783 if (VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3784 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3785 array_storage = XVECTOR_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3786 array_length = XVECTOR_LENGTH (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3787 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3788 else if (STRINGP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3789 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3790 Ibyte *strdata = XSTRING_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3791 array_length = string_char_length (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3792 /* No need to GCPRO, characters are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3793 STRING_DATA_TO_OBJECT_ARRAY (strdata, array_storage, i,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3794 array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3796 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3797 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3798 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3799 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3800 array_length = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3801 /* No need to GCPRO, fixnums are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3802 BIT_VECTOR_TO_OBJECT_ARRAY (v, array_storage, i, array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3804
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3805 result = list_array_merge_into_list (sequence_one,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3806 array_storage, array_length,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3807 check_merge, predicate, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3808 reverse_order);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3809 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3810 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3811 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3812 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3813 Elemcount sequence_one_len = XFIXNUM (Flength (sequence_one)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3814 sequence_two_len = XFIXNUM (Flength (sequence_two)), i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3815 Elemcount output_len = 1 + sequence_one_len + sequence_two_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3816 Lisp_Object *output = alloca_array (Lisp_Object, output_len),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3817 *sequence_one_storage = NULL, *sequence_two_storage = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3818 Boolint do_coerce = !(EQ (type, Qvector) || EQ (type, Qstring)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3819 || EQ (type, Qbit_vector) || EQ (type, Qlist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3820 Ibyte *strdata = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3821 Lisp_Bit_Vector *v = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3822 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3823
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3824 output[0] = do_coerce ? Qlist : type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3825 for (i = 1; i < output_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3826 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3827 output[i] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3828 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3829
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3830 GCPRO1 (output[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3831 gcpro1.nvars = output_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3832
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3833 if (VECTORP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3834 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3835 sequence_one_storage = XVECTOR_DATA (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3837 else if (STRINGP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3838 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3839 strdata = XSTRING_DATA (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3840 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3841 i, sequence_one_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3842 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3843 else if (BIT_VECTORP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3845 v = XBIT_VECTOR (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3846 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3847 i, sequence_one_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3848 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3849
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3850 if (VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3851 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3852 sequence_two_storage = XVECTOR_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3853 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3854 else if (STRINGP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3855 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3856 strdata = XSTRING_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3857 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3858 i, sequence_two_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3859 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3860 else if (BIT_VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3861 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3862 v = XBIT_VECTOR (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3863 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3864 i, sequence_two_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3865 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3866
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3867 if (LISTP (sequence_one) && LISTP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3868 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3869 list_list_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3870 sequence_one, sequence_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3871 check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3872 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3873 else if (LISTP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3874 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3875 list_array_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3876 sequence_one,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3877 sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3878 sequence_two_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3879 check_merge, predicate, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3880 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3881 else if (LISTP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3882 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3883 list_array_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3884 sequence_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3885 sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3886 sequence_one_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3887 check_merge, predicate, key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3889 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3890 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3891 array_merge (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3892 sequence_one_storage, sequence_one_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3893 sequence_two_storage, sequence_two_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3894 check_merge, predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3895 key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3896 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3897
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3898 result = Ffuncall (output_len, output);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3899
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3900 if (do_coerce)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3901 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3902 result = call2 (Qcoerce, result, type);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3903 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3905 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3906 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3908 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3909 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3910
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3911 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3912 list_sort (Lisp_Object list, check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3913 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3914 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3915 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3916 Lisp_Object back, tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3917 Lisp_Object front = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3918 Lisp_Object len = Flength (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3919
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3920 if (XFIXNUM (len) < 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3921 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3922
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3923 len = make_fixnum (XFIXNUM (len) / 2 - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3924 tem = Fnthcdr (len, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3925 back = Fcdr (tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3926 Fsetcdr (tem, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3927
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3928 GCPRO4 (front, back, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3929 front = list_sort (front, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3930 back = list_sort (back, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3931
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3932 RETURN_UNGCPRO (list_merge (front, back, check_merge, predicate, key));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3933 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3935 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3936 array_sort (Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3937 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3938 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3939 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3940 Elemcount split;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3941
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3942 if (array_len < 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3943 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3944
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3945 split = array_len / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3947 array_sort (array, split, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3948 array_sort (array + split, array_len - split, check_merge, predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3949 key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3950 array_merge (array, array_len, array, split, array + split,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3951 array_len - split, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3952 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3954 DEFUN ("sort*", FsortX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3955 Sort SEQUENCE, comparing elements using PREDICATE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3956 Returns the sorted sequence. SEQUENCE is modified by side effect.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3957
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3958 PREDICATE is called with two elements of SEQUENCE, and should return t if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3959 the first element is `less' than the second.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3961 Optional keyword argument KEY is a function used to extract an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3962 used for comparison from each element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3963
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3964 In this implementation, sorting is always stable; but call `stable-sort' if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3965 this stability is important to you, other implementations may not make the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3966 same guarantees.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3968 arguments: (SEQUENCE PREDICATE &key (KEY #'IDENTITY))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3969 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3970 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3971 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3972 Lisp_Object sequence = args[0], predicate = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3973 Lisp_Object *sequence_carray;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3974 check_test_func_t check_merge = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3975 Elemcount sequence_len, i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3976
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3977 PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3978
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3979 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3980
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3981 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3982
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3983 check_merge = get_merge_predicate (predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3984
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3985 if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3986 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3987 sequence = list_sort (sequence, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3988 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3989 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3990 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3991 array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3992 check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3993 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3994 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3995 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3996 Ibyte *strdata = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3997
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3998 sequence_len = string_char_length (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3999
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4000 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4001
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4002 /* No GCPRO necessary, characters are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4003 array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4004
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4005 strdata = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4006
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4007 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4008 for (i = 0; i < sequence_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4009 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4010 strdata += set_itext_ichar (strdata, XCHAR (sequence_carray[i]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4013 init_string_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4014 bump_string_modiff (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4015 sledgehammer_check_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4016 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4017 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4018 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4019 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4020 sequence_len = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4021
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4022 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4023
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4024 /* No GCPRO necessary, bits are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4025 array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4026
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4027 for (i = 0; i < sequence_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4028 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4029 set_bit_vector_bit (v, i, XFIXNUM (sequence_carray [i]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4030 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4031 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4032
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4033 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4034 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4036
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4037 static Lisp_Object replace_string_range_1 (Lisp_Object dest,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4038 Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4039 Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4040 const Ibyte *source,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4041 const Ibyte *source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4042 Lisp_Object item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4043
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4044 /* Fill the substring of DEST beginning at START and ending before END with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4045 the character ITEM. If DEST does not have sufficient space for END -
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4046 START characters at START, write as many as is possible without changing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4047 the character length of DEST. Update the string modification flag and do
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4048 any sledgehammer checks we have turned on.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4049
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4050 START must be a Lisp integer. END can be nil, indicating the length of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4051 string, or a Lisp integer. The condition (<= 0 START END (length DEST))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4052 must hold, or fill_string_range() will signal an error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4053 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4054 fill_string_range (Lisp_Object dest, Lisp_Object item, Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4055 Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4056 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4057 return replace_string_range_1 (dest, start, end, NULL, NULL, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4058 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4059
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4060 DEFUN ("fill", Ffill, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4061 Destructively modify SEQUENCE by replacing each element with ITEM.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4062 SEQUENCE is a list, vector, bit vector, or string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4063
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4064 Optional keyword START is the index of the first element of SEQUENCE
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4065 to be modified, and defaults to zero. Optional keyword END is the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4066 exclusive upper bound on the elements of SEQUENCE to be modified, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4067 defaults to the length of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4068
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4069 arguments: (SEQUENCE ITEM &key (START 0) (END (length SEQUENCE)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4070 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4071 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4072 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4073 Lisp_Object sequence = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4074 Lisp_Object item = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4075 Elemcount starting, ending = MOST_POSITIVE_FIXNUM + 1, ii, len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4076
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4077 PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4078
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4079 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4080 starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4081
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4082 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4083 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4084 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4085 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4086 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4087
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4088 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4089 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4090 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4091 CHECK_CHAR_COERCE_INT (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4092 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4093
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4094 fill_string_range (sequence, item, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4095 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4096 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4097 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4098 Lisp_Object *p = XVECTOR_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4099
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4100 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4101 len = XVECTOR_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4102
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4103 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4104 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4105
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4106 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4107 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4108 p[ii] = item;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4109 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4110 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4111 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4112 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4113 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4114 int bit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4116 CHECK_BIT (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4117 bit = XFIXNUM (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4118 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4119 len = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4120
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4121 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4122 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4123
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4124 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4126 set_bit_vector_bit (v, ii, bit);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4127 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4129 else if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4131 Elemcount counting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4132
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4133 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4134 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4135 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4136 if (counting >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4137 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4138 if (counting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4139 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4140 XSETCAR (tail, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4142 else if (counting == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4143 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4144 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4146 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4147 ++counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4148 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4149 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4150
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4151 if (counting < starting || (counting != ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4152 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4153 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4155 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4156 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4158 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4159 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4160 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4161 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4162 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4163
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4164
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4165 /* Replace the substring of DEST beginning at START and ending before END
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4166 with the text at SOURCE, which is END - START characters long and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4167 SOURCE_LIMIT - SOURCE octets long. If DEST does not have sufficient
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4168 space for END - START characters at START, write as many as is possible
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4169 without changing the length of DEST. Update the string modification flag
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4170 and do any sledgehammer checks we have turned on in this build.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4171
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4172 START must be a Lisp integer. END can be nil, indicating the length of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4173 string, or a Lisp integer. The condition (<= 0 START END (length DEST))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4174 must hold, or replace_string_range() will signal an error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4175 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4176 replace_string_range (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4177 const Ibyte *source, const Ibyte *source_limit)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4178 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4179 return replace_string_range_1 (dest, start, end, source, source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4180 Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4181 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4182
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4183 /* This is the guts of several mapping functions.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4184
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4185 Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4186 taking the elements from SEQUENCES. If VALS is non-NULL, store the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4187 results into VALS, a C array of Lisp_Objects; else, if LISP_VALS is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4188 non-nil, store the results into LISP_VALS, a sequence with sufficient
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4189 room for CALL_COUNT results (but see the documentation of SOME_OR_EVERY.)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4190 Else, do not accumulate any result.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4191
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4192 If VALS is non-NULL, NSEQUENCES is one, and SEQUENCES[0] is a cons,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4193 mapcarX will store the elements of SEQUENCES[0] in stack and GCPRO them,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4194 so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4195 mapcarX.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4196
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4197 Otherwise, mapcarX signals an invalid state error (see
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4198 mapping_interaction_error(), above) if it encounters a non-cons,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4199 non-array when traversing SEQUENCES. Common Lisp specifies in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4200 MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4201 destructively modifies SEQUENCES in a way that might affect the ongoing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4202 traversal operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4203
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4204 CALLER is a symbol describing the Lisp-visible function that was called,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4205 and any errors thrown because SEQUENCES was modified will reflect it.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4206
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4207 If CALLER is Qsome, return the (possibly multiple) values given by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4208 FUNCTION the first time it is non-nil, and abandon the iterations.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4209 LISP_VALS must be the result of calling STORE_VOID_IN_LISP on the address
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4210 of a Lisp object, and the return value will be stored at that address.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4211 If CALLER is Qevery, LISP_VALS must also reflect a pointer to a Lisp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4212 object, and Qnil will be stored at that address if FUNCTION gives nil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4213 otherwise it will be left alone. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4215 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4216 mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4217 Lisp_Object function, int nsequences, Lisp_Object *sequences,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4218 Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4219 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4220 Lisp_Object called, *args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4221 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4222 Ibyte *lisp_vals_staging = NULL, *cursor = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4223 int i, j;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4224
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4225 assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4227 args = alloca_array (Lisp_Object, nsequences + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4228 args[0] = function;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4229 for (i = 1; i <= nsequences; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4230 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4231 args[i] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4232 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4234 if (vals != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4235 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4236 GCPRO2 (args[0], vals[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4237 gcpro1.nvars = nsequences + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4238 gcpro2.nvars = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4239 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4240 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4241 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4242 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4243 gcpro1.nvars = nsequences + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4244 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4245
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4246 /* Be extra nice in the event that we've been handed one list and one
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4247 only; make it possible for FUNCTION to set cdrs not yet processed to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4248 non-cons, non-nil objects without ill-effect, if we have been handed
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4249 the stack space to do that. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4250 if (vals != NULL && 1 == nsequences && CONSP (sequences[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4251 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4252 Lisp_Object lst = sequences[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4253 Lisp_Object *val = vals;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4254 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4255 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4256 *val++ = XCAR (lst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4257 lst = XCDR (lst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4258 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4259 gcpro2.nvars = call_count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4260
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4261 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4262 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4263 args[1] = vals[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4264 vals[i] = IGNORE_MULTIPLE_VALUES (Ffuncall (nsequences + 1, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4265 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4266 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4267 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4268 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4269 enum lrecord_type lisp_vals_type = lrecord_type_symbol;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4270 Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4271 for (j = 0; j < nsequences; ++j)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4272 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4273 sequence_types[j] = XRECORD_LHEADER (sequences[j])->type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4274 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4276 if (!EQ (caller, Qsome) && !EQ (caller, Qevery))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4278 assert (LRECORDP (lisp_vals));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4279
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4280 lisp_vals_type
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4281 = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4282
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4283 if (lrecord_type_string == lisp_vals_type)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4284 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4285 lisp_vals_staging = cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4286 = alloca_ibytes (call_count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4287 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4288 else if (ARRAYP (lisp_vals))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4289 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4290 CHECK_LISP_WRITEABLE (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4291 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4292 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4293
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4294 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4295 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4296 for (j = 0; j < nsequences; ++j)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4297 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4298 switch (sequence_types[j])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4300 case lrecord_type_cons:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4301 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4302 if (!CONSP (sequences[j]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4303 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4304 /* This means FUNCTION has messed around with a cons
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4305 in one of the sequences, since we checked the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4306 type (CHECK_SEQUENCE()) and the length and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4307 structure (with Flength()) correctly in our
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4308 callers. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4309 mapping_interaction_error (caller, sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4310 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4311 args[j + 1] = XCAR (sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4312 sequences[j] = XCDR (sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4313 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4314 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4315 case lrecord_type_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4316 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4317 args[j + 1] = XVECTOR_DATA (sequences[j])[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4318 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4319 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4320 case lrecord_type_string:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4321 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4322 args[j + 1] = make_char (string_ichar (sequences[j], i));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4323 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4324 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4325 case lrecord_type_bit_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4326 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4327 args[j + 1]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4328 = make_fixnum (bit_vector_bit (XBIT_VECTOR (sequences[j]),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4329 i));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4330 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4331 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4332 default:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4333 ABORT();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4334 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4335 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4336 called = Ffuncall (nsequences + 1, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4337 if (vals != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4338 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4339 vals[i] = IGNORE_MULTIPLE_VALUES (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4340 gcpro2.nvars += 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4341 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4342 else if (EQ (Qsome, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4344 if (!NILP (IGNORE_MULTIPLE_VALUES (called)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4345 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4346 Lisp_Object *result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4347 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4348 *result = called;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4349 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4350 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4351 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4352 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4353 else if (EQ (Qevery, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4354 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4355 if (NILP (IGNORE_MULTIPLE_VALUES (called)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4356 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4357 Lisp_Object *result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4358 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4359 *result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4360 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4361 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4363 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4364 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4365 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4366 called = IGNORE_MULTIPLE_VALUES (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4367 switch (lisp_vals_type)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4368 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4369 case lrecord_type_symbol:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4370 /* Discard the result of funcall. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4371 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4372 case lrecord_type_cons:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4373 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4374 if (!CONSP (lisp_vals))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4375 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4376 /* If FUNCTION has inserted a non-cons non-nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4377 cdr into the list before we've processed the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4378 relevant part, error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4379 mapping_interaction_error (caller, lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4380 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4381 XSETCAR (lisp_vals, called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4382 lisp_vals = XCDR (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4383 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4384 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4385 case lrecord_type_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4386 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4387 i < XVECTOR_LENGTH (lisp_vals) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4388 (XVECTOR_DATA (lisp_vals)[i] = called) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4389 /* Let #'aset error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4390 Faset (lisp_vals, make_fixnum (i), called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4391 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4393 case lrecord_type_string:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4395 CHECK_CHAR_COERCE_INT (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4396 cursor += set_itext_ichar (cursor, XCHAR (called));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4397 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4398 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4399 case lrecord_type_bit_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4401 (BITP (called) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4402 i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4403 set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4404 XFIXNUM (called)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4405 (void) Faset (lisp_vals, make_fixnum (i), called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4406 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4407 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4408 default:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4409 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4410 ABORT();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4411 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4412 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4413 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4414 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4417 if (lisp_vals_staging != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4418 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4419 CHECK_LISP_WRITEABLE (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4420 replace_string_range (lisp_vals, Qzero, make_fixnum (call_count),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4421 lisp_vals_staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4422 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4423 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4424
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4425 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4426 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4427
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4428 /* Given NSEQUENCES objects at the address pointed to by SEQUENCES, return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4429 the length of the shortest sequence. Error if all are circular, or if any
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4430 one of them is not a sequence. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4431 static Elemcount
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4432 shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4433 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4434 Elemcount len = 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4435 Lisp_Object length = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4436 int i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4437
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4438 for (i = 0; i < nsequences; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4439 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4440 if (CONSP (sequences[i]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4441 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4442 length = Flist_length (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4443 if (!NILP (length))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4444 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4445 len = min (len, XFIXNUM (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4446 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4447 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4448 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4449 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4450 CHECK_SEQUENCE (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4451 length = Flength (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4452 len = min (len, XFIXNUM (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4453 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4454 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4455
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4456 if (len == 1 + MOST_POSITIVE_FIXNUM)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4458 signal_circular_list_error (sequences[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4461 return len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4462 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4463
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4464 DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4465 Call FUNCTION on each element of SEQUENCE, and concat results to a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4466 Between each pair of results, insert SEPARATOR.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4467
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4468 Each result, and SEPARATOR, should be strings. Thus, using " " as SEPARATOR
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4469 results in spaces between the values returned by FUNCTION. SEQUENCE itself
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4470 may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4471
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4472 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4473 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4474 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4475 `mapconcat' will give up once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4477 arguments: (FUNCTION SEQUENCE SEPARATOR &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4478 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4479 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4480 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4481 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4482 Lisp_Object sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4483 Lisp_Object separator = args[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4484 Elemcount len = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4485 Lisp_Object *args0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4486 EMACS_INT i, nargs0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4487
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4488 args[2] = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4489 args[1] = separator;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4490
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4491 len = shortest_length_among_sequences (nargs - 2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4492
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4493 if (len == 0) return build_ascstring ("");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4494
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4495 nargs0 = len + len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4496 args0 = alloca_array (Lisp_Object, nargs0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4498 /* Special-case this, it's very common and doesn't require any
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4499 funcalls. Upside of doing it here, instead of cl-macs.el: no consing,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4500 apart from the final string, we allocate everything on the stack. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4501 if (EQ (function, Qidentity) && 3 == nargs && CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4502 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4503 for (i = 0; i < len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4504 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4505 args0[i] = XCAR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4506 sequence = XCDR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4507 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4508 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4509 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4510 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4511 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4512 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4513
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4514 for (i = len - 1; i >= 0; i--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4515 args0[i + i] = args0[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4516
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4517 for (i = 1; i < nargs0; i += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4518 args0[i] = separator;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4519
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4520 return Fconcat (nargs0, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4521 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4522
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4523 DEFUN ("mapcar*", FmapcarX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4524 Call FUNCTION on each element of SEQUENCE; return a list of the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4525 The result is a list of the same length as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4526 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4527
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4528 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4529 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4530 from each sequence will be used each time FUNCTION is called, and `mapcar'
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4531 stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4532
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4533 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4534 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4535 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4536 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4537 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4538 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4539 Lisp_Object *args0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4541 args0 = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4542 mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4543
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4544 return Flist ((int) len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4545 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4546
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4547 DEFUN ("mapvector", Fmapvector, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4548 Call FUNCTION on each element of SEQUENCE; return a vector of the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4549 The result is a vector of the same length as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4550 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4551
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4552 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4553 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4554 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4555 `mapvector' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4556
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4557 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4558 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4559 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4560 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4561 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4562 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4563 Lisp_Object result = make_vector (len, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4565 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4566 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4567 /* Don't pass result as the lisp_object argument, we want mapcarX to protect
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4568 a single list argument's elements from being garbage-collected. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4569 mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4570 Qmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4571 RETURN_UNGCPRO (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4572 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4574 DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4575 Call FUNCTION on each element of SEQUENCE; chain the results together.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4576
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4577 FUNCTION must normally return a list; the results will be concatenated
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4578 together using `nconc'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4580 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4581 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4582 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4583 `mapcan' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4584
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4585 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4586 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4587 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4589 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4590 Lisp_Object function = args[0], *result = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4591
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4592 mapcarX (len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4593
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4594 /* #'nconc GCPROs its args in case of signals and error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4595 return Fnconc (len, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4596 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4597
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4598 DEFUN ("mapc", Fmapc, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4599 Call FUNCTION on each element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4600
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4601 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4602 This function is like `mapcar' but does not accumulate the results,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4603 which is more efficient if you do not use the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4604
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4605 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4606 there are SEQUENCES, plus one for the elements from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4607 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4608 `mapc' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4609
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4610 Return SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4611
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4612 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4613 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4614 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4615 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4616 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4617 Lisp_Object sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4618 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4619 /* We need to GCPRO sequence, because mapcarX will modify the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4620 elements of the args array handed to it, and this may involve
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4621 elements of sequence getting garbage collected. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4622 GCPRO1 (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4623 mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4624 RETURN_UNGCPRO (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4627 DEFUN ("map", Fmap, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4628 Map FUNCTION across one or more sequences, returning a sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4629
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4630 TYPE is the sequence type to return, FUNCTION is the function, SEQUENCE is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4631 the first argument sequence, SEQUENCES are the other argument sequences.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4632
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4633 FUNCTION will be called with (1+ (length SEQUENCES)) arguments, and must be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4634 capable of accepting this number of arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4635
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4636 Certain TYPEs are recognised internally by `map', but others are not, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4637 `coerce' may throw an error on an attempt to convert to a TYPE it does not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4638 understand. A null TYPE means do not accumulate any values.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4639
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4640 arguments: (TYPE FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4641 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4642 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4643 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4644 Lisp_Object type = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4645 Lisp_Object function = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4646 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4647 Lisp_Object *args0 = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4648 Elemcount len = shortest_length_among_sequences (nargs - 2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4649 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4651 if (!NILP (type))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4653 args0 = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4655
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4656 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4657
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4658 if (EQ (type, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4659 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4660 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4661 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4662
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4663 if (EQ (type, Qvector) || EQ (type, Qarray))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4664 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4665 result = Fvector (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4667 else if (EQ (type, Qstring))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4669 result = Fstring (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4670 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4671 else if (EQ (type, Qlist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4672 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4673 result = Flist (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4674 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4675 else if (EQ (type, Qbit_vector))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4676 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4677 result = Fbit_vector (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4678 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4679 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4680 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4681 result = Flist (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4682 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4683 result = call2 (Qcoerce, result, type);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4684 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4685 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4686
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4687 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4688 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4689
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4690 DEFUN ("map-into", Fmap_into, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4691 Modify RESULT-SEQUENCE using the return values of FUNCTION on SEQUENCES.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4692
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4693 RESULT-SEQUENCE and SEQUENCES can be lists or arrays.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4695 FUNCTION must accept at least as many arguments as there are SEQUENCES
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4696 \(possibly zero). If RESULT-SEQUENCE and the elements of SEQUENCES are not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4697 the same length, stop when the shortest is exhausted; any elements of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4698 RESULT-SEQUENCE beyond that are unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4700 Return RESULT-SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4701
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4702 arguments: (RESULT-SEQUENCE FUNCTION &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4703 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4704 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4705 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4706 Elemcount len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4707 Lisp_Object result_sequence = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4708 Lisp_Object function = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4709
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4710 args[0] = function;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4711 args[1] = result_sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4712
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4713 len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4714
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4715 mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4716 Qmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4718 return result_sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4719 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4721 DEFUN ("some", Fsome, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4722 Return true if PREDICATE gives non-nil for an element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4724 If so, return the value (possibly multiple) given by PREDICATE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4725
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4726 With optional SEQUENCES, call PREDICATE each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4727 there are SEQUENCES (plus one for the element from SEQUENCE).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4728
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4729 See also `find-if', which returns the corresponding element of SEQUENCE,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4730 rather than the value given by PREDICATE, and accepts bounding index
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4731 keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4732
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4733 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4734 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4735 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4736 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4737 Lisp_Object result = Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4738 result_ptr = STORE_VOID_IN_LISP ((void *) &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4739 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4740
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4741 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4742
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4743 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4746 DEFUN ("every", Fevery, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4747 Return true if PREDICATE is true of every element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4749 With optional SEQUENCES, call PREDICATE each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4750 there are SEQUENCES (plus one for the element from SEQUENCE).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4751
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4752 In contrast to `some', `every' never returns multiple values.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4754 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4755 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4756 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4757 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4758 Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4759 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4760
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4761 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4763 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4764 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4765
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4767 DEFUN ("reduce", Freduce, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4768 Combine the elements of SEQUENCE using FUNCTION, a binary operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4769
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4770 For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4771 SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4772 in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4774 Keywords supported: :start :end :from-end :initial-value :key
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4775 See `remove*' for the meaning of :start, :end, :from-end and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4776
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4777 :initial-value specifies an element (typically an identity element, such as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4778 0) that is conceptually prepended to the sequence (or appended, when
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4779 :from-end is given).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4781 If the sequence has one element, that element is returned directly.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4782 If the sequence has no elements, :initial-value is returned if given;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4783 otherwise, FUNCTION is called with no arguments, and its result returned.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4785 arguments: (FUNCTION SEQUENCE &key (START 0) (END (length SEQUENCE)) FROM-END INITIAL-VALUE (KEY #'identity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4786 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4787 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4788 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4789 Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4790 Elemcount starting, ending = MOST_POSITIVE_FIXNUM + 1, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4791
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4792 PARSE_KEYWORDS (Freduce, nargs, args, 5,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4793 (start, end, from_end, initial_value, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4794 (start = Qzero, initial_value = Qunbound));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4796 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4797 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4798 starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4799 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4800
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4801 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4802 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4803 #define CALL2(function, accum, item) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4804 IGNORE_MULTIPLE_VALUES (call2 (function, accum, item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4805
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4806 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4807 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4808 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4809 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4810 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4812 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4813 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4814 Lisp_Vector *vv = XVECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4815 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4817 check_sequence_range (sequence, start, end, make_fixnum (vv->size));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4819 ending = min (ending, vv->size);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4820
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4821 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4823 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4824 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4825 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4827 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4829 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4831 accum = KEY (key, vv->contents[starting]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4832 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4833 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4834 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4835 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4836 accum = KEY (key, vv->contents[ending - 1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4837 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4838 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4839 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4840
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4841 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4842 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4843 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4845 accum = CALL2 (function, accum, KEY (key, vv->contents[ii]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4847 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4848 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4849 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4850 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4851 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4852 accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4853 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4854 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4856 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4857 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4858 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4859 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4860 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4861 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4862
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4863 check_sequence_range (sequence, start, end, make_fixnum (bv->size));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4864 ending = min (ending, bv->size);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4865
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4866 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4867
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4868 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4869 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4870 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4871 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4872 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4873 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4874 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4875 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4876 accum = KEY (key, make_fixnum (bit_vector_bit (bv, starting)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4877 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4878 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4879 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4881 accum = KEY (key, make_fixnum (bit_vector_bit (bv, ending - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4882 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4883 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4884 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4885
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4886 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4887 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4888 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4889 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4890 accum = CALL2 (function, accum,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4891 KEY (key, make_fixnum (bit_vector_bit (bv, ii))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4892 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4893 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4894 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4895 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4896 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4897 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4898 accum = CALL2 (function, KEY (key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4899 make_fixnum (bit_vector_bit (bv,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4900 ii))),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4901 accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4902 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4903 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4905 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4906
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4907 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4908 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4909 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4910 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4911
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4912 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4913
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4914 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4915 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4916 Bytecount byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4917 Bytecount cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4918 const Ibyte *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4919 const Ibyte *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4920
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4921 for (ii = 0; ii != starting && cursor_offset < byte_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4922 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4923 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4924 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4925 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4926
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4927 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4928 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4929 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4930 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4931 else if (ending - starting && cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4932 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4933 accum = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4934 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4935 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4936 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4937
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4938 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4939 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4941 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4942 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4944 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4945 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4946 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4948
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4949 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4950 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4951 accum = CALL2 (function, accum,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4952 KEY (key, make_char (itext_ichar (cursor))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4954 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4955 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4956
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4957 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4958 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4959 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4960 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4961 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4962
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4963 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4964 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4965 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4966 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4968 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4969 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4970 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4971 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4972 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4973 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4974 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4975 Elemcount len = string_char_length (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4976 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4977 const Ibyte *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4978
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4979 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4980 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4981 starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4982
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4983 cursor = string_char_addr (sequence, ending - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4984 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4985
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4986 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4987 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4988 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4989 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4990 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4991 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4992 accum = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4993 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4994 if (ending > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4995 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4996 cursor = XSTRING_DATA (sequence) + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4997
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4998 if (!valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4999 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5000 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5001 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5002
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5003 DEC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5004 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5005 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5007
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5008 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5009 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5010 accum = CALL2 (function, KEY (key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5011 make_char (itext_ichar (cursor))),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5012 accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5013 if (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5014 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5015 cursor = XSTRING_DATA (sequence) + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5017 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5018 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5019 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5020 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5021 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5022
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5023 DEC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5024 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5025 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5026 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5027 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5028
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5029 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5030 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5031 else if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5032 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5033 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5034 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5035 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5036
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5037 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5038
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5039 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5040 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5041 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5042 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5043 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5045 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5046 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5047 if (ii == starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5048 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5049 accum = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5050 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5051 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5052 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5053 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5054 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5055 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5056 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5057
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5058 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5059
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5060 if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5061 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5062 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5063 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5064 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5065 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5066 if (ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5067 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5068 accum = CALL2 (function, accum, KEY (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5070 else if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5071 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5072 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5073 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5074 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5075 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5076 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5077 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5078 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5079
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5080 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5081
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5082 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5083 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5084 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5085 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5086 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5087 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5088 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5089 Boolint need_accum = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5090 Lisp_Object *subsequence = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5091 Elemcount counting = 0, len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5092 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5093
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5094 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5095 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5096 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5097
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5098 /* :from-end with a list; make an alloca copy of the relevant list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5099 data, attempting to go backwards isn't worth the trouble. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5100 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5101 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5102 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5103 if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5104 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5105 subsequence = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5106 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5107 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5108 else if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5109 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5110 subsequence = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5111 need_accum = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5112 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5113
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5114 if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5115 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5116 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5117 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5118 if (counting >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5119 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5120 if (counting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5121 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5122 subsequence[ii++] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5123 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5124 else if (counting == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5126 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5127 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5129 ++counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5130 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5131 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5132
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5133 if (subsequence != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5135 len = ending - starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5136 /* If we could be sure that neither FUNCTION nor KEY modify
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5137 SEQUENCE, this wouldn't be necessary, since all the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5138 elements of SUBSEQUENCE would definitely always be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5139 reachable via SEQUENCE. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5140 GCPRO1 (subsequence[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5141 gcpro1.nvars = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5142 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5143
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5144 if (need_accum)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5145 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5146 accum = KEY (key, subsequence[len - 1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5147 --len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5148 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5149
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5150 for (ii = len; ii != 0;)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5151 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5152 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5153 accum = CALL2 (function, KEY (key, subsequence[ii]), accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5155
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5156 if (subsequence != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5158 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5159 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5160 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5161 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5162
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5163 /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5164 need to return the result of calling FUNCTION with zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5165 arguments. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5166 if (UNBOUNDP (accum))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5167 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5168 accum = IGNORE_MULTIPLE_VALUES (call0 (function));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5169 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5170
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5171 return accum;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5172 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5173
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5174 /* This function is the implementation of fill_string_range() and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5175 replace_string_range(); see the comments for those functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5176 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5177 replace_string_range_1 (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5178 const Ibyte *source, const Ibyte *source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5179 Lisp_Object item)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5180 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5181 Ibyte *destp = XSTRING_DATA (dest), *p = destp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5182 *pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5183 Bytecount prefix_bytecount, source_len = source_limit - source;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5184 Charcount ii = 0, ending, len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5185 Charcount starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5186 Elemcount delta;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5187
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5188 while (ii < starting && p < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5189 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5190 INC_IBYTEPTR (p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5191 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5192 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5193
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5194 pcursor = p;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5195
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5196 if (NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5197 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5198 while (pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5199 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5200 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5201 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5202 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5203
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5204 ending = len = ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5205 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5206 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5207 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5208 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5209 while (ii < ending && pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5210 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5211 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5212 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5213 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5214 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5215
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5216 if (pcursor == pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5217 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5218 /* We have the length, check it for our callers. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5219 check_sequence_range (dest, start, end, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5220 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5221
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5222 if (!(p == pend || p == pcursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5223 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5224 prefix_bytecount = p - destp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5225
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5226 if (!NILP (item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5227 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5228 assert (source == NULL && source_limit == NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5229 source_len = set_itext_ichar (item_buf, XCHAR (item));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5230 delta = (source_len * (ending - starting)) - (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5231 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5232 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5233 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5234 assert (source != NULL && source_limit != NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5235 delta = source_len - (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5236 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5237
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5238 if (delta)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5239 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5240 resize_string (dest, prefix_bytecount, delta);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5241 destp = XSTRING_DATA (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5242 pcursor = destp + prefix_bytecount + (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5243 p = destp + prefix_bytecount;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5244 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5245
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5246 if (CHARP (item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5248 while (starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5249 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5250 memcpy (p, item_buf, source_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5251 p += source_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5252 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5253 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5254 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5255 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5256 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5257 while (starting < ending && source < source_limit)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5258 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5259 source_len = itext_copy_ichar (source, p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5260 p += source_len, source += source_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5261 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5262 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5263
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5264 init_string_ascii_begin (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5265 bump_string_modiff (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5266 sledgehammer_check_ascii_begin (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5267 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5269 return dest;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5270 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5271
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5272 DEFUN ("replace", Freplace, 2, MANY, 0, /*
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5273 Replace the elements of SEQUENCE1 with the elements of SEQUENCE2.
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5274
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5275 SEQUENCE1 is destructively modified, and returned. Its length is not
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5276 changed.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5277
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5278 Keywords :start1 and :end1 specify a subsequence of SEQUENCE1, and
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5279 :start2 and :end2 a subsequence of SEQUENCE2. See `search' for more
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5280 information.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5281
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5282 arguments: (SEQUENCE1 SEQUENCE2 &key (START1 0) (END1 (length SEQUENCE1)) (START2 0) (END2 (length SEQUENCE2)))
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5283 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5284 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5286 Lisp_Object sequence1 = args[0], sequence2 = args[1],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5287 result = sequence1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5288 Elemcount starting1, ending1 = MOST_POSITIVE_FIXNUM + 1, starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5289 Elemcount ending2 = MOST_POSITIVE_FIXNUM + 1, counting = 0, startcounting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5290 Boolint sequence1_listp, sequence2_listp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5291 overwriting = EQ (sequence1, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5293 PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5294 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5295
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5296 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5297 CHECK_LISP_WRITEABLE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5298
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5299 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5300
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5301 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5302 starting1 = BIGNUMP (start1) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5303 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5304 starting2 = BIGNUMP (start2) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5305
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5306 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5307 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5308 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5309 ending1 = BIGNUMP (end1) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5310 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5311
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5312 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5313 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5314 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5315 ending2 = BIGNUMP (end2) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5316 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5317
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5318 sequence1_listp = LISTP (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5319 sequence2_listp = LISTP (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5320
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5321 overwriting = overwriting && starting2 <= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5322
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5323 if (sequence1_listp && !ZEROP (start1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5324 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5325 sequence1 = Fnthcdr (start1, sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5327 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5328 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5329 check_sequence_range (args[0], start1, end1, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5330 /* Give up early here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5331 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5332 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5333
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5334 ending1 -= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5335 starting1 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5336 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5337
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5338 if (sequence2_listp && !ZEROP (start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5339 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5340 sequence2 = Fnthcdr (start2, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5341
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5342 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5344 check_sequence_range (args[1], start1, end1, Flength (args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5345 /* Nothing available to replace sequence1's contents. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5346 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5347 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5348
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5349 ending2 -= starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5350 starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5351 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5352
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5353 if (overwriting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5354 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5355 if (EQ (start1, start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5356 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5357 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5358 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5359
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5360 /* Our ranges may overlap. Save the data that might be overwritten. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5362 if (CONSP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5363 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5364 Elemcount len = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5365 Lisp_Object *subsequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5366 = alloca_array (Lisp_Object, min (ending2, len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5367 Elemcount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5369 LIST_LOOP_2 (elt, sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5370 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5371 if (counting == ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5372 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5373 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5374 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5376 subsequence[ii++] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5377 counting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5378 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5379
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5380 check_sequence_range (sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5381 /* The XFIXNUM (start2) is intentional here; we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5382 called #'length after doing (nthcdr
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5383 start2 sequence2). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5384 make_fixnum (XFIXNUM (start2) + len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5385 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5386 make_fixnum (XFIXNUM (start2) + len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5387
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5388 while (starting1 < ending1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5389 && starting2 < ending2 && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5390 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5391 XSETCAR (sequence1, subsequence[starting2]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5392 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5393 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5394 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5395 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5396 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5397 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5398 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5399 Ibyte *p = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5400 *pend = p + XSTRING_LENGTH (sequence2), *pcursor,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5401 *staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5402 Bytecount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5403
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5404 while (ii < starting2 && p < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5405 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5406 INC_IBYTEPTR (p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5407 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5408 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5409
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5410 pcursor = p;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5411
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5412 while (ii < ending2 && starting1 < ending1 && pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5413 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5414 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5415 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5416 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5417 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5418
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5419 if (pcursor == pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5420 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5421 check_sequence_range (sequence1, start1, end1, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5422 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5423 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5424 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5425 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5426 assert ((pcursor - p) > 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5427 staging = alloca_ibytes (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5428 memcpy (staging, p, pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5429 replace_string_range (result, start1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5430 make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5431 staging, staging + (pcursor - p));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5432 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5433 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5434 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5435 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5436 Elemcount seq_len = XFIXNUM (Flength (sequence2)), ii = 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5437 subseq_len = min (min (ending1 - starting1, seq_len - starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5438 min (ending2 - starting2, seq_len - starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5439 Lisp_Object *subsequence = alloca_array (Lisp_Object, subseq_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5441 check_sequence_range (sequence1, start1, end1, make_fixnum (seq_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5442 check_sequence_range (sequence2, start2, end2, make_fixnum (seq_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5443
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5444 while (starting2 < ending2 && ii < seq_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5445 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5446 subsequence[ii] = Faref (sequence2, make_fixnum (starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5447 ii++, starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5448 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5449
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5450 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5451
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5452 while (starting1 < ending1 && ii < seq_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5453 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5454 Faset (sequence1, make_fixnum (starting1), subsequence[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5455 ii++, starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5456 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5457 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5458 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5459 else if (sequence1_listp && sequence2_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5460 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5461 Lisp_Object sequence1_tortoise = sequence1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5462 sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5463 Elemcount shortest_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5465 counting = startcounting = min (ending1, ending2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5467 while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5468 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5469 XSETCAR (sequence1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5470 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5471 : Fcar (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5472 sequence1 = CONSP (sequence1) ? XCDR (sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5473 : Fcdr (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5474 sequence2 = CONSP (sequence2) ? XCDR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5475 : Fcdr (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5477 shortest_len++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5478
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5479 if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5480 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5481 if (counting & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5482 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5483 sequence1_tortoise = XCDR (sequence1_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5484 sequence2_tortoise = XCDR (sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5485 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5486
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5487 if (EQ (sequence1, sequence1_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5488 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5489 signal_circular_list_error (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5490 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5492 if (EQ (sequence2, sequence2_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5493 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5494 signal_circular_list_error (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5495 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5496 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5497 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5498
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5499 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5500 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5501 check_sequence_range (args[0], start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5502 make_fixnum (XFIXNUM (start1) + shortest_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5503 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5504 else if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5505 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5506 check_sequence_range (args[1], start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5507 make_fixnum (XFIXNUM (start2) + shortest_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5508 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5509 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5510 else if (sequence1_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5511 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5512 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5513 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5514 Ibyte *s2_data = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5515 *s2_end = s2_data + XSTRING_LENGTH (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5516 Elemcount char_count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5517 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5519 while (char_count < starting2 && s2_data < s2_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5521 INC_IBYTEPTR (s2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5522 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5523 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5524
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5525 while (starting1 < ending1 && starting2 < ending2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5526 && s2_data < s2_end && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5527 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5528 character = make_char (itext_ichar (s2_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5529 CONSP (sequence1) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5530 XSETCAR (sequence1, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5531 : Fsetcar (sequence1, character);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5532 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5533 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5534 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5535 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5536 INC_IBYTEPTR (s2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5537 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5538
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5539 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5540 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5541 check_sequence_range (sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5542 make_fixnum (XFIXNUM (start1) + starting1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5543 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5545 if (s2_data == s2_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5546 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5547 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5548 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5549 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5550 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5551 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5552 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5553 Elemcount len2 = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5554 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5555
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5556 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5557 while (starting2 < ending2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5558 && starting1 < ending1 && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5559 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5560 CHECK_CONS (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5561 XSETCAR (sequence1, Faref (sequence2, make_fixnum (starting2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5562 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5563 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5564 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5565 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5566
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5567 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5569 check_sequence_range (args[0], start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5570 make_fixnum (XFIXNUM (start1) + starting1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5571 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5572 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5573 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5574 else if (sequence2_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5575 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5576 if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5577 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5578 Elemcount ii = 0, count, len = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5579 Ibyte *staging, *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5580 Lisp_Object obj;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5582 check_sequence_range (sequence1, start1, end1, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5583 ending1 = min (ending1, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5584 count = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5585 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5586
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5587 while (ii < count && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5589 obj = CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5590 : Fcar (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5591
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5592 CHECK_CHAR_COERCE_INT (obj);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5593 cursor += set_itext_ichar (cursor, XCHAR (obj));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5594 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5595 sequence2 = XCDR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5596 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5597
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5598 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5599 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5600 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5601 make_fixnum (XFIXNUM (start2) + ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5604 replace_string_range (result, start1, make_fixnum (XFIXNUM (start1) + ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5605 staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5606 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5607 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5609 Elemcount len = XFIXNUM (Flength (sequence1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5610
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5611 check_sequence_range (sequence1, start2, end1, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5612 ending1 = min (ending2, min (ending1, len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5613
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5614 while (starting1 < ending1 && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5615 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5616 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5617 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5618 : Fcar (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5619 sequence2 = XCDR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5620 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5621 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5622 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5623
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5624 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5626 check_sequence_range (args[1], start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5627 make_fixnum (XFIXNUM (start2) + starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5628 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5629 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5630 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5631 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5633 if (STRINGP (sequence1) && STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5634 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5635 Ibyte *p2 = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5636 *p2end = p2 + XSTRING_LENGTH (sequence2), *p2cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5637 Charcount ii = 0, len1 = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5638
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5639 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5640
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5641 while (ii < starting2 && p2 < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5642 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5643 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5644 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5645 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5646
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5647 p2cursor = p2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5648 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5649
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5650 while (ii < ending2 && starting1 < ending1 && p2cursor < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5651 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5652 INC_IBYTEPTR (p2cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5653 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5654 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5655 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5656
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5657 if (p2cursor == p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5658 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5659 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5660 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5661
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5662 /* This isn't great; any error message won't necessarily reflect
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5663 the END1 that was supplied to #'replace. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5664 replace_string_range (result, start1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5665 p2, p2cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5667 else if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5669 Ibyte *staging, *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5670 Elemcount count, len1 = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5671 Elemcount len2 = XFIXNUM (Flength (sequence2)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5672 Lisp_Object obj;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5673
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5674 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5675 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5676
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5677 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5678 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5679 count = min (ending1 - starting1, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5680 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5682 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5683 while (ii < count)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5684 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5685 obj = Faref (sequence2, make_fixnum (starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5686
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5687 CHECK_CHAR_COERCE_INT (obj);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5688 cursor += set_itext_ichar (cursor, XCHAR (obj));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5689 starting2++, ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5690 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5692 replace_string_range (result, start1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5693 make_fixnum (XFIXNUM (start1) + count),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5694 staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5695 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5696 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5697 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5698 Ibyte *p2 = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5699 *p2end = p2 + XSTRING_LENGTH (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5700 Elemcount len1 = XFIXNUM (Flength (sequence1)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5701
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5702 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5703 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5704
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5705 while (ii < starting2 && p2 < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5706 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5707 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5708 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5709 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5711 while (p2 < p2end && starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5712 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5713 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5714 make_char (itext_ichar (p2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5715 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5716 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5717 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5718 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5719 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5721 if (p2 == p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5722 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5723 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5724 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5725 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5726 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5727 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5728 Elemcount len1 = XFIXNUM (Flength (sequence1)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5729 len2 = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5730
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5731 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5732 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5733
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5734 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5735 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5736
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5737 while (starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5739 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5740 Faref (sequence2, make_fixnum (starting2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5741 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5742 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5743 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5745 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5747 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5748 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5749
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5750 DEFUN ("nsubstitute", Fnsubstitute, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5751 Substitute NEW for OLD in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5752
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5753 This is a destructive function; it reuses the storage of SEQUENCE whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5754 possible. See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5755
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5756 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5757 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5758 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5759 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5760 Lisp_Object new_ = args[0], item = args[1], sequence = args[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5761 Lisp_Object object_, position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5762 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5763 Elemcount len, ii = 0, counting = MOST_POSITIVE_FIXNUM, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5764 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5765 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5767 PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5768 (test, if_, if_not, test_not, key, start, end, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5769 from_end), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5770
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5771 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5772 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5773 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5775 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5776 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5777 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5778 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5779 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5781 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5782 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5783 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5784 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5785 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5786 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5787 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5788 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5789 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5790 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5791 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5792 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5793 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5794 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5796 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5797 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5798 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5799 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5800 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5801
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5802 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5803 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5804
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5805 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5806 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5807 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5808 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5809 Lisp_Object present = count_with_tail (&object_, nargs - 1, args + 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5810 Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5812 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5813 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5814 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5815 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5817 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5818 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5819 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5820
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5821 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5822 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5823 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5824 if (!(ii < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5825 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5826 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5827 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5828
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5829 if (starting <= ii &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5830 check_test (test, key, item, elt) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5831 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5832 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5833 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5834 CHECK_LISP_WRITEABLE (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5835 XSETCAR (tail, new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5837 else if (!presenting && encountered >= counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5838 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5839 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5840 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5841
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5842 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5843 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5844 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5845 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5846
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5847 if ((ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5848 && encountered < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5849 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5850 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5851 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5852 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5853 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5854 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5855 Ibyte *staging, new_bytes[MAX_ICHAR_LEN], *staging_cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5856 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5857 Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5858 Bytecount new_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5859 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5860
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5861 CHECK_CHAR_COERCE_INT (new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5862
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5863 new_len = set_itext_ichar (new_bytes, XCHAR (new_));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5864
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5865 /* Worst case scenario; new char is four octets long, all the old ones
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5866 were one octet long, all the old ones match. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5867 staging = alloca_ibytes (XSTRING_LENGTH (sequence) * new_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5868 staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5869
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5870 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5871 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5872 Lisp_Object present = count_with_tail (&character, nargs - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5873 args + 1, Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5874
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5875 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5876 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5877 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5878 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5879
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5880 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5881
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5882 /* If there are fewer items in the string than we have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5883 permission to change, we don't need to differentiate
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5884 between the :from-end nil and :from-end t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5885 cases. Otherwise, presenting is the number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5886 items we need to ignore before we start to change. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5887 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5889
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5890 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5891 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5892 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5893 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5895 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5897 if ((check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5898 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5899 && (presenting ? encountered++ >= presenting :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5900 encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5901 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5902 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5903 += itext_copy_ichar (new_bytes, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5904 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5905 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5906 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5907 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5908 += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5909 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5910
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5911 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5912 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5913
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5914 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5915 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5917 mapping_interaction_error (Qnsubstitute, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5918 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5919 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5920 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5921 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5922 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5923 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5924
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5925 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5926 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5927 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5928 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5929
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5930 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5931 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5932 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5933 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5935 if (0 != encountered)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5936 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5937 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5938 replace_string_range (sequence, Qzero, make_fixnum (ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5939 staging, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5940 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5941 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5942 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5944 Elemcount positioning;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5945 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5947 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5948 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5949
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5950 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5951 test_not_unboundp, test, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5952 Qnil, Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5954 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5955 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5956 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5957 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5958
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5959 positioning = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5960 ending = min (len, ending);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5961
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5962 Faset (sequence, position0, new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5963 encountered = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5964
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5965 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5966 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5967 for (ii = positioning + 1; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5968 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5969 object_ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5970
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5971 if (check_test (test, key, item, object_) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5972 && encountered++ < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5973 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5974 Faset (sequence, make_fixnum (ii), new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5975 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5976 else if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5977 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5978 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5979 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5980 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5981 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5982 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5983 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5984 for (ii = positioning - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5985 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5986 object_ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5987
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5988 if (check_test (test, key, item, object_) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5989 && encountered++ < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5990 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5991 Faset (sequence, make_fixnum (ii), new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5992 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5993 else if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5994 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5995 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5996 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5997 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5998 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6000
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6001 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6002 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6003
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6004 DEFUN ("substitute", Fsubstitute, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6005 Substitute NEW for OLD in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6006
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6007 This is a non-destructive function; it makes a copy of SEQUENCE if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6008 to avoid corrupting the original SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6009
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6010 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6011
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6012 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) COUNT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6013 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6014 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6015 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6016 Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6017 Lisp_Object result = Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6018 Lisp_Object object, position0, matched_count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6019 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6020 Elemcount ii = 0, counting = MOST_POSITIVE_FIXNUM, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6021 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6022 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6023 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6025 PARSE_KEYWORDS (Fsubstitute, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6026 (test, if_, if_not, test_not, key, start, end, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6027 from_end), (start = Qzero, count = Qunbound));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6028
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6029 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6030
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6031 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6032 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6033
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6034 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6035 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6036 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6037 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6038 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6039
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6040 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6041 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6043 if (!UNBOUNDP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6045 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6046 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6047 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6048 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6049 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6050 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6051 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6052 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6053 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6054 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6055 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6056 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6057 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6058 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6059
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6060 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6061 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6062 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6063 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6064 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6065 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6066
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6067 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6068 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6069 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6070 test_not_unboundp, test, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6071 Qnil, Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6072
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6073 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6074 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6075 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6076 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6077 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6078 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6079 args[2] = Fcopy_sequence (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6080 return Fnsubstitute (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6081 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6082 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6083
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6084 matched_count = count_with_tail (&tail, nargs - 1, args + 1, Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6085
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6086 if (ZEROP (matched_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6087 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6088 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6089 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6090
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6091 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6092 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6093 presenting = XFIXNUM (matched_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6094 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6095 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6096
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6097 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6098 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6099 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6101 if (EQ (tail, tailing))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6102 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6103 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6104 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6105
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6106 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6107 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6108 return XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6109 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6110
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6111 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6112 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6113 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6114 else if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6115 (check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6116 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6117 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6119 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6120 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6121 result = result_tail = Fcons (new_, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6122 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6123 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6124 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6125 XSETCDR (result_tail, Fcons (new_, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6126 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6127 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6129 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6131 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6132 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6133 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6135 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6136 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6137 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6138
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6139 if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6140 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6141 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6142 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6143
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6144 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6146 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6148 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6149
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6150 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6151 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6152 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6153 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6154
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6155 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6156 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6157
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6158 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6159 subst (Lisp_Object new_, Lisp_Object old, Lisp_Object tree, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6161 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6162 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6163 stack_overflow ("Stack overflow in subst", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6164 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6165
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6166 if (EQ (tree, old))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6167 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6168 return new_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6169 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6170 else if (CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6172 Lisp_Object aa = subst (new_, old, XCAR (tree), depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6173 Lisp_Object dd = subst (new_, old, XCDR (tree), depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6174
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6175 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6176 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6177 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6178 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6179 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6180 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6181 return Fcons (aa, dd);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6182 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6183 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6184 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6185 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6186 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6187 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6188 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6189
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6190 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6191 sublis (Lisp_Object alist, Lisp_Object tree,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6192 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6193 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6194 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6195 Lisp_Object keyed = KEY (key, tree), aa, dd;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6196
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6197 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6198 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6199 stack_overflow ("Stack overflow in sublis", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6202 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6203 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6204 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6205 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6206 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6207 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6208 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6209 return XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6210 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6211 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6212 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6213 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6215 if (!CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6216 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6217 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6218 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6219
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6220 aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6221 depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6222 dd = sublis (alist, XCDR (tree), check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6223 depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6224
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6225 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6226 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6227 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6228 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6229
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6230 return Fcons (aa, dd);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6231 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6232
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6233 DEFUN ("sublis", Fsublis, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6234 Perform substitutions indicated by ALIST in TREE (non-destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6235 Return a copy of TREE with all matching elements replaced.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6236
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6237 Each dotted pair in ALIST describes a map from an old value (the car) to be
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6238 replaced by a new value (the cdr).
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6239
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6240 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6241
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6242 arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6243 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6244 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6245 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6246 Lisp_Object alist = args[0], tree = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6247 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6248 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6249
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6250 PARSE_KEYWORDS (Fsublis, nargs, args, 5, (test, if_, test_not, if_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6251 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6252
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6253 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6254 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6255 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6256 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6257
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6258 get_check_match_function (&test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6259 /* sublis() is going to apply the key, don't ask
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6260 for a match function that will do it for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6261 us. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6262 Qidentity, &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6263
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6264 if (CONSP (alist) && NILP (XCDR (alist)) && CONSP (XCAR (alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6265 && EQ (key, Qidentity) && 1 == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6266 && (check_eq_nokey == check_test ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6267 (check_eql_nokey == check_test &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6268 !NON_FIXNUM_NUMBER_P (XCAR (XCAR (alist))))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6269 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6270 /* #'subst with #'eq is very cheap indeed; call it. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6271 return subst (XCDR (XCAR (alist)), XCAR (XCAR (alist)), tree, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6272 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6273
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6274 return sublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6275 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6276
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6277 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6278 nsublis (Lisp_Object alist, Lisp_Object tree,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6279 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6280 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6281 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6283 Lisp_Object tree_saved = tree, tortoise = tree, keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6284 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6285 int count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6286
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6287 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6288 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6289 stack_overflow ("Stack overflow in nsublis", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6290 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6291
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6292 GCPRO2 (tree_saved, keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6293
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6294 while (CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6295 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6296 Boolint replaced = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6297 keyed = KEY (key, XCAR (tree));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6298
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6300 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6301 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6302 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6303 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6304 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6305 CHECK_LISP_WRITEABLE (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6306 /* See comment in sublis() on using elt_cdr. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6307 XSETCAR (tree, XCDR (elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6308 replaced = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6309 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6310 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6311 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6312 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6313 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6314
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6315 if (!replaced)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6316 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6317 if (CONSP (XCAR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6318 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6319 nsublis (alist, XCAR (tree), check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6320 test, key, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6321 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6324 keyed = KEY (key, XCDR (tree));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6325 replaced = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6327 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6328 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6329 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6330 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6331 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6332 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6333 CHECK_LISP_WRITEABLE (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6334 XSETCDR (tree, XCDR (elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6335 tree = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6336 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6337 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6338 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6339 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6340 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6341
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6342 if (!NILP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6344 tree = XCDR (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6345 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6346
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6347 if (++count > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6348 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6349 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6350 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6351 tortoise = XCDR (tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6352 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6353
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6354 if (EQ (tortoise, tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6355 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6356 signal_circular_list_error (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6357 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6358 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6359 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6360
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6361 RETURN_UNGCPRO (tree_saved);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6363
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6364 DEFUN ("nsublis", Fnsublis, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6365 Perform substitutions indicated by ALIST in TREE (destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6366 Any matching element of TREE is changed via a call to `setcar'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6367
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6368 Each dotted pair in ALIST describes a map from an old value (the car) to be
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6369 replaced by a new value (the cdr).
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6370
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6371 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6372
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6373 arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6374 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6375 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6376 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6377 Lisp_Object alist = args[0], tree = args[1], tailed = Qnil, keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6378 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6379 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6380 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6382 PARSE_KEYWORDS (Fnsublis, nargs, args, 5, (test, if_, test_not, if_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6383 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6384
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6385 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6386 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6387 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6388 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6389
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6390 get_check_match_function (&test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6391 /* nsublis() is going to apply the key, don't ask
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6392 for a match function that will do it for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6393 us. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6394 Qidentity, &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6395
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6396 GCPRO2 (tailed, keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6397
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6398 keyed = KEY (key, tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6399
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6401 /* nsublis() won't attempt to replace a cons handed to it, do that
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6402 ourselves. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6403 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6404 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6405 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6406 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6407 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6408 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6409 return XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6410 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6411 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6412 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6413 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6414
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6415 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6417 return nsublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6418 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6419
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6420 DEFUN ("subst", Fsubst, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6421 Substitute NEW for OLD everywhere in TREE (non-destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6422
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6423 Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6424
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6425 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6426
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6427 arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6428 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6429 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6430 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6431 Lisp_Object result, alist = noseeum_cons (noseeum_cons (args[1], args[0]),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6432 Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6433 args[1] = alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6434 result = Fsublis (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6435 free_cons (XCAR (alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6436 free_cons (alist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6437
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6438 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6439 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6441 DEFUN ("nsubst", Fnsubst, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6442 Substitute NEW for OLD everywhere in TREE (destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6443
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6444 Any element of TREE which is `eql' to OLD is changed to NEW (via a call to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6445 `setcar').
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6446
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6447 See `member*' for the meaning of the keywords. The keyword
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6448 :descend-structures, not specified by Common Lisp, allows callers to specify
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6449 that non-cons objects (vectors and range tables, among others) should also
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6450 undergo substitution.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6451
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6452 arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT DESCEND-STRUCTURES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6453 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6454 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6455 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6456 Lisp_Object new_ = args[0], old = args[1], tree = args[2], result, alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6457 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6458 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6459
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6460 PARSE_KEYWORDS (Fnsubst, nargs, args, 6, (test, if_, test_not, if_not, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6461 descend_structures), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6462 if (!NILP (descend_structures))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6463 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6464 check_test = get_check_test_function (old, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6465 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6467 return nsubst_structures (new_, old, tree, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6468 test, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6470 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6471
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6472 alist = noseeum_cons (noseeum_cons (old, new_), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6473 args[1] = alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6474 result = Fnsublis (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6475 free_cons (XCAR (alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6476 free_cons (alist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6477
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6478 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6479 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6480
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6481 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6482 tree_equal (Lisp_Object tree1, Lisp_Object tree2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6483 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6484 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6485 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6486 Lisp_Object tortoise1 = tree1, tortoise2 = tree2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6487 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6488 int count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6489 Boolint result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6490
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6491 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6492 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6493 stack_overflow ("Stack overflow in tree-equal", tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6494 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6495
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6496 GCPRO2 (tree1, tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6498 while (CONSP (tree1) && CONSP (tree2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6499 && tree_equal (XCAR (tree1), XCAR (tree2), check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6500 test_not_unboundp, test, key, depth + 1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6501 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6502 tree1 = XCDR (tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6503 tree2 = XCDR (tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6504
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6505 if (++count > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6506 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6507 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6508 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6509 tortoise1 = XCDR (tortoise1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6510 tortoise2 = XCDR (tortoise2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6511 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6512
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6513 if (EQ (tortoise1, tree1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6514 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6515 signal_circular_list_error (tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6518 if (EQ (tortoise2, tree2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6519 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6520 signal_circular_list_error (tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6521 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6522 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6523 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6524
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6525 if (CONSP (tree1) || CONSP (tree2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6526 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6527 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6528 return 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6529 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6530
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6531 result = check_test (test, key, tree1, tree2) == test_not_unboundp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6532 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6533
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6534 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6535 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6537 DEFUN ("tree-equal", Ftree_equal, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6538 Return t if TREE1 and TREE2 have `eql' leaves.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6539
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6540 Atoms are compared by `eql', unless another test is specified using
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6541 :test; cons cells are compared recursively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6542
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6543 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6545 arguments: (TREE1 TREE2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6546 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6547 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6548 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6549 Lisp_Object tree1 = args[0], tree2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6550 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6551 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6552
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6553 PARSE_KEYWORDS (Ftree_equal, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6554 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6555
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6556 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6557 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6558
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6559 return tree_equal (tree1, tree2, check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6560 0) ? Qt : Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6561 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6562
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6563 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6564 mismatch_from_end (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6565 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6566 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6567 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6568 Boolint UNUSED (return_sequence1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6569 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6570 Elemcount sequence1_len = XFIXNUM (Flength (sequence1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6571 Elemcount sequence2_len = XFIXNUM (Flength (sequence2)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6572 Elemcount starting1, ending1, starting2, ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6573 Lisp_Object *sequence1_storage = NULL, *sequence2_storage = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6574 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6575
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6576 check_sequence_range (sequence1, start1, end1, make_fixnum (sequence1_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6577 starting1 = XFIXNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6578 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6579 ending1 = min (ending1, sequence1_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6580
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6581 check_sequence_range (sequence2, start2, end2, make_fixnum (sequence2_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6582 starting2 = XFIXNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6583 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6584 ending2 = min (ending2, sequence2_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6585
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6586 if (LISTP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6587 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6588 Lisp_Object *saving;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6589 sequence1_storage = saving
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6590 = alloca_array (Lisp_Object, ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6591
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6592 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6593 EXTERNAL_LIST_LOOP_2 (elt, sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6595 if (starting1 <= ii && ii < ending1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6596 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6597 *saving++ = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6599 else if (ii == ending1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6600 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6601 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6604 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6605 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6606 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6607 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6608 else if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6609 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6610 const Ibyte *cursor = string_char_addr (sequence1, starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6611
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6612 STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence1_storage, ii,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6613 ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6614
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6615 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6616 else if (BIT_VECTORP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6617 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6618 Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6619 sequence1_storage = alloca_array (Lisp_Object, ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6620 for (ii = starting1; ii < ending1; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6621 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6622 sequence1_storage[ii - starting1]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6623 = make_fixnum (bit_vector_bit (vv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6624 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6626 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6628 sequence1_storage = XVECTOR_DATA (sequence1) + starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6629 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6630
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6631 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6632
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6633 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6634 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6635 Lisp_Object *saving;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6636 sequence2_storage = saving
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6637 = alloca_array (Lisp_Object, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6638
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6639 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6640 EXTERNAL_LIST_LOOP_2 (elt, sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6641 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6642 if (starting2 <= ii && ii < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6643 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6644 *saving++ = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6645 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6646 else if (ii == ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6647 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6648 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6649 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6651 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6652 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6653 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6655 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6656 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6657 const Ibyte *cursor = string_char_addr (sequence2, starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6658
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6659 STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence2_storage, ii,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6660 ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6661
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6663 else if (BIT_VECTORP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6664 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6665 Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6666 sequence2_storage = alloca_array (Lisp_Object, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6667 for (ii = starting2; ii < ending2; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6669 sequence2_storage[ii - starting2]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6670 = make_fixnum (bit_vector_bit (vv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6671 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6672 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6673 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6674 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6675 sequence2_storage = XVECTOR_DATA (sequence2) + starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6676 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6677
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6678 GCPRO2 (sequence1_storage[0], sequence2_storage[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6679 gcpro1.nvars = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6680 gcpro2.nvars = ending2 - starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6682 while (ending1 > starting1 && ending2 > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6683 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6684 --ending1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6685 --ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6686
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6687 if (check_match (test, key, sequence1_storage[ending1 - starting1],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6688 sequence2_storage[ending2 - starting2])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6689 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6690 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6691 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6692 return make_integer (ending1 + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6693 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6694 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6696 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6697
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6698 if (ending1 > starting1 || ending2 > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6699 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6700 return make_integer (ending1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6701 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6702
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6703 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6706 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6707 mismatch_list_list (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6708 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6709 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6710 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6711 Boolint UNUSED (return_list_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6712 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6713 Lisp_Object sequence1_tortoise = sequence1, sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6714 Lisp_Object orig_sequence1 = sequence1, orig_sequence2 = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6715 Elemcount ending1 = MOST_POSITIVE_FIXNUM, ending2 = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6716 Elemcount starting1, starting2, counting, startcounting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6717 Elemcount shortest_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6718 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6719
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6720 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6721 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6722
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6723 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6724 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6725 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6726 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6727
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6728 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6729 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6730 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6731 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6732
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6733 if (!ZEROP (start1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6734 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6735 sequence1 = Fnthcdr (start1, sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6736
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6737 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6739 check_sequence_range (sequence1_tortoise, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6740 Flength (sequence1_tortoise));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6741 /* Give up early here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6742 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6743 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6744
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6745 ending1 -= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6746 starting1 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6747 sequence1_tortoise = sequence1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6748 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6749
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6750 if (!ZEROP (start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6751 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6752 sequence2 = Fnthcdr (start2, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6754 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6755 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6756 check_sequence_range (sequence2_tortoise, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6757 Flength (sequence2_tortoise));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6758 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6759 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6760
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6761 ending2 -= starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6762 starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6763 sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6764 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6765
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6766 GCPRO4 (sequence1, sequence2, sequence1_tortoise, sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6767
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6768 counting = startcounting = min (ending1, ending2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6769
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6770 while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6771 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6772 if (check_match (test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6773 CONSP (sequence1) ? XCAR (sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6774 : Fcar (sequence1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6775 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6776 : Fcar (sequence2) ) != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6777 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6778 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6779 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6780 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6781
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6782 sequence1 = CONSP (sequence1) ? XCDR (sequence1) : Fcdr (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6783 sequence2 = CONSP (sequence2) ? XCDR (sequence2) : Fcdr (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6785 shortest_len++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6786
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6787 if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6788 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6789 if (counting & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6790 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6791 sequence1_tortoise = XCDR (sequence1_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6792 sequence2_tortoise = XCDR (sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6793 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6794
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6795 if (EQ (sequence1, sequence1_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6796 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6797 signal_circular_list_error (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6798 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6799
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6800 if (EQ (sequence2, sequence2_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6801 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6802 signal_circular_list_error (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6804 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6805 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6806
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6807 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6808
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6809 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6810 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6811 Lisp_Object args[] = { start1, make_fixnum (shortest_len) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6812 check_sequence_range (orig_sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6813 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6814 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6815
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6816 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6817 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6818 Lisp_Object args[] = { start2, make_fixnum (shortest_len) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6819 check_sequence_range (orig_sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6820 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6821 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6823 if ((!NILP (end1) && shortest_len != ending1 - starting1) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6824 (!NILP (end2) && shortest_len != ending2 - starting2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6825 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6826 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6827 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6828
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6829 if ((NILP (end1) && CONSP (sequence1)) || (NILP (end2) && CONSP (sequence2)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6831 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6832 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6834 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6835 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6836
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6837 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6838 mismatch_list_string (Lisp_Object list, Lisp_Object list_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6839 Lisp_Object list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6840 Lisp_Object string, Lisp_Object string_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6841 Lisp_Object string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6842 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6843 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6844 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6845 Boolint return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6846 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6847 Ibyte *string_data = XSTRING_DATA (string), *startp = string_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6848 Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6849 Elemcount char_count = 0, list_starting, list_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6850 Elemcount string_starting, string_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6851 Lisp_Object character, orig_list = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6852 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6853
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6854 list_ending = FIXNUMP (list_end) ? XFIXNUM (list_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6855 list_starting = FIXNUMP (list_start) ? XFIXNUM (list_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6856
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6857 string_ending = FIXNUMP (string_end) ? XFIXNUM (string_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6858 string_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6859 = FIXNUMP (string_start) ? XFIXNUM (string_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6860
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6861 while (char_count < string_starting && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6862 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6863 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6864 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6865 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6866 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6867
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6868 if (!ZEROP (list_start))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6869 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6870 list = Fnthcdr (list_start, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6871 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6872 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6873 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6874 Flength (orig_list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6875 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6876 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6877
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6878 list_ending -= list_starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6879 list_starting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6880 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6881
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6882 GCPRO1 (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6883
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6884 while (list_starting < list_ending && string_starting < string_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6885 && string_offset < string_len && !NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6886 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6887 character = make_char (itext_ichar (string_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6888
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6889 if (return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6890 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6891 if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6892 character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6893 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6895 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6896 return make_integer (XFIXNUM (list_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6897 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6898 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6899 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6900 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6901 if (check_match (test, key, character,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6902 CONSP (list) ? XCAR (list) : Fcar (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6903 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6904 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6905 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6906 return make_integer (char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6907 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6908 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6909
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6910 list = CONSP (list) ? XCDR (list) : Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6911
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6912 startp = XSTRING_DATA (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6913 string_data = startp + string_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6914 if (string_len != XSTRING_LENGTH (string)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6915 || !valid_ibyteptr_p (string_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6916 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6917 mapping_interaction_error (Qmismatch, string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6918 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6919
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6920 list_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6921 string_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6922 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6923 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6924 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6925 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6926
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6927 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6928
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6929 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6930 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6931 Lisp_Object args[] = { list_start, make_fixnum (char_count) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6932 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6933 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6934 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6935
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6936 if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6937 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6938 check_sequence_range (string, string_start, string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6939 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6940 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6941
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6942 if ((NILP (string_end) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6943 string_offset < string_len : string_starting < string_ending) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6944 (NILP (list_end) ? !NILP (list) : list_starting < list_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6945 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6946 return make_integer (return_list_index ? XFIXNUM (list_start) + char_count :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6947 char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6948 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6949
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6950 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6951 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6952
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6953 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6954 mismatch_list_array (Lisp_Object list, Lisp_Object list_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6955 Lisp_Object list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6956 Lisp_Object array, Lisp_Object array_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6957 Lisp_Object array_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6958 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6959 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6960 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6961 Boolint return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6963 Elemcount ii = 0, list_starting, list_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6964 Elemcount array_starting, array_ending, array_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6965 Lisp_Object orig_list = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6966 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6968 list_ending = FIXNUMP (list_end) ? XFIXNUM (list_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6969 list_starting = FIXNUMP (list_start) ? XFIXNUM (list_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6970
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6971 array_ending = FIXNUMP (array_end) ? XFIXNUM (array_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6972 array_starting = FIXNUMP (array_start) ? XFIXNUM (array_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6973 array_len = XFIXNUM (Flength (array));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6974
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6975 array_ending = min (array_ending, array_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6976
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6977 check_sequence_range (array, array_start, array_end, make_fixnum (array_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6978
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6979 if (!ZEROP (list_start))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6981 list = Fnthcdr (list_start, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6982 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6983 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6984 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6985 Flength (orig_list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6986 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6987 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6988
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6989 list_ending -= list_starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6990 list_starting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6992
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6993 GCPRO1 (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6994
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6995 while (list_starting < list_ending && array_starting < array_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6996 && !NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6998 if (return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6999 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7000 if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7001 Faref (array, make_fixnum (array_starting)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7002 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7003 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7004 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7005 return make_integer (XFIXNUM (list_start) + ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7007 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7008 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7009 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7010 if (check_match (test, key, Faref (array, make_fixnum (array_starting)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7011 CONSP (list) ? XCAR (list) : Fcar (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7012 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7013 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7014 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7015 return make_integer (array_starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7016 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7017 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7018
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7019 list = CONSP (list) ? XCDR (list) : Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7020 list_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7021 array_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7022 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7023 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7025 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7026
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7027 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7028 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7029 Lisp_Object args[] = { list_start, make_fixnum (ii) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7030 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7031 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7032 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7033
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7034 if (array_starting < array_ending ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7035 (NILP (list_end) ? !NILP (list) : list_starting < list_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7036 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7037 return make_integer (return_list_index ? XFIXNUM (list_start) + ii :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7038 array_starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7039 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7041 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7042 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7043
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7044 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7045 mismatch_string_array (Lisp_Object string, Lisp_Object string_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7046 Lisp_Object string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7047 Lisp_Object array, Lisp_Object array_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7048 Lisp_Object array_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7049 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7050 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7051 Boolint return_string_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7052 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7053 Ibyte *string_data = XSTRING_DATA (string), *startp = string_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7054 Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7055 Elemcount char_count = 0, array_starting, array_ending, array_length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7056 Elemcount string_starting, string_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7057 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7058
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7059 array_starting = FIXNUMP (array_start) ? XFIXNUM (array_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7060 array_ending = FIXNUMP (array_end) ? XFIXNUM (array_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7061 array_length = XFIXNUM (Flength (array));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7062 check_sequence_range (array, array_start, array_end, make_fixnum (array_length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7063 array_ending = min (array_ending, array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7064
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7065 string_ending = FIXNUMP (string_end) ? XFIXNUM (string_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7066 string_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7067 = FIXNUMP (string_start) ? XFIXNUM (string_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7068
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7069 while (char_count < string_starting && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7070 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7071 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7072 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7073 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7074 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7075
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7076 while (array_starting < array_ending && string_starting < string_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7077 && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7078 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7079 character = make_char (itext_ichar (string_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7080
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7081 if (return_string_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7082 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7083 if (check_match (test, key, character,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7084 Faref (array, make_fixnum (array_starting)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7085 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7086 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7087 return make_integer (char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7088 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7089 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7090 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7091 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7092 if (check_match (test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7093 Faref (array, make_fixnum (array_starting)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7094 character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7095 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7096 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7097 return make_integer (XFIXNUM (array_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7098 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7099 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7100
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7101 startp = XSTRING_DATA (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7102 string_data = startp + string_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7103 if (string_len != XSTRING_LENGTH (string)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7104 || !valid_ibyteptr_p (string_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7105 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7106 mapping_interaction_error (Qmismatch, string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7107 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7108
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7109 array_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7110 string_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7111 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7112 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7113 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7114 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7116 if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7117 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7118 check_sequence_range (string, string_start, string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7119 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7120 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7121
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7122 if ((NILP (string_end) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7123 string_offset < string_len : string_starting < string_ending) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7124 (NILP (array_end) ? !NILP (array) : array_starting < array_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7126 return make_integer (return_string_index ? char_count :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7127 XFIXNUM (array_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7129
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7130 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7131 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7132
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7133 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7134 mismatch_string_string (Lisp_Object string1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7135 Lisp_Object string1_start, Lisp_Object string1_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7136 Lisp_Object string2, Lisp_Object string2_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7137 Lisp_Object string2_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7138 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7139 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7140 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7141 Boolint UNUSED (return_string1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7142 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7143 Ibyte *string1_data = XSTRING_DATA (string1), *startp1 = string1_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7144 Bytecount string1_offset = 0, string1_len = XSTRING_LENGTH (string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7145 Ibyte *string2_data = XSTRING_DATA (string2), *startp2 = string2_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7146 Bytecount string2_offset = 0, string2_len = XSTRING_LENGTH (string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7147 Elemcount char_count1 = 0, string1_starting, string1_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7148 Elemcount char_count2 = 0, string2_starting, string2_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7149 Lisp_Object character1, character2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7150
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7151 string1_ending = FIXNUMP (string1_end) ? XFIXNUM (string1_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7152 string1_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7153 = FIXNUMP (string1_start) ? XFIXNUM (string1_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7154
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7155 string2_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7156 = FIXNUMP (string2_start) ? XFIXNUM (string2_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7157 string2_ending = FIXNUMP (string2_end) ? XFIXNUM (string2_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7158
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7159 while (char_count1 < string1_starting && string1_offset < string1_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7161 INC_IBYTEPTR (string1_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7162 string1_offset = string1_data - startp1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7163 char_count1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7164 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7165
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7166 while (char_count2 < string2_starting && string2_offset < string2_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7167 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7168 INC_IBYTEPTR (string2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7169 string2_offset = string2_data - startp2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7170 char_count2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7171 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7172
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7173 while (string2_starting < string2_ending && string1_starting < string1_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7174 && string1_offset < string1_len && string2_offset < string2_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7175 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7176 character1 = make_char (itext_ichar (string1_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7177 character2 = make_char (itext_ichar (string2_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7178
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7179 if (check_match (test, key, character1, character2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7180 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7181 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7182 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7183 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7184
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7185 startp1 = XSTRING_DATA (string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7186 string1_data = startp1 + string1_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7187 if (string1_len != XSTRING_LENGTH (string1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7188 || !valid_ibyteptr_p (string1_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7189 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7190 mapping_interaction_error (Qmismatch, string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7191 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7192
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7193 startp2 = XSTRING_DATA (string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7194 string2_data = startp2 + string2_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7195 if (string2_len != XSTRING_LENGTH (string2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7196 || !valid_ibyteptr_p (string2_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7197 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7198 mapping_interaction_error (Qmismatch, string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7199 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7200
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7201 string2_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7202 string1_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7203 char_count1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7204 char_count2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7205 INC_IBYTEPTR (string1_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7206 string1_offset = string1_data - startp1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7207 INC_IBYTEPTR (string2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7208 string2_offset = string2_data - startp2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7209 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7210
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7211 if (string1_data == XSTRING_DATA (string1) + XSTRING_LENGTH (string1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7212 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7213 check_sequence_range (string1, string1_start, string1_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7214 make_fixnum (char_count1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7215 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7216
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7217 if (string2_data == XSTRING_DATA (string2) + XSTRING_LENGTH (string2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7218 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7219 check_sequence_range (string2, string2_start, string2_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7220 make_fixnum (char_count2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7221 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7222
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7223 if ((!NILP (string1_end) && string1_starting < string1_ending) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7224 (!NILP (string2_end) && string2_starting < string2_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7225 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7226 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7227 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7228
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7229 if ((NILP (string1_end) && string1_data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7230 < (XSTRING_DATA (string1) + XSTRING_LENGTH (string1))) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7231 (NILP (string2_end) && string2_data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7232 < (XSTRING_DATA (string2) + XSTRING_LENGTH (string2))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7233 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7234 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7235 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7236
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7237 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7238 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7239
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7240 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7241 mismatch_array_array (Lisp_Object array1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7242 Lisp_Object array2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7243 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7244 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7245 Boolint UNUSED (return_array1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7246 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7247 Elemcount len1 = XFIXNUM (Flength (array1)), len2 = XFIXNUM (Flength (array2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7248 Elemcount ending1 = MOST_POSITIVE_FIXNUM, ending2 = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7249 Elemcount starting1, starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7250
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7251 check_sequence_range (array1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7252 check_sequence_range (array2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7253
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7254 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7255 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7256
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7257 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7258 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7259 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7262 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7263 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7264 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7265 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7266
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7267 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7268 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7269
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7270 while (starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7271 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7272 if (check_match (test, key, Faref (array1, make_fixnum (starting1)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7273 Faref (array2, make_fixnum (starting2)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7274 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7275 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7276 return make_integer (starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7277 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7278 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7279 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7280 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7281
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7282 if (starting1 < ending1 || starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7283 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7284 return make_integer (starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7285 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7286
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7287 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7288 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7289
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7290 typedef Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7291 (*mismatch_func_t) (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7292 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7293 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7294 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7295 Boolint return_list_index);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7296
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7297 static mismatch_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7298 get_mismatch_func (Lisp_Object sequence1, Lisp_Object sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7299 Lisp_Object from_end, Boolint *return_sequence1_index_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7300 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7301 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7302 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7303
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7304 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7305 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7306 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7307 return mismatch_from_end;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7308 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7309
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7310 if (LISTP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7311 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7312 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7313 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7314 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7315 return mismatch_list_list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7316 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7317
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7318 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7319 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7320 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7321 return mismatch_list_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7324 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7325 return mismatch_list_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7326 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7327
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7328 if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7329 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7330 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7331 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7332 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7333 return mismatch_string_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7334 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7335
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7336 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7337 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7338 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7339 return mismatch_list_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7340 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7341
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7342 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7343 return mismatch_string_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7344 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7345
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7346 if (ARRAYP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7347 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7348 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7349 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7350 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7351 return mismatch_string_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7352 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7353
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7354 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7355 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7356 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7357 return mismatch_list_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7358 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7359
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7360 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7361 return mismatch_array_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7363
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7364 RETURN_NOT_REACHED (NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7365 return NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7366 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7367
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7368 DEFUN ("mismatch", Fmismatch, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7369 Compare SEQUENCE1 with SEQUENCE2, return index of first mismatching element.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7370
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7371 Return nil if the sequences match. If one sequence is a prefix of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7372 other, the return value indicates the end of the shorter sequence. A
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7373 non-nil return value always reflects an index into SEQUENCE1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7374
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7375 See `search' for the meaning of the keywords."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7376
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7377 arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7378 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7379 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7380 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7381 Lisp_Object sequence1 = args[0], sequence2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7382 Boolint test_not_unboundp = 1, return_first_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7383 check_test_func_t check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7384 mismatch_func_t mismatch = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7386 PARSE_KEYWORDS (Fmismatch, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7387 (test, key, from_end, start1, end1, start2, end2, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7388 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7389
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7390 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7391 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7392
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7393 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7394 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7395
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7396 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7397 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7398 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7399 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7400
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7401 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7402 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7403 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7404 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7405
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7406 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7407 &test_not_unboundp, NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7408 mismatch = get_mismatch_func (sequence1, sequence2, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7409 &return_first_index);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7410
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7411 if (return_first_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7412 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7413 return mismatch (sequence1, start1, end1, sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7414 check_match, test_not_unboundp, test, key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7417 return mismatch (sequence2, start2, end2, sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7418 check_match, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7419 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7420
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7421 DEFUN ("search", Fsearch, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7422 Search for SEQUENCE1 as a subsequence of SEQUENCE2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7423
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7424 Return the index of the leftmost element of the first match found; return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7425 nil if there are no matches.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7426
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7427 In this function, :start1 and :end1 specify a subsequence of SEQUENCE1, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7428 :start2 and :end2 specify a subsequence of SEQUENCE2. See `remove*' for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7429 details of the other keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7430
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7431 arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7432 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7433 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7435 Lisp_Object sequence1 = args[0], sequence2 = args[1], position0 = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7436 Boolint test_not_unboundp = 1, return_first = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7437 check_test_func_t check_test = NULL, check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7438 mismatch_func_t mismatch = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7439 Elemcount starting1 = 0, ending1 = 1 + MOST_POSITIVE_FIXNUM, starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7440 Elemcount ending2 = 1 + MOST_POSITIVE_FIXNUM, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7441 Elemcount length1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7442 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7443 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7444
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7445 PARSE_KEYWORDS (Fsearch, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7446 (test, key, from_end, start1, end1, start2, end2, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7447 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7448
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7449 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7450 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7451 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7452
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7453 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7454 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7455 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7456 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7458 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7459 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7460 Lisp_Object len1 = Flength (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7461
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7462 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7463 check_sequence_range (sequence1, start1, end1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7464 ending1 = min (XFIXNUM (end1), XFIXNUM (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7465 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7466 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7467 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7468 end1 = Flength (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7469 check_sequence_range (sequence1, start1, end1, end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7470 ending1 = XFIXNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7473 length1 = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7474
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7475 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7476 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7477 Lisp_Object len2 = Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7478
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7479 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7480 check_sequence_range (sequence2, start2, end2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7481 ending2 = min (XFIXNUM (end2), XFIXNUM (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7482 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7483 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7484 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7485 end2 = Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7486 check_sequence_range (sequence2, start2, end2, end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7487 ending2 = XFIXNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7488 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7489
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7490 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7491 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7492 mismatch = get_mismatch_func (sequence1, sequence2, from_end, &return_first);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7493
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7494 if (bytecode_arithcompare (start1, make_integer (ending1)) >= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7495 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7496 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7497 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7498 return start2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7500
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7501 if (NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7502 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7503 return Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7504 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7505
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7506 return end2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7507 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7508
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7509 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7510 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7511 Lisp_Object mismatch_start1 = Fadd1 (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7512 Lisp_Object first = KEY (key, Felt (sequence1, start1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7513 GCPRO2 (first, mismatch_start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7514
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7515 ii = starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7516 while (ii < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7517 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7518 position0 = position (&object, first, sequence2, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7519 test_not_unboundp, test, key, make_fixnum (ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7520 end2, Qnil, Qnil, Qsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7521 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7522 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7523 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7524 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7525 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7526
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7527 if (length1 + XFIXNUM (position0) <= ending2 &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7528 (return_first ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7529 NILP (mismatch (sequence1, mismatch_start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7530 sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7531 make_fixnum (1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7532 make_fixnum (length1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7533 check_match, test_not_unboundp, test, key, 1)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7534 NILP (mismatch (sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7535 make_fixnum (1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7536 make_fixnum (length1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7537 sequence1, mismatch_start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7538 check_match, test_not_unboundp, test, key, 0))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7539
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7541 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7542 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7543 return position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7544 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7546 ii = XFIXNUM (position0) + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7547 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7548
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7549 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7550 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7551 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7552 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7553 Lisp_Object mismatch_end1 = make_integer (ending1 - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7554 Lisp_Object last = KEY (key, Felt (sequence1, mismatch_end1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7555 GCPRO2 (last, mismatch_end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7556
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7557 ii = ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7558 while (ii > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7559 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7560 position0 = position (&object, last, sequence2, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7561 test_not_unboundp, test, key, start2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7562 make_fixnum (ii), Qt, Qnil, Qsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7563
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7564 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7565 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7566 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7567 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7568 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7569
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7570 if (XFIXNUM (position0) - length1 + 1 >= starting2 &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7571 (return_first ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7572 NILP (mismatch (sequence1, start1, mismatch_end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7573 sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7574 make_fixnum (XFIXNUM (position0) - length1 + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7575 make_fixnum (XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7576 check_match, test_not_unboundp, test, key, 1)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7577 NILP (mismatch (sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7578 make_fixnum (XFIXNUM (position0) - length1 + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7579 make_fixnum (XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7580 sequence1, start1, mismatch_end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7581 check_match, test_not_unboundp, test, key, 0))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7582 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7583 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7584 return make_fixnum (XFIXNUM (position0) - length1 + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7585 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7586
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7587 ii = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7588 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7589
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7590 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7591 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7592
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7593 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7594 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7595
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7596 /* These two functions do set operations, those that can be visualised with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7597 Venn diagrams. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7598 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7599 venn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7600 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7601 Lisp_Object liszt1 = args[0], liszt2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7602 Lisp_Object result = EQ (caller, Qsubsetp) ? Qt : Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7603 Lisp_Object keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7604 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7605 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7606 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7608 PARSE_KEYWORDS_8 (caller, nargs, args, 4, (test, key, test_not, stable),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7609 NULL, 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7610
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7611 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7612 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7613
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7614 CHECK_KEY_ARGUMENT (key);
5700
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7615
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7616 /* #### Consider refactoring these tests into callers, and/or optimizing
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7617 tests. */
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7618 if (EQ (caller, Qsubsetp))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7619 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7620 if (NILP (liszt1))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7621 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7622 return Qt;
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7623 }
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7624 if (NILP (liszt2))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7625 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7626 return Qnil;
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7627 }
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7628 }
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7629
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7630 if (NILP (liszt1) && intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7631 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7632 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7633 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7634
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7635 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7636 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7637 return intersectionp ? Qnil : liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7638 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7639
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7640 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7641 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7642
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7643 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7644
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7645 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7646 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7647 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7648 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7649 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7650 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7651 test, key, 0, Qzero, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7652 != intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7653 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7654 if (EQ (Qsubsetp, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7655 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7656 result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7657 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7658 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7659 else if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7661 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7663 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7664 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7665 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7666 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7667 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7668 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7669 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7670 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7671 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7672 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7673 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7674 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7675 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7676
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7677 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7678
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7679 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7680 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7682 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7683 nvenn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7684 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7685 Lisp_Object liszt1 = args[0], liszt2 = args[1], tortoise_elt, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7686 Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, prev_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7687 Elemcount count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7688 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7689 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7690 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7692 PARSE_KEYWORDS_8 (caller, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7693 NULL, 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7695 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7696 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7697
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7698 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7700 if (NILP (liszt1) && intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7701 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7702 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7703 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7704
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7705 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7706 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7707 return intersectionp ? Qnil : liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7708 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7709
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7710 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7711 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7712
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7713 tortoise_elt = tail = liszt1, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7714
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7715 GCPRO4 (tail, keyed, liszt1, tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7717 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7718 (signal_malformed_list_error (liszt1), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7719 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7720 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7721 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7722 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7723 test, key, 0, Qzero, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7724 == intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7725 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7726 if (NILP (prev_tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7727 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7728 liszt1 = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7729 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7730 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7731 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7732 XSETCDR (prev_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7733 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7734
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7735 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7736 /* List is definitely not circular now! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7737 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7738 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7739 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7740 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7741 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7742 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7743 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7744
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7745 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7747 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7748 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7749 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7750 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7751
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7752 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7753 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7754 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7755 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7756 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7757
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7758 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7760 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7761 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7763 DEFUN ("intersection", Fintersection, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7764 Combine LIST1 and LIST2 using a set-intersection operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7765
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7766 The result list contains all items that appear in both LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7767 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7768 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7769
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7770 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7771 return the items in the order they appear in LIST1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7772
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7773 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7775 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7776 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7777 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7778 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7779 return venn (Qintersection, nargs, args, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7780 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7781
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7782 DEFUN ("nintersection", Fnintersection, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7783 Combine LIST1 and LIST2 using a set-intersection operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7785 The result list contains all items that appear in both LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7786 This is a destructive function; it reuses the storage of LIST1 whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7787 possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7788
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7789 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7790
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7791 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7792 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7793 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7794 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7795 return nvenn (Qnintersection, nargs, args, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7796 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7797
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7798 DEFUN ("subsetp", Fsubsetp, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7799 Return non-nil if every element of LIST1 also appears in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7800
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7801 See `union' for the meaning of the keyword arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7802
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7803 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7804 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7805 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7806 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7807 return venn (Qsubsetp, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7808 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7810 DEFUN ("set-difference", Fset_difference, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7811 Combine LIST1 and LIST2 using a set-difference operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7812
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7813 The result list contains all items that appear in LIST1 but not LIST2. This
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7814 is a non-destructive function; it makes a copy of the data if necessary to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7815 avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7817 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7819 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7820 return the items in the order they appear in LIST1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7821
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7822 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7823 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7824 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7825 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7826 return venn (Qset_difference, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7827 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7828
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7829 DEFUN ("nset-difference", Fnset_difference, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7830 Combine LIST1 and LIST2 using a set-difference operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7831
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7832 The result list contains all items that appear in LIST1 but not LIST2. This
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7833 is a destructive function; it reuses the storage of LIST1 whenever possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7834
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7835 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7836
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7837 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7838 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7839 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7840 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7841 return nvenn (Qnset_difference, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7842 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7843
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7844 DEFUN ("nunion", Fnunion, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7845 Combine LIST1 and LIST2 using a set-union operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7846 The result list contains all items that appear in either LIST1 or LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7847
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7848 This is a destructive function, it reuses the storage of LIST1 whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7849 possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7850
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7851 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7852
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7853 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7854 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7855 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7856 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7857 args[0] = nvenn (Qnunion, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7858 return bytecode_nconc2 (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7859 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7860
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7861 DEFUN ("union", Funion, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7862 Combine LIST1 and LIST2 using a set-union operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7863 The result list contains all items that appear in either LIST1 or LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7864 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7865 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7866
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7867 The keywords :test and :test-not specify two-argument test and negated-test
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7868 predicates, respectively; :test defaults to `eql'. See `member*' for more
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7869 information.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7870
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7871 :key specifies a one-argument function that transforms elements of LIST1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7872 and LIST2 into \"comparison keys\" before the test predicate is applied.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7873 For example, if :key is #'car, then the car of elements from LIST1 is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7874 compared with the car of elements from LIST2. The :key function, however,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7875 does not affect the elements in the returned list, which are taken directly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7876 from the elements in LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7877
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7878 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7879 return the items of LIST1 in order, followed by the remaining items of LIST2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7880 in the order they occur in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7881
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7882 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7883 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7884 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7885 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7886 Lisp_Object liszt1 = args[0], liszt2 = args[1], ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7887 Lisp_Object keyed = Qnil, result, result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7888 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7889 check_test_func_t check_test = NULL, check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7890 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7891
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7892 PARSE_KEYWORDS (Funion, nargs, args, 4, (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7893
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7894 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7895 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7897 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7898
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7899 if (NILP (liszt1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7900 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7901 return liszt2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7902 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7903
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7904 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7905 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7906 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7907 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7908
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7909 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7910 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7911
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7912 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7913
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7914 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7915 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7916 result = liszt2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7917 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7918 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7919 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7920 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7921 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7922 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7923 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7924 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7925 /* The Lisp version of #'union used to check which list was
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7926 longer, and use that as the tail of the constructed
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7927 list. That fails when the order of arguments to TEST is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7928 specified, as is the case for these functions. We could
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7929 pass the reverse_check argument to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7930 list_position_cons_before, but that means any key argument
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7931 is called an awful lot more, so it's a space win but not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7932 a time win. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7933 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7934 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7935 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7936 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7937 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7938 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7939 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7941 result = result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7942
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7943 /* The standard `union' doesn't produce a "stable" union -- it
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7944 iterates over the second list instead of the first one, and returns
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7945 the values in backwards order. According to the CLTL2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7946 documentation, `union' is not required to preserve the ordering of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7947 elements in any fashion; providing the functionality for a stable
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7948 union is an XEmacs extension. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7949 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7950 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7951 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7952 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7953 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7954 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7955 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7956 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7957 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7958 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7959 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7960 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7961 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7962 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7963 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7965 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7966 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7967 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7968 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7969
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7970 result = NILP (result) ? liszt1 : nconc2 (Fcopy_list (liszt1), result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7971 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7972
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7973 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7974
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7975 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7976 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7977
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7978 DEFUN ("set-exclusive-or", Fset_exclusive_or, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7979 Combine LIST1 and LIST2 using a set-exclusive-or operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7980
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7981 The result list contains all items that appear in exactly one of LIST1, LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7982 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7983 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7984
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7985 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7986
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7987 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7988 return the items in the order they appear in LIST1, followed by the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7989 remaining items in the order they appear in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7990
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7991 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7992 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7993 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7994 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7995 Lisp_Object liszt1 = args[0], liszt2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7996 Lisp_Object result = Qnil, result_tail = Qnil, keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7997 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7998 check_test_func_t check_match = NULL, check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7999 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8000
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8001 PARSE_KEYWORDS (Fset_exclusive_or, nargs, args, 4,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8002 (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8003
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8004 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8005 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8006
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8007 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8008
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8009 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8010 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8011 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8012 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8013
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8014 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8015 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8017 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8018 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8019 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8020 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8021 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8022 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8023 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8024 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8025 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8026 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8027 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8028 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8029 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8030 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8031 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8032 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8033 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8034 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8035 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8036 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8037 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8038 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8039 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8040 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8041 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8042 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8043
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8044 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8045 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8046 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8047 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8048 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8049 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8050 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8051 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8052 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8053 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8054 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8055 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8056 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8057 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8058 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8059 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8060 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8061 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8062 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8063 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8064 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8065 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8066 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8067 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8068
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8069 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8070
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8071 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8072 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8073
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8074 DEFUN ("nset-exclusive-or", Fnset_exclusive_or, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8075 Combine LIST1 and LIST2 using a set-exclusive-or operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8076
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8077 The result list contains all items that appear in exactly one of LIST1 and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8078 LIST2. This is a destructive function; it reuses the storage of LIST1 and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8079 LIST2 whenever possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8080
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8081 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8082
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8083 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8084 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8085 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8086 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8087 Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8088 Lisp_Object result = Qnil, tortoise_elt = Qnil, keyed = Qnil, swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8089 Lisp_Object prev_tail = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8090 Elemcount count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8091 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8092 check_test_func_t check_match = NULL, check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8093 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8094
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8095 PARSE_KEYWORDS (Fnset_exclusive_or, nargs, args, 4,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8096 (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8097
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8098 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8099 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8100
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8101 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8102
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8103 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8104 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8105 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8106 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8107
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8108 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8109 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8110
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8111 tortoise_elt = tail = liszt1, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8112
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8113 GCPRO4 (tail, keyed, result, tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8114
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8115 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8116 (signal_malformed_list_error (liszt1), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8117 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8118 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8119 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8120 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8121 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8122 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8123 swap = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8124
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8125 if (NILP (prev_tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8127 liszt1 = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8129 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8131 XSETCDR (prev_tail, swap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8132 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8133
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8134 XSETCDR (tail, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8135 result = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8136 tail = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8137
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8138 /* List is definitely not circular now! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8139 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8140 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8141 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8142 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8143 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8144 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8146
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8147 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8148
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8149 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8150 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8151 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8153
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8154 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8155 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8156 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8157 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8158 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8159
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8160 tortoise_elt = tail = liszt2, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8161
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8162 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8163 (signal_malformed_list_error (liszt2), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8164 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8165 /* Need to leave the key calculation to list_position_cons_before(). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8166 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8167 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8168 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8169 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8170 swap = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8171 XSETCDR (tail, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8172 result = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8173 tail = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8174 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8175 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8176 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8177 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8178 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8179 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8181 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8182
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8183 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8184 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8185 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8186 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8187
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8188 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8189 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8190 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8191 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8192 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8193
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8194 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8195
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8196 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8197 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8199 void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8200 syms_of_sequence (void)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8201 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8202 DEFSYMBOL (Qstring_lessp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8203 DEFSYMBOL (Qmerge);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8204 DEFSYMBOL (Qfill);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8205 DEFSYMBOL (Qidentity);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8206 DEFSYMBOL (Qvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8207 DEFSYMBOL (Qarray);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8208 DEFSYMBOL (Qstring);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8209 DEFSYMBOL (Qlist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8210 DEFSYMBOL (Qbit_vector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8211 defsymbol (&QsortX, "sort*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8212 DEFSYMBOL (Qreduce);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8213 DEFSYMBOL (Qreplace);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8214 DEFSYMBOL (Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8215 DEFSYMBOL (Qfind);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8216 defsymbol (&QdeleteX, "delete*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8217 defsymbol (&QremoveX, "remove*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8218
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8219 DEFSYMBOL (Qmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8220 defsymbol (&QmapcarX, "mapcar*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8221 DEFSYMBOL (Qmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8222 DEFSYMBOL (Qmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8223 DEFSYMBOL (Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8224 DEFSYMBOL (Qmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8225 DEFSYMBOL (Qmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8226 DEFSYMBOL (Qsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8227 DEFSYMBOL (Qevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8228 DEFSYMBOL (Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8229 DEFSYMBOL (Qdelete_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8230 DEFSYMBOL (Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8231 DEFSYMBOL (Qmismatch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8232 DEFSYMBOL (Qintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8233 DEFSYMBOL (Qnintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8234 DEFSYMBOL (Qsubsetp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8235 DEFSYMBOL (Qcar_less_than_car);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8236 DEFSYMBOL (Qset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8237 DEFSYMBOL (Qnset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8238 DEFSYMBOL (Qnunion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8239
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8240 DEFKEYWORD (Q_from_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8241 DEFKEYWORD (Q_initial_value);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8242 DEFKEYWORD (Q_start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8243 DEFKEYWORD (Q_start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8244 DEFKEYWORD (Q_end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8245 DEFKEYWORD (Q_end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8246 defkeyword (&Q_if_, ":if");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8247 DEFKEYWORD (Q_if_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8248 DEFKEYWORD (Q_test_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8249 DEFKEYWORD (Q_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8250 DEFKEYWORD (Q_stable);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8251 DEFKEYWORD (Q_descend_structures);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8252
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8253 DEFSUBR (Flength);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8254 DEFSUBR (Fcount);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8255 DEFSUBR (Fsubseq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8256 DEFSUBR (Felt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8257 DEFSUBR (Fcopy_tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8258 DEFSUBR (Fmember);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8259 DEFSUBR (Fmemq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8260 DEFSUBR (FmemberX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8261 DEFSUBR (Fadjoin);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8262 DEFSUBR (Fassoc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8263 DEFSUBR (Fassq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8264 DEFSUBR (FassocX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8265 DEFSUBR (Frassoc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8266 DEFSUBR (Frassq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8267 DEFSUBR (FrassocX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8268 DEFSUBR (Fposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8269 DEFSUBR (Ffind);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8270 DEFSUBR (FdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8271 DEFSUBR (FremoveX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8272 DEFSUBR (Fdelete_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8273 DEFSUBR (Fremove_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8274 DEFSUBR (Fnreverse);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8275 DEFSUBR (Freverse);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8276 DEFSUBR (Fmerge);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8277 DEFSUBR (FsortX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8278 DEFSUBR (Ffill);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8279 DEFSUBR (Fmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8280 DEFSUBR (FmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8281 DEFSUBR (Fmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8282 DEFSUBR (Fmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8283 DEFSUBR (Fmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8284 Ffset (intern ("mapc-internal"), Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8285 Ffset (intern ("mapcar"), QmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8286 DEFSUBR (Fmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8287 DEFSUBR (Fmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8288 DEFSUBR (Fsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8289 DEFSUBR (Fevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8290 DEFSUBR (Freduce);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8291 DEFSUBR (Freplace);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8292 DEFSUBR (Fnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8293 DEFSUBR (Fsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8294 DEFSUBR (Fsublis);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8295 DEFSUBR (Fnsublis);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8296 DEFSUBR (Fsubst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8297 DEFSUBR (Fnsubst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8298 DEFSUBR (Ftree_equal);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8299 DEFSUBR (Fmismatch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8300 DEFSUBR (Fsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8301 DEFSUBR (Fintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8302 DEFSUBR (Fnintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8303 DEFSUBR (Fsubsetp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8304 DEFSUBR (Fset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8305 DEFSUBR (Fnset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8306 DEFSUBR (Fnunion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8307 DEFSUBR (Funion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8308 DEFSUBR (Fset_exclusive_or);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8309 DEFSUBR (Fnset_exclusive_or);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8310 }