Mercurial > hg > xemacs-beta
annotate src/fns.c @ 5303:4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* fns.c (Fnreverse):
Check that non-list sequences are writable from Lisp before
modifying them. (There's an argument that we should do this for
list sequences too, but for the moment other code (e.g. #'setcar)
doesn't.)
(mapcarX): Initialise lisp_vals_staging, lisp_vals_type
explicitly, for the sake of compile warnings. Check if
lisp_vals_staging is non-NULL when deciding whether to replace a
string's range.
(Fsome): Cross-reference to #'find-if in the doc string for this
function.
(Freduce): GCPRO accum in this function, when a key argument is
specicified it can be silently garbage-collected. When deciding
whether to iterate across a string, check whether the cursor
exceeds the byte len; while iterating, increment an integer
counter. Don't ABORT() if check_sequence_range() returns when
handed a suspicious sequence; it is legal to supply the length of
SEQUENCE as the :end keyword value, and this will provoke our
suspicions, legitimately enough. (Problems with this function
revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.)
(Freplace): Check list sequence lengths using the arguments, not
the conses we're currently looking at, thank you Paul Dietz.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 14 Nov 2010 14:54:09 +0000 |
parents | 6468cf6f0b9d |
children | cde1608596d0 002cb5224e4f |
rev | line source |
---|---|
428 | 1 /* Random utility Lisp functions. |
2 Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc. | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
3 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2010 Ben Wing. |
428 | 4 |
5 This file is part of XEmacs. | |
6 | |
7 XEmacs is free software; you can redistribute it and/or modify it | |
8 under the terms of the GNU General Public License as published by the | |
9 Free Software Foundation; either version 2, or (at your option) any | |
10 later version. | |
11 | |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with XEmacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 Boston, MA 02111-1307, USA. */ | |
21 | |
22 /* Synched up with: Mule 2.0, FSF 19.30. */ | |
23 | |
24 /* This file has been Mule-ized. */ | |
25 | |
26 /* Note: FSF 19.30 has bool vectors. We have bit vectors. */ | |
27 | |
28 /* Hacked on for Mule by Ben Wing, December 1994, January 1995. */ | |
29 | |
30 #include <config.h> | |
31 | |
32 /* Note on some machines this defines `vector' as a typedef, | |
33 so make sure we don't use that name in this file. */ | |
34 #undef vector | |
35 #define vector ***** | |
36 | |
37 #include "lisp.h" | |
38 | |
442 | 39 #include "sysfile.h" |
771 | 40 #include "sysproc.h" /* for qxe_getpid() */ |
428 | 41 |
42 #include "buffer.h" | |
43 #include "bytecode.h" | |
44 #include "device.h" | |
45 #include "events.h" | |
46 #include "extents.h" | |
47 #include "frame.h" | |
872 | 48 #include "process.h" |
428 | 49 #include "systime.h" |
50 #include "insdel.h" | |
51 #include "lstream.h" | |
52 #include "opaque.h" | |
53 | |
54 /* NOTE: This symbol is also used in lread.c */ | |
55 #define FEATUREP_SYNTAX | |
56 | |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
57 Lisp_Object Qstring_lessp, Qsort, Qmerge, Qfill, Qreplace; |
428 | 58 Lisp_Object Qidentity; |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
59 Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Q_from_end, Q_initial_value; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
60 Lisp_Object Qmapconcat, QmapcarX, Qmapvector, Qmapcan, Qmapc, Qmap, Qmap_into; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
61 Lisp_Object Qsome, Qevery, Qmaplist, Qmapl, Qmapcon, Qreduce; |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
62 Lisp_Object Q_start1, Q_start2, Q_end1, Q_end2; |
428 | 63 |
563 | 64 Lisp_Object Qbase64_conversion_error; |
65 | |
771 | 66 Lisp_Object Vpath_separator; |
67 | |
428 | 68 static int internal_old_equal (Lisp_Object, Lisp_Object, int); |
454 | 69 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth); |
428 | 70 |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
71 static DOESNT_RETURN |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
72 mapping_interaction_error (Lisp_Object func, Lisp_Object object) |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
73 { |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
74 invalid_state_2 ("object modified while traversing it", func, object); |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
75 } |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
76 |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
77 static void |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
78 check_sequence_range (Lisp_Object sequence, Lisp_Object start, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
79 Lisp_Object end, Lisp_Object length) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
80 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
81 Elemcount starting = XINT (start), ending, len = XINT (length); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
82 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
83 ending = NILP (end) ? XINT (length) : XINT (end); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
84 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
85 if (!(0 <= starting && starting <= ending && ending <= len)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
86 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
87 args_out_of_range_3 (sequence, start, make_int (ending)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
88 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
89 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
90 |
428 | 91 static Lisp_Object |
2286 | 92 mark_bit_vector (Lisp_Object UNUSED (obj)) |
428 | 93 { |
94 return Qnil; | |
95 } | |
96 | |
97 static void | |
2286 | 98 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, |
99 int UNUSED (escapeflag)) | |
428 | 100 { |
665 | 101 Elemcount i; |
440 | 102 Lisp_Bit_Vector *v = XBIT_VECTOR (obj); |
665 | 103 Elemcount len = bit_vector_length (v); |
104 Elemcount last = len; | |
428 | 105 |
106 if (INTP (Vprint_length)) | |
107 last = min (len, XINT (Vprint_length)); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
108 write_ascstring (printcharfun, "#*"); |
428 | 109 for (i = 0; i < last; i++) |
110 { | |
111 if (bit_vector_bit (v, i)) | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
112 write_ascstring (printcharfun, "1"); |
428 | 113 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
114 write_ascstring (printcharfun, "0"); |
428 | 115 } |
116 | |
117 if (last != len) | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
118 write_ascstring (printcharfun, "..."); |
428 | 119 } |
120 | |
121 static int | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
122 bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
123 int UNUSED (foldcase)) |
428 | 124 { |
440 | 125 Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1); |
126 Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2); | |
428 | 127 |
128 return ((bit_vector_length (v1) == bit_vector_length (v2)) && | |
129 !memcmp (v1->bits, v2->bits, | |
130 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) * | |
131 sizeof (long))); | |
132 } | |
133 | |
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
134 /* This needs to be algorithmically identical to internal_array_hash in |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
135 elhash.c when equalp is one, so arrays and bit vectors with the same |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
136 contents hash the same. It would be possible to enforce this by giving |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
137 internal_ARRAYLIKE_hash its own file and including it twice, but right |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
138 now that doesn't seem worth it. */ |
665 | 139 static Hashcode |
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
140 internal_bit_vector_equalp_hash (Lisp_Bit_Vector *v) |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
141 { |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
142 int ii, size = bit_vector_length (v); |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
143 Hashcode hash = 0; |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
144 |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
145 if (size <= 5) |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
146 { |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
147 for (ii = 0; ii < size; ii++) |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
148 { |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
149 hash = HASH2 |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
150 (hash, |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
151 FLOAT_HASHCODE_FROM_DOUBLE ((double) (bit_vector_bit (v, ii)))); |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
152 } |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
153 return hash; |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
154 } |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
155 |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
156 /* just pick five elements scattered throughout the array. |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
157 A slightly better approach would be to offset by some |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
158 noise factor from the points chosen below. */ |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
159 for (ii = 0; ii < 5; ii++) |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
160 hash = HASH2 (hash, |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
161 FLOAT_HASHCODE_FROM_DOUBLE |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
162 ((double) (bit_vector_bit (v, ii * size / 5)))); |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
163 |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
164 return hash; |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
165 } |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
166 |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
167 static Hashcode |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
168 bit_vector_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp) |
428 | 169 { |
440 | 170 Lisp_Bit_Vector *v = XBIT_VECTOR (obj); |
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
171 if (equalp) |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
172 { |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
173 return HASH2 (bit_vector_length (v), |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
174 internal_bit_vector_equalp_hash (v)); |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
175 } |
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5187
diff
changeset
|
176 |
428 | 177 return HASH2 (bit_vector_length (v), |
178 memory_hash (v->bits, | |
179 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * | |
180 sizeof (long))); | |
181 } | |
182 | |
665 | 183 static Bytecount |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
184 size_bit_vector (Lisp_Object obj) |
442 | 185 { |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
186 Lisp_Bit_Vector *v = XBIT_VECTOR (obj); |
456 | 187 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits, |
442 | 188 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v))); |
189 } | |
190 | |
1204 | 191 static const struct memory_description bit_vector_description[] = { |
428 | 192 { XD_END } |
193 }; | |
194 | |
195 | |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
196 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("bit-vector", bit_vector, |
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
197 mark_bit_vector, |
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
198 print_bit_vector, 0, |
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
199 bit_vector_equal, |
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
200 bit_vector_hash, |
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
201 bit_vector_description, |
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
202 size_bit_vector, |
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
203 Lisp_Bit_Vector); |
934 | 204 |
428 | 205 |
206 DEFUN ("identity", Fidentity, 1, 1, 0, /* | |
207 Return the argument unchanged. | |
208 */ | |
209 (arg)) | |
210 { | |
211 return arg; | |
212 } | |
213 | |
214 DEFUN ("random", Frandom, 0, 1, 0, /* | |
215 Return a pseudo-random number. | |
1983 | 216 All fixnums are equally likely. On most systems, this is 31 bits' worth. |
5302
6468cf6f0b9d
Correct argument name in docstring, #'random.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5300
diff
changeset
|
217 With positive integer argument LIMIT, return random number in interval [0, |
6468cf6f0b9d
Correct argument name in docstring, #'random.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5300
diff
changeset
|
218 LIMIT). LIMIT can be a bignum, in which case the range of possible values |
6468cf6f0b9d
Correct argument name in docstring, #'random.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5300
diff
changeset
|
219 is extended. With argument t, set the random number seed from the current |
6468cf6f0b9d
Correct argument name in docstring, #'random.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5300
diff
changeset
|
220 time and pid. |
428 | 221 */ |
222 (limit)) | |
223 { | |
224 EMACS_INT val; | |
225 unsigned long denominator; | |
226 | |
227 if (EQ (limit, Qt)) | |
771 | 228 seed_random (qxe_getpid () + time (NULL)); |
428 | 229 if (NATNUMP (limit) && !ZEROP (limit)) |
230 { | |
231 /* Try to take our random number from the higher bits of VAL, | |
232 not the lower, since (says Gentzel) the low bits of `random' | |
233 are less random than the higher ones. We do this by using the | |
234 quotient rather than the remainder. At the high end of the RNG | |
235 it's possible to get a quotient larger than limit; discarding | |
236 these values eliminates the bias that would otherwise appear | |
237 when using a large limit. */ | |
2039 | 238 denominator = ((unsigned long)1 << INT_VALBITS) / XINT (limit); |
428 | 239 do |
240 val = get_random () / denominator; | |
241 while (val >= XINT (limit)); | |
242 } | |
1983 | 243 #ifdef HAVE_BIGNUM |
244 else if (BIGNUMP (limit)) | |
245 { | |
246 bignum_random (scratch_bignum, XBIGNUM_DATA (limit)); | |
247 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
248 } | |
249 #endif | |
428 | 250 else |
251 val = get_random (); | |
252 | |
253 return make_int (val); | |
254 } | |
255 | |
256 /* Random data-structure functions */ | |
257 | |
258 #ifdef LOSING_BYTECODE | |
259 | |
260 /* #### Delete this shit */ | |
261 | |
262 /* Charcount is a misnomer here as we might be dealing with the | |
263 length of a vector or list, but emphasizes that we're not dealing | |
264 with Bytecounts in strings */ | |
265 static Charcount | |
266 length_with_bytecode_hack (Lisp_Object seq) | |
267 { | |
268 if (!COMPILED_FUNCTIONP (seq)) | |
269 return XINT (Flength (seq)); | |
270 else | |
271 { | |
440 | 272 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq); |
428 | 273 |
274 return (f->flags.interactivep ? COMPILED_INTERACTIVE : | |
275 f->flags.domainp ? COMPILED_DOMAIN : | |
276 COMPILED_DOC_STRING) | |
277 + 1; | |
278 } | |
279 } | |
280 | |
281 #endif /* LOSING_BYTECODE */ | |
282 | |
283 void | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
284 check_losing_bytecode (const Ascbyte *function, Lisp_Object seq) |
428 | 285 { |
286 if (COMPILED_FUNCTIONP (seq)) | |
563 | 287 signal_ferror_with_frob |
288 (Qinvalid_argument, seq, | |
428 | 289 "As of 20.3, `%s' no longer works with compiled-function objects", |
290 function); | |
291 } | |
292 | |
293 DEFUN ("length", Flength, 1, 1, 0, /* | |
294 Return the length of vector, bit vector, list or string SEQUENCE. | |
295 */ | |
296 (sequence)) | |
297 { | |
298 retry: | |
299 if (STRINGP (sequence)) | |
826 | 300 return make_int (string_char_length (sequence)); |
428 | 301 else if (CONSP (sequence)) |
302 { | |
665 | 303 Elemcount len; |
428 | 304 GET_EXTERNAL_LIST_LENGTH (sequence, len); |
305 return make_int (len); | |
306 } | |
307 else if (VECTORP (sequence)) | |
308 return make_int (XVECTOR_LENGTH (sequence)); | |
309 else if (NILP (sequence)) | |
310 return Qzero; | |
311 else if (BIT_VECTORP (sequence)) | |
312 return make_int (bit_vector_length (XBIT_VECTOR (sequence))); | |
313 else | |
314 { | |
315 check_losing_bytecode ("length", sequence); | |
316 sequence = wrong_type_argument (Qsequencep, sequence); | |
317 goto retry; | |
318 } | |
319 } | |
320 | |
321 DEFUN ("safe-length", Fsafe_length, 1, 1, 0, /* | |
322 Return the length of a list, but avoid error or infinite loop. | |
323 This function never gets an error. If LIST is not really a list, | |
324 it returns 0. If LIST is circular, it returns a finite value | |
325 which is at least the number of distinct elements. | |
326 */ | |
327 (list)) | |
328 { | |
329 Lisp_Object hare, tortoise; | |
665 | 330 Elemcount len; |
428 | 331 |
332 for (hare = tortoise = list, len = 0; | |
333 CONSP (hare) && (! EQ (hare, tortoise) || len == 0); | |
334 hare = XCDR (hare), len++) | |
335 { | |
336 if (len & 1) | |
337 tortoise = XCDR (tortoise); | |
338 } | |
339 | |
340 return make_int (len); | |
341 } | |
342 | |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
343 /* This is almost the above, but is defined by Common Lisp. We need it in C |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
344 for shortest_length_among_sequences(), below, for the various sequence |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
345 functions that can usefully operate on circular lists. */ |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
346 |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
347 DEFUN ("list-length", Flist_length, 1, 1, 0, /* |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
348 Return the length of LIST. Return nil if LIST is circular. |
5299
28651c24b3f8
Error in #'list-length if LIST is dotted; check for this error with #'mapcar
Aidan Kehoe <kehoea@parhasard.net>
parents:
5285
diff
changeset
|
349 Error if LIST is dotted. |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
350 */ |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
351 (list)) |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
352 { |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
353 Lisp_Object hare, tortoise; |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
354 Elemcount len; |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
355 |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
356 for (hare = tortoise = list, len = 0; |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
357 CONSP (hare) && (! EQ (hare, tortoise) || len == 0); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
358 hare = XCDR (hare), len++) |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
359 { |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
360 if (len & 1) |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
361 tortoise = XCDR (tortoise); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
362 } |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
363 |
5299
28651c24b3f8
Error in #'list-length if LIST is dotted; check for this error with #'mapcar
Aidan Kehoe <kehoea@parhasard.net>
parents:
5285
diff
changeset
|
364 if (!LISTP (hare)) |
28651c24b3f8
Error in #'list-length if LIST is dotted; check for this error with #'mapcar
Aidan Kehoe <kehoea@parhasard.net>
parents:
5285
diff
changeset
|
365 { |
28651c24b3f8
Error in #'list-length if LIST is dotted; check for this error with #'mapcar
Aidan Kehoe <kehoea@parhasard.net>
parents:
5285
diff
changeset
|
366 signal_malformed_list_error (list); |
28651c24b3f8
Error in #'list-length if LIST is dotted; check for this error with #'mapcar
Aidan Kehoe <kehoea@parhasard.net>
parents:
5285
diff
changeset
|
367 } |
28651c24b3f8
Error in #'list-length if LIST is dotted; check for this error with #'mapcar
Aidan Kehoe <kehoea@parhasard.net>
parents:
5285
diff
changeset
|
368 |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
369 return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
370 } |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
371 |
428 | 372 /*** string functions. ***/ |
373 | |
374 DEFUN ("string-equal", Fstring_equal, 2, 2, 0, /* | |
375 Return t if two strings have identical contents. | |
376 Case is significant. Text properties are ignored. | |
377 \(Under XEmacs, `equal' also ignores text properties and extents in | |
378 strings, but this is not the case under FSF Emacs 19. In FSF Emacs 20 | |
379 `equal' is the same as in XEmacs, in that respect.) | |
380 Symbols are also allowed; their print names are used instead. | |
381 */ | |
444 | 382 (string1, string2)) |
428 | 383 { |
384 Bytecount len; | |
793 | 385 Lisp_Object p1, p2; |
428 | 386 |
444 | 387 if (SYMBOLP (string1)) |
388 p1 = XSYMBOL (string1)->name; | |
428 | 389 else |
390 { | |
444 | 391 CHECK_STRING (string1); |
793 | 392 p1 = string1; |
428 | 393 } |
394 | |
444 | 395 if (SYMBOLP (string2)) |
396 p2 = XSYMBOL (string2)->name; | |
428 | 397 else |
398 { | |
444 | 399 CHECK_STRING (string2); |
793 | 400 p2 = string2; |
428 | 401 } |
402 | |
793 | 403 return (((len = XSTRING_LENGTH (p1)) == XSTRING_LENGTH (p2)) && |
404 !memcmp (XSTRING_DATA (p1), XSTRING_DATA (p2), len)) ? Qt : Qnil; | |
428 | 405 } |
406 | |
801 | 407 DEFUN ("compare-strings", Fcompare_strings, 6, 7, 0, /* |
408 Compare the contents of two strings, maybe ignoring case. | |
409 In string STR1, skip the first START1 characters and stop at END1. | |
410 In string STR2, skip the first START2 characters and stop at END2. | |
4796
c45fdd4e1858
Don't args-out-of-range in compare-strings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
411 END1 and END2 default to the full lengths of the respective strings, |
4797
a5eca70cf401
Fix typo in last patch.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4796
diff
changeset
|
412 and arguments that are outside the string (negative STARTi or ENDi |
4796
c45fdd4e1858
Don't args-out-of-range in compare-strings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
413 greater than length) are coerced to 0 or string length as appropriate. |
c45fdd4e1858
Don't args-out-of-range in compare-strings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
414 |
c45fdd4e1858
Don't args-out-of-range in compare-strings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
415 Optional IGNORE-CASE non-nil means use case-insensitive comparison. |
c45fdd4e1858
Don't args-out-of-range in compare-strings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
416 Case is significant by default. |
801 | 417 |
418 The value is t if the strings (or specified portions) match. | |
419 If string STR1 is less, the value is a negative number N; | |
420 - 1 - N is the number of characters that match at the beginning. | |
421 If string STR1 is greater, the value is a positive number N; | |
422 N - 1 is the number of characters that match at the beginning. | |
423 */ | |
424 (str1, start1, end1, str2, start2, end2, ignore_case)) | |
425 { | |
426 Charcount ccstart1, ccend1, ccstart2, ccend2; | |
427 Bytecount bstart1, blen1, bstart2, blen2; | |
428 Charcount matching; | |
429 int res; | |
430 | |
431 CHECK_STRING (str1); | |
432 CHECK_STRING (str2); | |
433 get_string_range_char (str1, start1, end1, &ccstart1, &ccend1, | |
4796
c45fdd4e1858
Don't args-out-of-range in compare-strings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
434 GB_HISTORICAL_STRING_BEHAVIOR|GB_COERCE_RANGE); |
801 | 435 get_string_range_char (str2, start2, end2, &ccstart2, &ccend2, |
4796
c45fdd4e1858
Don't args-out-of-range in compare-strings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
436 GB_HISTORICAL_STRING_BEHAVIOR|GB_COERCE_RANGE); |
801 | 437 |
438 bstart1 = string_index_char_to_byte (str1, ccstart1); | |
439 blen1 = string_offset_char_to_byte_len (str1, bstart1, ccend1 - ccstart1); | |
440 bstart2 = string_index_char_to_byte (str2, ccstart2); | |
441 blen2 = string_offset_char_to_byte_len (str2, bstart2, ccend2 - ccstart2); | |
442 | |
443 res = ((NILP (ignore_case) ? qxetextcmp_matching : qxetextcasecmp_matching) | |
444 (XSTRING_DATA (str1) + bstart1, blen1, | |
445 XSTRING_DATA (str2) + bstart2, blen2, | |
446 &matching)); | |
447 | |
448 if (!res) | |
449 return Qt; | |
450 else if (res > 0) | |
451 return make_int (1 + matching); | |
452 else | |
453 return make_int (-1 - matching); | |
454 } | |
455 | |
428 | 456 DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /* |
457 Return t if first arg string is less than second in lexicographic order. | |
771 | 458 Comparison is simply done on a character-by-character basis using the |
459 numeric value of a character. (Note that this may not produce | |
460 particularly meaningful results under Mule if characters from | |
461 different charsets are being compared.) | |
428 | 462 |
463 Symbols are also allowed; their print names are used instead. | |
464 | |
771 | 465 Currently we don't do proper language-specific collation or handle |
466 multiple character sets. This may be changed when Unicode support | |
467 is implemented. | |
428 | 468 */ |
444 | 469 (string1, string2)) |
428 | 470 { |
793 | 471 Lisp_Object p1, p2; |
428 | 472 Charcount end, len2; |
473 int i; | |
474 | |
444 | 475 if (SYMBOLP (string1)) |
476 p1 = XSYMBOL (string1)->name; | |
793 | 477 else |
478 { | |
444 | 479 CHECK_STRING (string1); |
793 | 480 p1 = string1; |
428 | 481 } |
482 | |
444 | 483 if (SYMBOLP (string2)) |
484 p2 = XSYMBOL (string2)->name; | |
428 | 485 else |
486 { | |
444 | 487 CHECK_STRING (string2); |
793 | 488 p2 = string2; |
428 | 489 } |
490 | |
826 | 491 end = string_char_length (p1); |
492 len2 = string_char_length (p2); | |
428 | 493 if (end > len2) |
494 end = len2; | |
495 | |
496 { | |
867 | 497 Ibyte *ptr1 = XSTRING_DATA (p1); |
498 Ibyte *ptr2 = XSTRING_DATA (p2); | |
428 | 499 |
500 /* #### It is not really necessary to do this: We could compare | |
501 byte-by-byte and still get a reasonable comparison, since this | |
502 would compare characters with a charset in the same way. With | |
503 a little rearrangement of the leading bytes, we could make most | |
504 inter-charset comparisons work out the same, too; even if some | |
505 don't, this is not a big deal because inter-charset comparisons | |
506 aren't really well-defined anyway. */ | |
507 for (i = 0; i < end; i++) | |
508 { | |
867 | 509 if (itext_ichar (ptr1) != itext_ichar (ptr2)) |
510 return itext_ichar (ptr1) < itext_ichar (ptr2) ? Qt : Qnil; | |
511 INC_IBYTEPTR (ptr1); | |
512 INC_IBYTEPTR (ptr2); | |
428 | 513 } |
514 } | |
515 /* Can't do i < len2 because then comparison between "foo" and "foo^@" | |
516 won't work right in I18N2 case */ | |
517 return end < len2 ? Qt : Qnil; | |
518 } | |
519 | |
520 DEFUN ("string-modified-tick", Fstring_modified_tick, 1, 1, 0, /* | |
521 Return STRING's tick counter, incremented for each change to the string. | |
522 Each string has a tick counter which is incremented each time the contents | |
523 of the string are changed (e.g. with `aset'). It wraps around occasionally. | |
524 */ | |
525 (string)) | |
526 { | |
527 CHECK_STRING (string); | |
793 | 528 if (CONSP (XSTRING_PLIST (string)) && INTP (XCAR (XSTRING_PLIST (string)))) |
529 return XCAR (XSTRING_PLIST (string)); | |
428 | 530 else |
531 return Qzero; | |
532 } | |
533 | |
534 void | |
535 bump_string_modiff (Lisp_Object str) | |
536 { | |
793 | 537 Lisp_Object *ptr = &XSTRING_PLIST (str); |
428 | 538 |
539 #ifdef I18N3 | |
540 /* #### remove the `string-translatable' property from the string, | |
541 if there is one. */ | |
542 #endif | |
543 /* skip over extent info if it's there */ | |
544 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr))) | |
545 ptr = &XCDR (*ptr); | |
546 if (CONSP (*ptr) && INTP (XCAR (*ptr))) | |
793 | 547 XCAR (*ptr) = make_int (1+XINT (XCAR (*ptr))); |
428 | 548 else |
549 *ptr = Fcons (make_int (1), *ptr); | |
550 } | |
551 | |
552 | |
553 enum concat_target_type { c_cons, c_string, c_vector, c_bit_vector }; | |
554 static Lisp_Object concat (int nargs, Lisp_Object *args, | |
555 enum concat_target_type target_type, | |
556 int last_special); | |
557 | |
558 Lisp_Object | |
444 | 559 concat2 (Lisp_Object string1, Lisp_Object string2) |
428 | 560 { |
561 Lisp_Object args[2]; | |
444 | 562 args[0] = string1; |
563 args[1] = string2; | |
428 | 564 return concat (2, args, c_string, 0); |
565 } | |
566 | |
567 Lisp_Object | |
444 | 568 concat3 (Lisp_Object string1, Lisp_Object string2, Lisp_Object string3) |
428 | 569 { |
570 Lisp_Object args[3]; | |
444 | 571 args[0] = string1; |
572 args[1] = string2; | |
573 args[2] = string3; | |
428 | 574 return concat (3, args, c_string, 0); |
575 } | |
576 | |
577 Lisp_Object | |
444 | 578 vconcat2 (Lisp_Object vec1, Lisp_Object vec2) |
428 | 579 { |
580 Lisp_Object args[2]; | |
444 | 581 args[0] = vec1; |
582 args[1] = vec2; | |
428 | 583 return concat (2, args, c_vector, 0); |
584 } | |
585 | |
586 Lisp_Object | |
444 | 587 vconcat3 (Lisp_Object vec1, Lisp_Object vec2, Lisp_Object vec3) |
428 | 588 { |
589 Lisp_Object args[3]; | |
444 | 590 args[0] = vec1; |
591 args[1] = vec2; | |
592 args[2] = vec3; | |
428 | 593 return concat (3, args, c_vector, 0); |
594 } | |
595 | |
596 DEFUN ("append", Fappend, 0, MANY, 0, /* | |
597 Concatenate all the arguments and make the result a list. | |
598 The result is a list whose elements are the elements of all the arguments. | |
599 Each argument may be a list, vector, bit vector, or string. | |
600 The last argument is not copied, just used as the tail of the new list. | |
601 Also see: `nconc'. | |
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
602 |
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
603 arguments: (&rest ARGS) |
428 | 604 */ |
605 (int nargs, Lisp_Object *args)) | |
606 { | |
607 return concat (nargs, args, c_cons, 1); | |
608 } | |
609 | |
610 DEFUN ("concat", Fconcat, 0, MANY, 0, /* | |
611 Concatenate all the arguments and make the result a string. | |
612 The result is a string whose elements are the elements of all the arguments. | |
613 Each argument may be a string or a list or vector of characters. | |
614 | |
615 As of XEmacs 21.0, this function does NOT accept individual integers | |
616 as arguments. Old code that relies on, for example, (concat "foo" 50) | |
617 returning "foo50" will fail. To fix such code, either apply | |
618 `int-to-string' to the integer argument, or use `format'. | |
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
619 |
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
620 arguments: (&rest ARGS) |
428 | 621 */ |
622 (int nargs, Lisp_Object *args)) | |
623 { | |
624 return concat (nargs, args, c_string, 0); | |
625 } | |
626 | |
627 DEFUN ("vconcat", Fvconcat, 0, MANY, 0, /* | |
628 Concatenate all the arguments and make the result a vector. | |
629 The result is a vector whose elements are the elements of all the arguments. | |
630 Each argument may be a list, vector, bit vector, or string. | |
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
631 |
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
632 arguments: (&rest ARGS) |
428 | 633 */ |
634 (int nargs, Lisp_Object *args)) | |
635 { | |
636 return concat (nargs, args, c_vector, 0); | |
637 } | |
638 | |
639 DEFUN ("bvconcat", Fbvconcat, 0, MANY, 0, /* | |
640 Concatenate all the arguments and make the result a bit vector. | |
641 The result is a bit vector whose elements are the elements of all the | |
642 arguments. Each argument may be a list, vector, bit vector, or string. | |
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
643 |
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
644 arguments: (&rest ARGS) |
428 | 645 */ |
646 (int nargs, Lisp_Object *args)) | |
647 { | |
648 return concat (nargs, args, c_bit_vector, 0); | |
649 } | |
650 | |
651 /* Copy a (possibly dotted) list. LIST must be a cons. | |
652 Can't use concat (1, &alist, c_cons, 0) - doesn't handle dotted lists. */ | |
653 static Lisp_Object | |
654 copy_list (Lisp_Object list) | |
655 { | |
656 Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list)); | |
657 Lisp_Object last = list_copy; | |
658 Lisp_Object hare, tortoise; | |
665 | 659 Elemcount len; |
428 | 660 |
661 for (tortoise = hare = XCDR (list), len = 1; | |
662 CONSP (hare); | |
663 hare = XCDR (hare), len++) | |
664 { | |
665 XCDR (last) = Fcons (XCAR (hare), XCDR (hare)); | |
666 last = XCDR (last); | |
667 | |
668 if (len < CIRCULAR_LIST_SUSPICION_LENGTH) | |
669 continue; | |
670 if (len & 1) | |
671 tortoise = XCDR (tortoise); | |
672 if (EQ (tortoise, hare)) | |
673 signal_circular_list_error (list); | |
674 } | |
675 | |
676 return list_copy; | |
677 } | |
678 | |
679 DEFUN ("copy-list", Fcopy_list, 1, 1, 0, /* | |
680 Return a copy of list LIST, which may be a dotted list. | |
681 The elements of LIST are not copied; they are shared | |
682 with the original. | |
683 */ | |
684 (list)) | |
685 { | |
686 again: | |
687 if (NILP (list)) return list; | |
688 if (CONSP (list)) return copy_list (list); | |
689 | |
690 list = wrong_type_argument (Qlistp, list); | |
691 goto again; | |
692 } | |
693 | |
694 DEFUN ("copy-sequence", Fcopy_sequence, 1, 1, 0, /* | |
695 Return a copy of list, vector, bit vector or string SEQUENCE. | |
696 The elements of a list or vector are not copied; they are shared | |
697 with the original. SEQUENCE may be a dotted list. | |
698 */ | |
699 (sequence)) | |
700 { | |
701 again: | |
702 if (NILP (sequence)) return sequence; | |
703 if (CONSP (sequence)) return copy_list (sequence); | |
704 if (STRINGP (sequence)) return concat (1, &sequence, c_string, 0); | |
705 if (VECTORP (sequence)) return concat (1, &sequence, c_vector, 0); | |
706 if (BIT_VECTORP (sequence)) return concat (1, &sequence, c_bit_vector, 0); | |
707 | |
708 check_losing_bytecode ("copy-sequence", sequence); | |
709 sequence = wrong_type_argument (Qsequencep, sequence); | |
710 goto again; | |
711 } | |
712 | |
713 struct merge_string_extents_struct | |
714 { | |
715 Lisp_Object string; | |
716 Bytecount entry_offset; | |
717 Bytecount entry_length; | |
718 }; | |
719 | |
720 static Lisp_Object | |
721 concat (int nargs, Lisp_Object *args, | |
722 enum concat_target_type target_type, | |
723 int last_special) | |
724 { | |
725 Lisp_Object val; | |
726 Lisp_Object tail = Qnil; | |
727 int toindex; | |
728 int argnum; | |
729 Lisp_Object last_tail; | |
730 Lisp_Object prev; | |
731 struct merge_string_extents_struct *args_mse = 0; | |
867 | 732 Ibyte *string_result = 0; |
733 Ibyte *string_result_ptr = 0; | |
428 | 734 struct gcpro gcpro1; |
851 | 735 int sdep = specpdl_depth (); |
428 | 736 |
737 /* The modus operandi in Emacs is "caller gc-protects args". | |
738 However, concat is called many times in Emacs on freshly | |
739 created stuff. So we help those callers out by protecting | |
740 the args ourselves to save them a lot of temporary-variable | |
741 grief. */ | |
742 | |
743 GCPRO1 (args[0]); | |
744 gcpro1.nvars = nargs; | |
745 | |
746 #ifdef I18N3 | |
747 /* #### if the result is a string and any of the strings have a string | |
748 for the `string-translatable' property, then concat should also | |
749 concat the args but use the `string-translatable' strings, and store | |
750 the result in the returned string's `string-translatable' property. */ | |
751 #endif | |
752 if (target_type == c_string) | |
753 args_mse = alloca_array (struct merge_string_extents_struct, nargs); | |
754 | |
755 /* In append, the last arg isn't treated like the others */ | |
756 if (last_special && nargs > 0) | |
757 { | |
758 nargs--; | |
759 last_tail = args[nargs]; | |
760 } | |
761 else | |
762 last_tail = Qnil; | |
763 | |
764 /* Check and coerce the arguments. */ | |
765 for (argnum = 0; argnum < nargs; argnum++) | |
766 { | |
767 Lisp_Object seq = args[argnum]; | |
768 if (LISTP (seq)) | |
769 ; | |
770 else if (VECTORP (seq) || STRINGP (seq) || BIT_VECTORP (seq)) | |
771 ; | |
772 #ifdef LOSING_BYTECODE | |
773 else if (COMPILED_FUNCTIONP (seq)) | |
774 /* Urk! We allow this, for "compatibility"... */ | |
775 ; | |
776 #endif | |
777 #if 0 /* removed for XEmacs 21 */ | |
778 else if (INTP (seq)) | |
779 /* This is too revolting to think about but maintains | |
780 compatibility with FSF (and lots and lots of old code). */ | |
781 args[argnum] = Fnumber_to_string (seq); | |
782 #endif | |
783 else | |
784 { | |
785 check_losing_bytecode ("concat", seq); | |
786 args[argnum] = wrong_type_argument (Qsequencep, seq); | |
787 } | |
788 | |
789 if (args_mse) | |
790 { | |
791 if (STRINGP (seq)) | |
792 args_mse[argnum].string = seq; | |
793 else | |
794 args_mse[argnum].string = Qnil; | |
795 } | |
796 } | |
797 | |
798 { | |
799 /* Charcount is a misnomer here as we might be dealing with the | |
800 length of a vector or list, but emphasizes that we're not dealing | |
801 with Bytecounts in strings */ | |
802 Charcount total_length; | |
803 | |
804 for (argnum = 0, total_length = 0; argnum < nargs; argnum++) | |
805 { | |
806 #ifdef LOSING_BYTECODE | |
807 Charcount thislen = length_with_bytecode_hack (args[argnum]); | |
808 #else | |
809 Charcount thislen = XINT (Flength (args[argnum])); | |
810 #endif | |
811 total_length += thislen; | |
812 } | |
813 | |
814 switch (target_type) | |
815 { | |
816 case c_cons: | |
817 if (total_length == 0) | |
851 | 818 { |
819 unbind_to (sdep); | |
820 /* In append, if all but last arg are nil, return last arg */ | |
821 RETURN_UNGCPRO (last_tail); | |
822 } | |
428 | 823 val = Fmake_list (make_int (total_length), Qnil); |
824 break; | |
825 case c_vector: | |
826 val = make_vector (total_length, Qnil); | |
827 break; | |
828 case c_bit_vector: | |
829 val = make_bit_vector (total_length, Qzero); | |
830 break; | |
831 case c_string: | |
832 /* We don't make the string yet because we don't know the | |
833 actual number of bytes. This loop was formerly written | |
834 to call Fmake_string() here and then call set_string_char() | |
835 for each char. This seems logical enough but is waaaaaaaay | |
836 slow -- set_string_char() has to scan the whole string up | |
837 to the place where the substitution is called for in order | |
838 to find the place to change, and may have to do some | |
839 realloc()ing in order to make the char fit properly. | |
840 O(N^2) yuckage. */ | |
841 val = Qnil; | |
851 | 842 string_result = |
867 | 843 (Ibyte *) MALLOC_OR_ALLOCA (total_length * MAX_ICHAR_LEN); |
428 | 844 string_result_ptr = string_result; |
845 break; | |
846 default: | |
442 | 847 val = Qnil; |
2500 | 848 ABORT (); |
428 | 849 } |
850 } | |
851 | |
852 | |
853 if (CONSP (val)) | |
854 tail = val, toindex = -1; /* -1 in toindex is flag we are | |
855 making a list */ | |
856 else | |
857 toindex = 0; | |
858 | |
859 prev = Qnil; | |
860 | |
861 for (argnum = 0; argnum < nargs; argnum++) | |
862 { | |
863 Charcount thisleni = 0; | |
864 Charcount thisindex = 0; | |
865 Lisp_Object seq = args[argnum]; | |
867 | 866 Ibyte *string_source_ptr = 0; |
867 Ibyte *string_prev_result_ptr = string_result_ptr; | |
428 | 868 |
869 if (!CONSP (seq)) | |
870 { | |
871 #ifdef LOSING_BYTECODE | |
872 thisleni = length_with_bytecode_hack (seq); | |
873 #else | |
874 thisleni = XINT (Flength (seq)); | |
875 #endif | |
876 } | |
877 if (STRINGP (seq)) | |
878 string_source_ptr = XSTRING_DATA (seq); | |
879 | |
880 while (1) | |
881 { | |
882 Lisp_Object elt; | |
883 | |
884 /* We've come to the end of this arg, so exit. */ | |
885 if (NILP (seq)) | |
886 break; | |
887 | |
888 /* Fetch next element of `seq' arg into `elt' */ | |
889 if (CONSP (seq)) | |
890 { | |
891 elt = XCAR (seq); | |
892 seq = XCDR (seq); | |
893 } | |
894 else | |
895 { | |
896 if (thisindex >= thisleni) | |
897 break; | |
898 | |
899 if (STRINGP (seq)) | |
900 { | |
867 | 901 elt = make_char (itext_ichar (string_source_ptr)); |
902 INC_IBYTEPTR (string_source_ptr); | |
428 | 903 } |
904 else if (VECTORP (seq)) | |
905 elt = XVECTOR_DATA (seq)[thisindex]; | |
906 else if (BIT_VECTORP (seq)) | |
907 elt = make_int (bit_vector_bit (XBIT_VECTOR (seq), | |
908 thisindex)); | |
909 else | |
910 elt = Felt (seq, make_int (thisindex)); | |
911 thisindex++; | |
912 } | |
913 | |
914 /* Store into result */ | |
915 if (toindex < 0) | |
916 { | |
917 /* toindex negative means we are making a list */ | |
918 XCAR (tail) = elt; | |
919 prev = tail; | |
920 tail = XCDR (tail); | |
921 } | |
922 else if (VECTORP (val)) | |
923 XVECTOR_DATA (val)[toindex++] = elt; | |
924 else if (BIT_VECTORP (val)) | |
925 { | |
926 CHECK_BIT (elt); | |
927 set_bit_vector_bit (XBIT_VECTOR (val), toindex++, XINT (elt)); | |
928 } | |
929 else | |
930 { | |
931 CHECK_CHAR_COERCE_INT (elt); | |
867 | 932 string_result_ptr += set_itext_ichar (string_result_ptr, |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
933 XCHAR (elt)); |
428 | 934 } |
935 } | |
936 if (args_mse) | |
937 { | |
938 args_mse[argnum].entry_offset = | |
939 string_prev_result_ptr - string_result; | |
940 args_mse[argnum].entry_length = | |
941 string_result_ptr - string_prev_result_ptr; | |
942 } | |
943 } | |
944 | |
945 /* Now we finally make the string. */ | |
946 if (target_type == c_string) | |
947 { | |
948 val = make_string (string_result, string_result_ptr - string_result); | |
949 for (argnum = 0; argnum < nargs; argnum++) | |
950 { | |
951 if (STRINGP (args_mse[argnum].string)) | |
952 copy_string_extents (val, args_mse[argnum].string, | |
953 args_mse[argnum].entry_offset, 0, | |
954 args_mse[argnum].entry_length); | |
955 } | |
956 } | |
957 | |
958 if (!NILP (prev)) | |
959 XCDR (prev) = last_tail; | |
960 | |
851 | 961 unbind_to (sdep); |
428 | 962 RETURN_UNGCPRO (val); |
963 } | |
964 | |
965 DEFUN ("copy-alist", Fcopy_alist, 1, 1, 0, /* | |
966 Return a copy of ALIST. | |
967 This is an alist which represents the same mapping from objects to objects, | |
968 but does not share the alist structure with ALIST. | |
969 The objects mapped (cars and cdrs of elements of the alist) | |
970 are shared, however. | |
971 Elements of ALIST that are not conses are also shared. | |
972 */ | |
973 (alist)) | |
974 { | |
975 Lisp_Object tail; | |
976 | |
977 if (NILP (alist)) | |
978 return alist; | |
979 CHECK_CONS (alist); | |
980 | |
981 alist = concat (1, &alist, c_cons, 0); | |
982 for (tail = alist; CONSP (tail); tail = XCDR (tail)) | |
983 { | |
984 Lisp_Object car = XCAR (tail); | |
985 | |
986 if (CONSP (car)) | |
987 XCAR (tail) = Fcons (XCAR (car), XCDR (car)); | |
988 } | |
989 return alist; | |
990 } | |
991 | |
992 DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /* | |
993 Return a copy of a list and substructures. | |
994 The argument is copied, and any lists contained within it are copied | |
995 recursively. Circularities and shared substructures are not preserved. | |
996 Second arg VECP causes vectors to be copied, too. Strings and bit vectors | |
997 are not copied. | |
998 */ | |
999 (arg, vecp)) | |
1000 { | |
454 | 1001 return safe_copy_tree (arg, vecp, 0); |
1002 } | |
1003 | |
1004 Lisp_Object | |
1005 safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth) | |
1006 { | |
1007 if (depth > 200) | |
563 | 1008 stack_overflow ("Stack overflow in copy-tree", arg); |
454 | 1009 |
428 | 1010 if (CONSP (arg)) |
1011 { | |
1012 Lisp_Object rest; | |
1013 rest = arg = Fcopy_sequence (arg); | |
1014 while (CONSP (rest)) | |
1015 { | |
1016 Lisp_Object elt = XCAR (rest); | |
1017 QUIT; | |
1018 if (CONSP (elt) || VECTORP (elt)) | |
454 | 1019 XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1); |
428 | 1020 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */ |
454 | 1021 XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1); |
428 | 1022 rest = XCDR (rest); |
1023 } | |
1024 } | |
1025 else if (VECTORP (arg) && ! NILP (vecp)) | |
1026 { | |
1027 int i = XVECTOR_LENGTH (arg); | |
1028 int j; | |
1029 arg = Fcopy_sequence (arg); | |
1030 for (j = 0; j < i; j++) | |
1031 { | |
1032 Lisp_Object elt = XVECTOR_DATA (arg) [j]; | |
1033 QUIT; | |
1034 if (CONSP (elt) || VECTORP (elt)) | |
454 | 1035 XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1); |
428 | 1036 } |
1037 } | |
1038 return arg; | |
1039 } | |
1040 | |
1041 DEFUN ("subseq", Fsubseq, 2, 3, 0, /* | |
442 | 1042 Return the subsequence of SEQUENCE starting at START and ending before END. |
1043 END may be omitted; then the subsequence runs to the end of SEQUENCE. | |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1044 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1045 If START or END is negative, it counts from the end, in contravention of |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1046 Common Lisp. |
442 | 1047 The returned subsequence is always of the same type as SEQUENCE. |
1048 If SEQUENCE is a string, relevant parts of the string-extent-data | |
1049 are copied to the new string. | |
5224
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1050 |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1051 See also `substring-no-properties', which only operates on strings, and does |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1052 not copy extent data. |
428 | 1053 */ |
442 | 1054 (sequence, start, end)) |
428 | 1055 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1056 Elemcount len, ss, ee = EMACS_INT_MAX, ii; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1057 Lisp_Object result = Qnil; |
5089
99f8ebc082d9
Make #'substring an alias of #'subseq; give the latter the byte code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5051
diff
changeset
|
1058 |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
1059 CHECK_SEQUENCE (sequence); |
442 | 1060 CHECK_INT (start); |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1061 ss = XINT (start); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1062 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1063 if (!NILP (end)) |
428 | 1064 { |
442 | 1065 CHECK_INT (end); |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1066 ee = XINT (end); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1067 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1068 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1069 if (STRINGP (sequence)) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1070 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1071 Bytecount bstart, blen; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1072 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1073 get_string_range_char (sequence, start, end, &ss, &ee, |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1074 GB_HISTORICAL_STRING_BEHAVIOR); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1075 bstart = string_index_char_to_byte (sequence, ss); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1076 blen = string_offset_char_to_byte_len (sequence, bstart, ee - ss); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1077 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1078 result = make_string (XSTRING_DATA (sequence) + bstart, blen); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1079 /* Copy any applicable extent information into the new string. */ |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1080 copy_string_extents (result, sequence, 0, bstart, blen); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1081 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1082 else if (CONSP (sequence)) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1083 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1084 Lisp_Object result_tail, saved = sequence; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1085 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1086 if (ss < 0 || ee < 0) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1087 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1088 len = XINT (Flength (sequence)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1089 if (ss < 0) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1090 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1091 ss = len + ss; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1092 start = make_integer (ss); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1093 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1094 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1095 if (ee < 0) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1096 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1097 ee = len + ee; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1098 end = make_integer (ee); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1099 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1100 else |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1101 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1102 ee = min (ee, len); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1103 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1104 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1105 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1106 if (0 != ss) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1107 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1108 sequence = Fnthcdr (make_int (ss), sequence); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1109 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1110 |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
1111 ii = ss + 1; |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
1112 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1113 if (ss < ee && !NILP (sequence)) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1114 { |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
1115 result = result_tail = Fcons (Fcar (sequence), Qnil); |
442 | 1116 sequence = Fcdr (sequence); |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1117 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1118 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1119 EXTERNAL_LIST_LOOP_2 (elt, sequence) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1120 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1121 if (!(ii < ee)) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1122 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1123 break; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1124 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1125 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1126 XSETCDR (result_tail, Fcons (elt, Qnil)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1127 result_tail = XCDR (result_tail); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1128 ii++; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1129 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1130 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1131 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1132 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1133 if (NILP (result) || (ii < ee && !NILP (end))) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1134 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1135 /* We were handed a cons, which definitely has elements. nil |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1136 result means either ss >= ee or SEQUENCE was nil after the |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1137 nthcdr; in both cases that means START and END were incorrectly |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1138 specified for this sequence. ii < ee with a non-nil end means |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1139 the user handed us a bogus end value. */ |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1140 check_sequence_range (saved, start, end, Flength (saved)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1141 } |
442 | 1142 } |
1143 else | |
1144 { | |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1145 len = XINT (Flength (sequence)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1146 if (ss < 0) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1147 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1148 ss = len + ss; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1149 start = make_integer (ss); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1150 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1151 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1152 if (ee < 0) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1153 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1154 ee = len + ee; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1155 end = make_integer (ee); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1156 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1157 else |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1158 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1159 ee = min (len, ee); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1160 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1161 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1162 check_sequence_range (sequence, start, end, make_int (len)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1163 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1164 if (VECTORP (sequence)) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1165 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1166 result = Fvector (ee - ss, XVECTOR_DATA (sequence) + ss); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1167 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1168 else if (BIT_VECTORP (sequence)) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1169 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1170 result = make_bit_vector (ee - ss, Qzero); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1171 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1172 for (ii = ss; ii < ee; ii++) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1173 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1174 set_bit_vector_bit (XBIT_VECTOR (result), ii - ss, |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1175 bit_vector_bit (XBIT_VECTOR (sequence), ii)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1176 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1177 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1178 else if (NILP (sequence)) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1179 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1180 DO_NOTHING; |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1181 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1182 else |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1183 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1184 /* Won't happen, since CHECK_SEQUENCE didn't error. */ |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1185 ABORT (); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1186 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1187 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1188 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
1189 return result; |
428 | 1190 } |
1191 | |
5224
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1192 DEFUN ("substring-no-properties", Fsubstring_no_properties, 1, 3, 0, /* |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1193 Return a substring of STRING, without copying the extents. |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1194 END may be nil or omitted; then the substring runs to the end of STRING. |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1195 If START or END is negative, it counts from the end. |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1196 |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1197 With one argument, copy STRING without its properties. |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1198 */ |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1199 (string, start, end)) |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1200 { |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1201 Charcount ccstart, ccend; |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1202 Bytecount bstart, blen; |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1203 Lisp_Object val; |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1204 |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1205 get_string_range_char (string, start, end, &ccstart, &ccend, |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1206 GB_HISTORICAL_STRING_BEHAVIOR); |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1207 bstart = string_index_char_to_byte (string, ccstart); |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1208 blen = string_offset_char_to_byte_len (string, bstart, ccend - ccstart); |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1209 val = make_string (XSTRING_DATA (string) + bstart, blen); |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1210 |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1211 return val; |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1212 } |
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1213 |
771 | 1214 /* Split STRING into a list of substrings. The substrings are the |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1215 parts of original STRING separated by SEPCHAR. |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1216 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1217 If UNESCAPE is non-zero, ESCAPECHAR specifies a character that will quote |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1218 SEPCHAR, and cause it not to split STRING. A double ESCAPECHAR is |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1219 necessary for ESCAPECHAR to appear once in a substring. */ |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1220 |
771 | 1221 static Lisp_Object |
867 | 1222 split_string_by_ichar_1 (const Ibyte *string, Bytecount size, |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1223 Ichar sepchar, int unescape, Ichar escapechar) |
771 | 1224 { |
1225 Lisp_Object result = Qnil; | |
867 | 1226 const Ibyte *end = string + size; |
771 | 1227 |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1228 if (unescape) |
771 | 1229 { |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1230 Ibyte unescape_buffer[64], *unescape_buffer_ptr = unescape_buffer, |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1231 escaped[MAX_ICHAR_LEN], *unescape_cursor; |
5036
9624523604c5
Use better types when ESCAPECHAR is specified, split_string_by_ichar_1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5035
diff
changeset
|
1232 Bytecount unescape_buffer_size = countof (unescape_buffer), |
9624523604c5
Use better types when ESCAPECHAR is specified, split_string_by_ichar_1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5035
diff
changeset
|
1233 escaped_len = set_itext_ichar (escaped, escapechar); |
9624523604c5
Use better types when ESCAPECHAR is specified, split_string_by_ichar_1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5035
diff
changeset
|
1234 Boolint deleting_escapes, previous_escaped; |
9624523604c5
Use better types when ESCAPECHAR is specified, split_string_by_ichar_1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5035
diff
changeset
|
1235 Ichar pchar; |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1236 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1237 while (1) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1238 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1239 const Ibyte *p = string, *cursor; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1240 deleting_escapes = 0; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1241 previous_escaped = 0; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1242 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1243 while (p < end) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1244 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1245 pchar = itext_ichar (p); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1246 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1247 if (pchar == sepchar) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1248 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1249 if (!previous_escaped) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1250 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1251 break; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1252 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1253 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1254 else if (pchar == escapechar |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1255 /* Doubled escapes don't escape: */ |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1256 && !previous_escaped) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1257 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1258 ++deleting_escapes; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1259 previous_escaped = 1; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1260 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1261 else |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1262 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1263 previous_escaped = 0; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1264 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1265 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1266 INC_IBYTEPTR (p); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1267 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1268 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1269 if (deleting_escapes) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1270 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1271 if (((p - string) - (escaped_len * deleting_escapes)) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1272 > unescape_buffer_size) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1273 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1274 unescape_buffer_size = |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1275 ((p - string) - (escaped_len * deleting_escapes)) * 1.5; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1276 unescape_buffer_ptr = alloca_ibytes (unescape_buffer_size); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1277 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1278 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1279 cursor = string; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1280 unescape_cursor = unescape_buffer_ptr; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1281 previous_escaped = 0; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1282 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1283 while (cursor < p) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1284 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1285 pchar = itext_ichar (cursor); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1286 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1287 if (pchar != escapechar || previous_escaped) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1288 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1289 memcpy (unescape_cursor, cursor, |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1290 itext_ichar_len (cursor)); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1291 INC_IBYTEPTR (unescape_cursor); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1292 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1293 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1294 previous_escaped = !previous_escaped |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1295 && (pchar == escapechar); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1296 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1297 INC_IBYTEPTR (cursor); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1298 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1299 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1300 result = Fcons (make_string (unescape_buffer_ptr, |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1301 unescape_cursor |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1302 - unescape_buffer_ptr), |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1303 result); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1304 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1305 else |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1306 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1307 result = Fcons (make_string (string, p - string), result); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1308 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1309 if (p < end) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1310 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1311 string = p; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1312 INC_IBYTEPTR (string); /* skip sepchar */ |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1313 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1314 else |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1315 break; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1316 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1317 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1318 else |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1319 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1320 while (1) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1321 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1322 const Ibyte *p = string; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1323 while (p < end) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1324 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1325 if (itext_ichar (p) == sepchar) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1326 break; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1327 INC_IBYTEPTR (p); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1328 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1329 result = Fcons (make_string (string, p - string), result); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1330 if (p < end) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1331 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1332 string = p; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1333 INC_IBYTEPTR (string); /* skip sepchar */ |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1334 } |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1335 else |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1336 break; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1337 } |
771 | 1338 } |
1339 return Fnreverse (result); | |
1340 } | |
1341 | |
1342 /* The same as the above, except PATH is an external C string (it is | |
1343 converted using Qfile_name), and sepchar is hardcoded to SEPCHAR | |
1344 (':' or whatever). */ | |
1345 Lisp_Object | |
1346 split_external_path (const Extbyte *path) | |
1347 { | |
1348 Bytecount newlen; | |
867 | 1349 Ibyte *newpath; |
771 | 1350 if (!path) |
1351 return Qnil; | |
1352 | |
1353 TO_INTERNAL_FORMAT (C_STRING, path, ALLOCA, (newpath, newlen), Qfile_name); | |
1354 | |
1355 /* #### Does this make sense? It certainly does for | |
1356 split_env_path(), but it looks dubious here. Does any code | |
1357 depend on split_external_path("") returning nil instead of an empty | |
1358 string? */ | |
1359 if (!newlen) | |
1360 return Qnil; | |
1361 | |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1362 return split_string_by_ichar_1 (newpath, newlen, SEPCHAR, 0, 0); |
771 | 1363 } |
1364 | |
1365 Lisp_Object | |
867 | 1366 split_env_path (const CIbyte *evarname, const Ibyte *default_) |
771 | 1367 { |
867 | 1368 const Ibyte *path = 0; |
771 | 1369 if (evarname) |
1370 path = egetenv (evarname); | |
1371 if (!path) | |
1372 path = default_; | |
1373 if (!path) | |
1374 return Qnil; | |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1375 return split_string_by_ichar_1 (path, qxestrlen (path), SEPCHAR, 0, 0); |
771 | 1376 } |
1377 | |
1378 /* Ben thinks this function should not exist or be exported to Lisp. | |
1379 We use it to define split-path-string in subr.el (not!). */ | |
1380 | |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1381 DEFUN ("split-string-by-char", Fsplit_string_by_char, 2, 3, 0, /* |
771 | 1382 Split STRING into a list of substrings originally separated by SEPCHAR. |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1383 |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1384 With optional ESCAPE-CHAR, any instances of SEPCHAR preceded by that |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1385 character will not split the string, and a double instance of ESCAPE-CHAR |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1386 will be necessary for a single ESCAPE-CHAR to appear in the output string. |
771 | 1387 */ |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1388 (string, sepchar, escape_char)) |
771 | 1389 { |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1390 Ichar escape_ichar = 0; |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1391 |
771 | 1392 CHECK_STRING (string); |
1393 CHECK_CHAR (sepchar); | |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1394 if (!NILP (escape_char)) |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1395 { |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1396 CHECK_CHAR (escape_char); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1397 escape_ichar = XCHAR (escape_char); |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1398 } |
867 | 1399 return split_string_by_ichar_1 (XSTRING_DATA (string), |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1400 XSTRING_LENGTH (string), |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1401 XCHAR (sepchar), |
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1402 !NILP (escape_char), escape_ichar); |
771 | 1403 } |
1404 | |
1405 /* #### This was supposed to be in subr.el, but is used VERY early in | |
1406 the bootstrap process, so it goes here. Damn. */ | |
1407 | |
1408 DEFUN ("split-path", Fsplit_path, 1, 1, 0, /* | |
1409 Explode a search path into a list of strings. | |
1410 The path components are separated with the characters specified | |
1411 with `path-separator'. | |
1412 */ | |
1413 (path)) | |
1414 { | |
1415 CHECK_STRING (path); | |
1416 | |
1417 while (!STRINGP (Vpath_separator) | |
826 | 1418 || (string_char_length (Vpath_separator) != 1)) |
771 | 1419 Vpath_separator = signal_continuable_error |
1420 (Qinvalid_state, | |
1421 "`path-separator' should be set to a single-character string", | |
1422 Vpath_separator); | |
1423 | |
867 | 1424 return (split_string_by_ichar_1 |
771 | 1425 (XSTRING_DATA (path), XSTRING_LENGTH (path), |
5035
b1e48555be7d
Add a new optional ESCAPE-CHAR argument to #'split-string-by-char.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5034
diff
changeset
|
1426 itext_ichar (XSTRING_DATA (Vpath_separator)), 0, 0)); |
771 | 1427 } |
1428 | |
428 | 1429 |
1430 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /* | |
1431 Take cdr N times on LIST, and return the result. | |
1432 */ | |
1433 (n, list)) | |
1434 { | |
1920 | 1435 /* This function can GC */ |
647 | 1436 REGISTER EMACS_INT i; |
428 | 1437 REGISTER Lisp_Object tail = list; |
1438 CHECK_NATNUM (n); | |
1439 for (i = XINT (n); i; i--) | |
1440 { | |
1441 if (CONSP (tail)) | |
1442 tail = XCDR (tail); | |
1443 else if (NILP (tail)) | |
1444 return Qnil; | |
1445 else | |
1446 { | |
1447 tail = wrong_type_argument (Qlistp, tail); | |
1448 i++; | |
1449 } | |
1450 } | |
1451 return tail; | |
1452 } | |
1453 | |
1454 DEFUN ("nth", Fnth, 2, 2, 0, /* | |
1455 Return the Nth element of LIST. | |
1456 N counts from zero. If LIST is not that long, nil is returned. | |
1457 */ | |
1458 (n, list)) | |
1459 { | |
1920 | 1460 /* This function can GC */ |
428 | 1461 return Fcar (Fnthcdr (n, list)); |
1462 } | |
1463 | |
1464 DEFUN ("elt", Felt, 2, 2, 0, /* | |
1465 Return element of SEQUENCE at index N. | |
1466 */ | |
1467 (sequence, n)) | |
1468 { | |
1920 | 1469 /* This function can GC */ |
428 | 1470 retry: |
1471 CHECK_INT_COERCE_CHAR (n); /* yuck! */ | |
1472 if (LISTP (sequence)) | |
1473 { | |
1474 Lisp_Object tem = Fnthcdr (n, sequence); | |
1475 /* #### Utterly, completely, fucking disgusting. | |
1476 * #### The whole point of "elt" is that it operates on | |
1477 * #### sequences, and does error- (bounds-) checking. | |
1478 */ | |
1479 if (CONSP (tem)) | |
1480 return XCAR (tem); | |
1481 else | |
1482 #if 1 | |
1483 /* This is The Way It Has Always Been. */ | |
1484 return Qnil; | |
1485 #else | |
1486 /* This is The Way Mly and Cltl2 say It Should Be. */ | |
1487 args_out_of_range (sequence, n); | |
1488 #endif | |
1489 } | |
1490 else if (STRINGP (sequence) || | |
1491 VECTORP (sequence) || | |
1492 BIT_VECTORP (sequence)) | |
1493 return Faref (sequence, n); | |
1494 #ifdef LOSING_BYTECODE | |
1495 else if (COMPILED_FUNCTIONP (sequence)) | |
1496 { | |
1497 EMACS_INT idx = XINT (n); | |
1498 if (idx < 0) | |
1499 { | |
1500 lose: | |
1501 args_out_of_range (sequence, n); | |
1502 } | |
1503 /* Utter perversity */ | |
1504 { | |
1505 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (sequence); | |
1506 switch (idx) | |
1507 { | |
1508 case COMPILED_ARGLIST: | |
1509 return compiled_function_arglist (f); | |
1510 case COMPILED_INSTRUCTIONS: | |
1511 return compiled_function_instructions (f); | |
1512 case COMPILED_CONSTANTS: | |
1513 return compiled_function_constants (f); | |
1514 case COMPILED_STACK_DEPTH: | |
1515 return compiled_function_stack_depth (f); | |
1516 case COMPILED_DOC_STRING: | |
1517 return compiled_function_documentation (f); | |
1518 case COMPILED_DOMAIN: | |
1519 return compiled_function_domain (f); | |
1520 case COMPILED_INTERACTIVE: | |
1521 if (f->flags.interactivep) | |
1522 return compiled_function_interactive (f); | |
1523 /* if we return nil, can't tell interactive with no args | |
1524 from noninteractive. */ | |
1525 goto lose; | |
1526 default: | |
1527 goto lose; | |
1528 } | |
1529 } | |
1530 } | |
1531 #endif /* LOSING_BYTECODE */ | |
1532 else | |
1533 { | |
1534 check_losing_bytecode ("elt", sequence); | |
1535 sequence = wrong_type_argument (Qsequencep, sequence); | |
1536 goto retry; | |
1537 } | |
1538 } | |
1539 | |
1540 DEFUN ("last", Flast, 1, 2, 0, /* | |
1541 Return the tail of list LIST, of length N (default 1). | |
1542 LIST may be a dotted list, but not a circular list. | |
1543 Optional argument N must be a non-negative integer. | |
1544 If N is zero, then the atom that terminates the list is returned. | |
1545 If N is greater than the length of LIST, then LIST itself is returned. | |
1546 */ | |
1547 (list, n)) | |
1548 { | |
1549 EMACS_INT int_n, count; | |
1550 Lisp_Object retval, tortoise, hare; | |
1551 | |
1552 CHECK_LIST (list); | |
1553 | |
1554 if (NILP (n)) | |
1555 int_n = 1; | |
1556 else | |
1557 { | |
1558 CHECK_NATNUM (n); | |
1559 int_n = XINT (n); | |
1560 } | |
1561 | |
1562 for (retval = tortoise = hare = list, count = 0; | |
1563 CONSP (hare); | |
1564 hare = XCDR (hare), | |
1565 (int_n-- <= 0 ? ((void) (retval = XCDR (retval))) : (void)0), | |
1566 count++) | |
1567 { | |
1568 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue; | |
1569 | |
1570 if (count & 1) | |
1571 tortoise = XCDR (tortoise); | |
1572 if (EQ (hare, tortoise)) | |
1573 signal_circular_list_error (list); | |
1574 } | |
1575 | |
1576 return retval; | |
1577 } | |
1578 | |
1579 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* | |
1580 Modify LIST to remove the last N (default 1) elements. | |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1581 |
428 | 1582 If LIST has N or fewer elements, nil is returned and LIST is unmodified. |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1583 Otherwise, LIST may be dotted, but not circular. |
428 | 1584 */ |
1585 (list, n)) | |
1586 { | |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1587 Elemcount int_n = 1; |
428 | 1588 |
1589 CHECK_LIST (list); | |
1590 | |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1591 if (!NILP (n)) |
428 | 1592 { |
1593 CHECK_NATNUM (n); | |
1594 int_n = XINT (n); | |
1595 } | |
1596 | |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1597 if (CONSP (list)) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1598 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1599 Lisp_Object last_cons = list; |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1600 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1601 EXTERNAL_LIST_LOOP_3 (elt, list, tail) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1602 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1603 if (int_n-- < 0) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1604 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1605 last_cons = XCDR (last_cons); |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1606 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1607 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1608 if (!CONSP (XCDR (tail))) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1609 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1610 break; |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1611 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1612 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1613 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1614 if (int_n >= 0) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1615 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1616 return Qnil; |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1617 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1618 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1619 XCDR (last_cons) = Qnil; |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1620 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1621 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1622 return list; |
428 | 1623 } |
1624 | |
1625 DEFUN ("butlast", Fbutlast, 1, 2, 0, /* | |
1626 Return a copy of LIST with the last N (default 1) elements removed. | |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1627 |
428 | 1628 If LIST has N or fewer elements, nil is returned. |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1629 Otherwise, LIST may be dotted, but not circular, and `(butlast LIST 0)' |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1630 converts a dotted into a true list. |
428 | 1631 */ |
1632 (list, n)) | |
1633 { | |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1634 Lisp_Object retval = Qnil, retval_tail = Qnil; |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1635 Elemcount int_n = 1; |
428 | 1636 |
1637 CHECK_LIST (list); | |
1638 | |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1639 if (!NILP (n)) |
428 | 1640 { |
1641 CHECK_NATNUM (n); | |
1642 int_n = XINT (n); | |
1643 } | |
1644 | |
5285
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1645 if (CONSP (list)) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1646 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1647 Lisp_Object tail = list; |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1648 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1649 EXTERNAL_LIST_LOOP_3 (elt, list, list_tail) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1650 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1651 if (--int_n < 0) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1652 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1653 if (NILP (retval_tail)) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1654 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1655 retval = retval_tail = Fcons (XCAR (tail), Qnil); |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1656 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1657 else |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1658 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1659 XSETCDR (retval_tail, Fcons (XCAR (tail), Qnil)); |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1660 retval_tail = XCDR (retval_tail); |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1661 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1662 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1663 tail = XCDR (tail); |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1664 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1665 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1666 if (!CONSP (XCDR (list_tail))) |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1667 { |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1668 break; |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1669 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1670 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1671 } |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1672 |
99de5fd48e87
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff
Aidan Kehoe <kehoea@parhasard.net>
parents:
5283
diff
changeset
|
1673 return retval; |
428 | 1674 } |
1675 | |
1676 DEFUN ("member", Fmember, 2, 2, 0, /* | |
1677 Return non-nil if ELT is an element of LIST. Comparison done with `equal'. | |
1678 The value is actually the tail of LIST whose car is ELT. | |
1679 */ | |
1680 (elt, list)) | |
1681 { | |
1682 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) | |
1683 { | |
1684 if (internal_equal (elt, list_elt, 0)) | |
1685 return tail; | |
1686 } | |
1687 return Qnil; | |
1688 } | |
1689 | |
1690 DEFUN ("old-member", Fold_member, 2, 2, 0, /* | |
1691 Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'. | |
1692 The value is actually the tail of LIST whose car is ELT. | |
1693 This function is provided only for byte-code compatibility with v19. | |
1694 Do not use it. | |
1695 */ | |
1696 (elt, list)) | |
1697 { | |
1698 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) | |
1699 { | |
1700 if (internal_old_equal (elt, list_elt, 0)) | |
1701 return tail; | |
1702 } | |
1703 return Qnil; | |
1704 } | |
1705 | |
1706 DEFUN ("memq", Fmemq, 2, 2, 0, /* | |
1707 Return non-nil if ELT is an element of LIST. Comparison done with `eq'. | |
1708 The value is actually the tail of LIST whose car is ELT. | |
1709 */ | |
1710 (elt, list)) | |
1711 { | |
1712 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) | |
1713 { | |
1714 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) | |
1715 return tail; | |
1716 } | |
1717 return Qnil; | |
1718 } | |
1719 | |
1720 DEFUN ("old-memq", Fold_memq, 2, 2, 0, /* | |
1721 Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'. | |
1722 The value is actually the tail of LIST whose car is ELT. | |
1723 This function is provided only for byte-code compatibility with v19. | |
1724 Do not use it. | |
1725 */ | |
1726 (elt, list)) | |
1727 { | |
1728 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) | |
1729 { | |
1730 if (HACKEQ_UNSAFE (elt, list_elt)) | |
1731 return tail; | |
1732 } | |
1733 return Qnil; | |
1734 } | |
1735 | |
1736 Lisp_Object | |
1737 memq_no_quit (Lisp_Object elt, Lisp_Object list) | |
1738 { | |
1739 LIST_LOOP_3 (list_elt, list, tail) | |
1740 { | |
1741 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) | |
1742 return tail; | |
1743 } | |
1744 return Qnil; | |
1745 } | |
1746 | |
1747 DEFUN ("assoc", Fassoc, 2, 2, 0, /* | |
444 | 1748 Return non-nil if KEY is `equal' to the car of an element of ALIST. |
1749 The value is actually the element of ALIST whose car equals KEY. | |
428 | 1750 */ |
444 | 1751 (key, alist)) |
428 | 1752 { |
1753 /* This function can GC. */ | |
444 | 1754 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
428 | 1755 { |
1756 if (internal_equal (key, elt_car, 0)) | |
1757 return elt; | |
1758 } | |
1759 return Qnil; | |
1760 } | |
1761 | |
1762 DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* | |
444 | 1763 Return non-nil if KEY is `old-equal' to the car of an element of ALIST. |
1764 The value is actually the element of ALIST whose car equals KEY. | |
428 | 1765 */ |
444 | 1766 (key, alist)) |
428 | 1767 { |
1768 /* This function can GC. */ | |
444 | 1769 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
428 | 1770 { |
1771 if (internal_old_equal (key, elt_car, 0)) | |
1772 return elt; | |
1773 } | |
1774 return Qnil; | |
1775 } | |
1776 | |
1777 Lisp_Object | |
444 | 1778 assoc_no_quit (Lisp_Object key, Lisp_Object alist) |
428 | 1779 { |
1780 int speccount = specpdl_depth (); | |
1781 specbind (Qinhibit_quit, Qt); | |
771 | 1782 return unbind_to_1 (speccount, Fassoc (key, alist)); |
428 | 1783 } |
1784 | |
1785 DEFUN ("assq", Fassq, 2, 2, 0, /* | |
444 | 1786 Return non-nil if KEY is `eq' to the car of an element of ALIST. |
1787 The value is actually the element of ALIST whose car is KEY. | |
1788 Elements of ALIST that are not conses are ignored. | |
428 | 1789 */ |
444 | 1790 (key, alist)) |
428 | 1791 { |
444 | 1792 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
428 | 1793 { |
1794 if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) | |
1795 return elt; | |
1796 } | |
1797 return Qnil; | |
1798 } | |
1799 | |
1800 DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* | |
444 | 1801 Return non-nil if KEY is `old-eq' to the car of an element of ALIST. |
1802 The value is actually the element of ALIST whose car is KEY. | |
1803 Elements of ALIST that are not conses are ignored. | |
428 | 1804 This function is provided only for byte-code compatibility with v19. |
1805 Do not use it. | |
1806 */ | |
444 | 1807 (key, alist)) |
428 | 1808 { |
444 | 1809 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
428 | 1810 { |
1811 if (HACKEQ_UNSAFE (key, elt_car)) | |
1812 return elt; | |
1813 } | |
1814 return Qnil; | |
1815 } | |
1816 | |
1817 /* Like Fassq but never report an error and do not allow quits. | |
1818 Use only on lists known never to be circular. */ | |
1819 | |
1820 Lisp_Object | |
444 | 1821 assq_no_quit (Lisp_Object key, Lisp_Object alist) |
428 | 1822 { |
1823 /* This cannot GC. */ | |
444 | 1824 LIST_LOOP_2 (elt, alist) |
428 | 1825 { |
1826 Lisp_Object elt_car = XCAR (elt); | |
1827 if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) | |
1828 return elt; | |
1829 } | |
1830 return Qnil; | |
1831 } | |
1832 | |
1833 DEFUN ("rassoc", Frassoc, 2, 2, 0, /* | |
444 | 1834 Return non-nil if VALUE is `equal' to the cdr of an element of ALIST. |
1835 The value is actually the element of ALIST whose cdr equals VALUE. | |
428 | 1836 */ |
444 | 1837 (value, alist)) |
428 | 1838 { |
444 | 1839 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
428 | 1840 { |
444 | 1841 if (internal_equal (value, elt_cdr, 0)) |
428 | 1842 return elt; |
1843 } | |
1844 return Qnil; | |
1845 } | |
1846 | |
1847 DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* | |
444 | 1848 Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST. |
1849 The value is actually the element of ALIST whose cdr equals VALUE. | |
428 | 1850 */ |
444 | 1851 (value, alist)) |
428 | 1852 { |
444 | 1853 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
428 | 1854 { |
444 | 1855 if (internal_old_equal (value, elt_cdr, 0)) |
428 | 1856 return elt; |
1857 } | |
1858 return Qnil; | |
1859 } | |
1860 | |
1861 DEFUN ("rassq", Frassq, 2, 2, 0, /* | |
444 | 1862 Return non-nil if VALUE is `eq' to the cdr of an element of ALIST. |
1863 The value is actually the element of ALIST whose cdr is VALUE. | |
428 | 1864 */ |
444 | 1865 (value, alist)) |
428 | 1866 { |
444 | 1867 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
428 | 1868 { |
444 | 1869 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr)) |
428 | 1870 return elt; |
1871 } | |
1872 return Qnil; | |
1873 } | |
1874 | |
1875 DEFUN ("old-rassq", Fold_rassq, 2, 2, 0, /* | |
444 | 1876 Return non-nil if VALUE is `old-eq' to the cdr of an element of ALIST. |
1877 The value is actually the element of ALIST whose cdr is VALUE. | |
428 | 1878 */ |
444 | 1879 (value, alist)) |
428 | 1880 { |
444 | 1881 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
428 | 1882 { |
444 | 1883 if (HACKEQ_UNSAFE (value, elt_cdr)) |
428 | 1884 return elt; |
1885 } | |
1886 return Qnil; | |
1887 } | |
1888 | |
444 | 1889 /* Like Frassq, but caller must ensure that ALIST is properly |
428 | 1890 nil-terminated and ebola-free. */ |
1891 Lisp_Object | |
444 | 1892 rassq_no_quit (Lisp_Object value, Lisp_Object alist) |
428 | 1893 { |
444 | 1894 LIST_LOOP_2 (elt, alist) |
428 | 1895 { |
1896 Lisp_Object elt_cdr = XCDR (elt); | |
444 | 1897 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr)) |
428 | 1898 return elt; |
1899 } | |
1900 return Qnil; | |
1901 } | |
1902 | |
1903 | |
1904 DEFUN ("delete", Fdelete, 2, 2, 0, /* | |
1905 Delete by side effect any occurrences of ELT as a member of LIST. | |
1906 The modified LIST is returned. Comparison is done with `equal'. | |
1907 If the first member of LIST is ELT, there is no way to remove it by side | |
1908 effect; therefore, write `(setq foo (delete element foo))' to be sure | |
1909 of changing the value of `foo'. | |
1910 Also see: `remove'. | |
1911 */ | |
1912 (elt, list)) | |
1913 { | |
1914 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, | |
1915 (internal_equal (elt, list_elt, 0))); | |
1916 return list; | |
1917 } | |
1918 | |
1919 DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* | |
1920 Delete by side effect any occurrences of ELT as a member of LIST. | |
1921 The modified LIST is returned. Comparison is done with `old-equal'. | |
1922 If the first member of LIST is ELT, there is no way to remove it by side | |
1923 effect; therefore, write `(setq foo (old-delete element foo))' to be sure | |
1924 of changing the value of `foo'. | |
1925 */ | |
1926 (elt, list)) | |
1927 { | |
1928 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, | |
1929 (internal_old_equal (elt, list_elt, 0))); | |
1930 return list; | |
1931 } | |
1932 | |
1933 DEFUN ("delq", Fdelq, 2, 2, 0, /* | |
1934 Delete by side effect any occurrences of ELT as a member of LIST. | |
1935 The modified LIST is returned. Comparison is done with `eq'. | |
1936 If the first member of LIST is ELT, there is no way to remove it by side | |
1937 effect; therefore, write `(setq foo (delq element foo))' to be sure of | |
1938 changing the value of `foo'. | |
1939 */ | |
1940 (elt, list)) | |
1941 { | |
1942 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, | |
1943 (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); | |
1944 return list; | |
1945 } | |
1946 | |
1947 DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* | |
1948 Delete by side effect any occurrences of ELT as a member of LIST. | |
1949 The modified LIST is returned. Comparison is done with `old-eq'. | |
1950 If the first member of LIST is ELT, there is no way to remove it by side | |
1951 effect; therefore, write `(setq foo (old-delq element foo))' to be sure of | |
1952 changing the value of `foo'. | |
1953 */ | |
1954 (elt, list)) | |
1955 { | |
1956 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, | |
1957 (HACKEQ_UNSAFE (elt, list_elt))); | |
1958 return list; | |
1959 } | |
1960 | |
1961 /* Like Fdelq, but caller must ensure that LIST is properly | |
1962 nil-terminated and ebola-free. */ | |
1963 | |
1964 Lisp_Object | |
1965 delq_no_quit (Lisp_Object elt, Lisp_Object list) | |
1966 { | |
1967 LIST_LOOP_DELETE_IF (list_elt, list, | |
1968 (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); | |
1969 return list; | |
1970 } | |
1971 | |
1972 /* Be VERY careful with this. This is like delq_no_quit() but | |
1973 also calls free_cons() on the removed conses. You must be SURE | |
1974 that no pointers to the freed conses remain around (e.g. | |
1975 someone else is pointing to part of the list). This function | |
1976 is useful on internal lists that are used frequently and where | |
1977 the actual list doesn't escape beyond known code bounds. */ | |
1978 | |
1979 Lisp_Object | |
1980 delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list) | |
1981 { | |
1982 REGISTER Lisp_Object tail = list; | |
1983 REGISTER Lisp_Object prev = Qnil; | |
1984 | |
1985 while (!NILP (tail)) | |
1986 { | |
1987 REGISTER Lisp_Object tem = XCAR (tail); | |
1988 if (EQ (elt, tem)) | |
1989 { | |
1990 Lisp_Object cons_to_free = tail; | |
1991 if (NILP (prev)) | |
1992 list = XCDR (tail); | |
1993 else | |
1994 XCDR (prev) = XCDR (tail); | |
1995 tail = XCDR (tail); | |
853 | 1996 free_cons (cons_to_free); |
428 | 1997 } |
1998 else | |
1999 { | |
2000 prev = tail; | |
2001 tail = XCDR (tail); | |
2002 } | |
2003 } | |
2004 return list; | |
2005 } | |
2006 | |
2007 DEFUN ("remassoc", Fremassoc, 2, 2, 0, /* | |
444 | 2008 Delete by side effect any elements of ALIST whose car is `equal' to KEY. |
2009 The modified ALIST is returned. If the first member of ALIST has a car | |
428 | 2010 that is `equal' to KEY, there is no way to remove it by side effect; |
2011 therefore, write `(setq foo (remassoc key foo))' to be sure of changing | |
2012 the value of `foo'. | |
2013 */ | |
444 | 2014 (key, alist)) |
428 | 2015 { |
444 | 2016 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist, |
428 | 2017 (CONSP (elt) && |
2018 internal_equal (key, XCAR (elt), 0))); | |
444 | 2019 return alist; |
428 | 2020 } |
2021 | |
2022 Lisp_Object | |
444 | 2023 remassoc_no_quit (Lisp_Object key, Lisp_Object alist) |
428 | 2024 { |
2025 int speccount = specpdl_depth (); | |
2026 specbind (Qinhibit_quit, Qt); | |
771 | 2027 return unbind_to_1 (speccount, Fremassoc (key, alist)); |
428 | 2028 } |
2029 | |
2030 DEFUN ("remassq", Fremassq, 2, 2, 0, /* | |
444 | 2031 Delete by side effect any elements of ALIST whose car is `eq' to KEY. |
2032 The modified ALIST is returned. If the first member of ALIST has a car | |
428 | 2033 that is `eq' to KEY, there is no way to remove it by side effect; |
2034 therefore, write `(setq foo (remassq key foo))' to be sure of changing | |
2035 the value of `foo'. | |
2036 */ | |
444 | 2037 (key, alist)) |
428 | 2038 { |
444 | 2039 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist, |
428 | 2040 (CONSP (elt) && |
2041 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); | |
444 | 2042 return alist; |
428 | 2043 } |
2044 | |
2045 /* no quit, no errors; be careful */ | |
2046 | |
2047 Lisp_Object | |
444 | 2048 remassq_no_quit (Lisp_Object key, Lisp_Object alist) |
428 | 2049 { |
444 | 2050 LIST_LOOP_DELETE_IF (elt, alist, |
428 | 2051 (CONSP (elt) && |
2052 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); | |
444 | 2053 return alist; |
428 | 2054 } |
2055 | |
2056 DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /* | |
444 | 2057 Delete by side effect any elements of ALIST whose cdr is `equal' to VALUE. |
2058 The modified ALIST is returned. If the first member of ALIST has a car | |
428 | 2059 that is `equal' to VALUE, there is no way to remove it by side effect; |
2060 therefore, write `(setq foo (remrassoc value foo))' to be sure of changing | |
2061 the value of `foo'. | |
2062 */ | |
444 | 2063 (value, alist)) |
428 | 2064 { |
444 | 2065 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist, |
428 | 2066 (CONSP (elt) && |
2067 internal_equal (value, XCDR (elt), 0))); | |
444 | 2068 return alist; |
428 | 2069 } |
2070 | |
2071 DEFUN ("remrassq", Fremrassq, 2, 2, 0, /* | |
444 | 2072 Delete by side effect any elements of ALIST whose cdr is `eq' to VALUE. |
2073 The modified ALIST is returned. If the first member of ALIST has a car | |
428 | 2074 that is `eq' to VALUE, there is no way to remove it by side effect; |
2075 therefore, write `(setq foo (remrassq value foo))' to be sure of changing | |
2076 the value of `foo'. | |
2077 */ | |
444 | 2078 (value, alist)) |
428 | 2079 { |
444 | 2080 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist, |
428 | 2081 (CONSP (elt) && |
2082 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); | |
444 | 2083 return alist; |
428 | 2084 } |
2085 | |
2086 /* Like Fremrassq, fast and unsafe; be careful */ | |
2087 Lisp_Object | |
444 | 2088 remrassq_no_quit (Lisp_Object value, Lisp_Object alist) |
428 | 2089 { |
444 | 2090 LIST_LOOP_DELETE_IF (elt, alist, |
428 | 2091 (CONSP (elt) && |
2092 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); | |
444 | 2093 return alist; |
428 | 2094 } |
2095 | |
2096 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* | |
5300
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2097 Reverse SEQUENCE, destructively. |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2098 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2099 Return the beginning of the reversed sequence, which will be a distinct Lisp |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2100 object if SEQUENCE is a list with length greater than one. See also |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2101 `reverse', the non-destructive version of this function. |
428 | 2102 */ |
5300
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2103 (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2104 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2105 CHECK_SEQUENCE (sequence); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2106 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2107 if (CONSP (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2108 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2109 struct gcpro gcpro1, gcpro2; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2110 Lisp_Object prev = Qnil; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2111 Lisp_Object tail = sequence; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2112 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2113 /* We gcpro our args; see `nconc' */ |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2114 GCPRO2 (prev, tail); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2115 while (!NILP (tail)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2116 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2117 REGISTER Lisp_Object next; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2118 CONCHECK_CONS (tail); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2119 next = XCDR (tail); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2120 XCDR (tail) = prev; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2121 prev = tail; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2122 tail = next; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2123 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2124 UNGCPRO; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2125 return prev; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2126 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2127 else if (VECTORP (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2128 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2129 Elemcount length = XVECTOR_LENGTH (sequence), ii = length; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2130 Elemcount half = length / 2; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2131 Lisp_Object swap = Qnil; |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
2132 CHECK_LISP_WRITEABLE (sequence); |
5300
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2133 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2134 while (ii > half) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2135 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2136 swap = XVECTOR_DATA (sequence) [length - ii]; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2137 XVECTOR_DATA (sequence) [length - ii] |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2138 = XVECTOR_DATA (sequence) [ii - 1]; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2139 XVECTOR_DATA (sequence) [ii - 1] = swap; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2140 --ii; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2141 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2142 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2143 else if (STRINGP (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2144 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2145 Elemcount length = XSTRING_LENGTH (sequence); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2146 Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2147 Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2148 |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
2149 CHECK_LISP_WRITEABLE (sequence); |
5300
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2150 while (cursor < endp) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2151 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2152 staging_end -= itext_ichar_len (cursor); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2153 itext_copy_ichar (cursor, staging_end); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2154 INC_IBYTEPTR (cursor); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2155 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2156 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2157 assert (staging == staging_end); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2158 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2159 memcpy (XSTRING_DATA (sequence), staging, length); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2160 init_string_ascii_begin (sequence); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2161 bump_string_modiff (sequence); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2162 sledgehammer_check_ascii_begin (sequence); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2163 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2164 else if (BIT_VECTORP (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2165 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2166 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2167 Elemcount length = bit_vector_length (bv), ii = length; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2168 Elemcount half = length / 2; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2169 int swap = 0; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2170 |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
2171 CHECK_LISP_WRITEABLE (sequence); |
5300
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2172 while (ii > half) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2173 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2174 swap = bit_vector_bit (bv, length - ii); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2175 set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1)); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2176 set_bit_vector_bit (bv, ii - 1, swap); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2177 --ii; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2178 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2179 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2180 else |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2181 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2182 assert (NILP (sequence)); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2183 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2184 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2185 return sequence; |
428 | 2186 } |
2187 | |
2188 DEFUN ("reverse", Freverse, 1, 1, 0, /* | |
5300
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2189 Reverse SEQUENCE, copying. Return the reversed sequence. |
428 | 2190 See also the function `nreverse', which is used more often. |
2191 */ | |
5300
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2192 (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2193 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2194 Lisp_Object result = Qnil; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2195 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2196 CHECK_SEQUENCE (sequence); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2197 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2198 if (CONSP (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2199 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2200 EXTERNAL_LIST_LOOP_2 (elt, sequence) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2201 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2202 result = Fcons (elt, result); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2203 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2204 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2205 else if (VECTORP (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2206 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2207 Elemcount length = XVECTOR_LENGTH (sequence), ii = length; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2208 Lisp_Object *staging = alloca_array (Lisp_Object, length); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2209 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2210 while (ii > 0) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2211 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2212 staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1]; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2213 --ii; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2214 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2215 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2216 result = Fvector (length, staging); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2217 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2218 else if (STRINGP (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2219 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2220 Elemcount length = XSTRING_LENGTH (sequence); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2221 Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2222 Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2223 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2224 while (cursor < endp) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2225 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2226 staging_end -= itext_ichar_len (cursor); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2227 itext_copy_ichar (cursor, staging_end); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2228 INC_IBYTEPTR (cursor); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2229 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2230 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2231 assert (staging == staging_end); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2232 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2233 result = make_string (staging, length); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2234 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2235 else if (BIT_VECTORP (sequence)) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2236 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2237 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence), *res; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2238 Elemcount length = bit_vector_length (bv), ii = length; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2239 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2240 result = make_bit_vector (length, Qzero); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2241 res = XBIT_VECTOR (result); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2242 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2243 while (ii > 0) |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2244 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2245 set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1)); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2246 --ii; |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2247 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2248 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2249 else |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2250 { |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2251 assert (NILP (sequence)); |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2252 } |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2253 |
9f738305f80f
Accept sequences generally, not just lists, #'reverse, #'nreverse.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5299
diff
changeset
|
2254 return result; |
428 | 2255 } |
2256 | |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2257 static Lisp_Object |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2258 c_merge_predicate_key (Lisp_Object obj1, Lisp_Object obj2, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2259 Lisp_Object pred, Lisp_Object key_func) |
428 | 2260 { |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2261 struct gcpro gcpro1; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2262 Lisp_Object args[3]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2263 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2264 /* We could use call2() and call3() here, but we're called O(nlogn) times |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2265 for a sequence of length n, it make some sense to inline them. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2266 args[0] = key_func; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2267 args[1] = obj1; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2268 args[2] = Qnil; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2269 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2270 GCPRO1 (args[0]); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2271 gcpro1.nvars = countof (args); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2272 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2273 obj1 = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2274 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2275 args[1] = obj2; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2276 obj2 = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args)); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2277 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2278 args[0] = pred; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2279 args[1] = obj1; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2280 args[2] = obj2; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2281 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2282 RETURN_UNGCPRO (IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args))); |
428 | 2283 } |
2284 | |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2285 static Lisp_Object |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2286 c_merge_predicate_nokey (Lisp_Object obj1, Lisp_Object obj2, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2287 Lisp_Object pred, Lisp_Object UNUSED (key_func)) |
428 | 2288 { |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2289 struct gcpro gcpro1; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2290 Lisp_Object args[3]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2291 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2292 /* This is (almost) the implementation of call2, it makes some sense to |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2293 inline it here. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2294 args[0] = pred; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2295 args[1] = obj1; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2296 args[2] = obj2; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2297 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2298 GCPRO1 (args[0]); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2299 gcpro1.nvars = countof (args); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2300 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2301 RETURN_UNGCPRO (IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args))); |
428 | 2302 } |
2303 | |
2304 Lisp_Object | |
2305 list_merge (Lisp_Object org_l1, Lisp_Object org_l2, | |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2306 Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2307 Lisp_Object, Lisp_Object), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2308 Lisp_Object predicate, Lisp_Object key_func) |
428 | 2309 { |
2310 Lisp_Object value; | |
2311 Lisp_Object tail; | |
2312 Lisp_Object tem; | |
2313 Lisp_Object l1, l2; | |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2314 Lisp_Object tortoises[2]; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2315 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
5283
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2316 int l1_count = 0, l2_count = 0; |
428 | 2317 |
2318 l1 = org_l1; | |
2319 l2 = org_l2; | |
2320 tail = Qnil; | |
2321 value = Qnil; | |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2322 tortoises[0] = org_l1; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2323 tortoises[1] = org_l2; |
428 | 2324 |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2325 if (NULL == c_predicate) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2326 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2327 c_predicate = EQ (key_func, Qidentity) ? |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2328 c_merge_predicate_nokey : c_merge_predicate_key; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2329 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2330 |
428 | 2331 /* It is sufficient to protect org_l1 and org_l2. |
2332 When l1 and l2 are updated, we copy the new values | |
2333 back into the org_ vars. */ | |
2334 | |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2335 GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2336 gcpro5.nvars = 2; |
428 | 2337 |
2338 while (1) | |
2339 { | |
2340 if (NILP (l1)) | |
2341 { | |
2342 UNGCPRO; | |
2343 if (NILP (tail)) | |
2344 return l2; | |
2345 Fsetcdr (tail, l2); | |
2346 return value; | |
2347 } | |
2348 if (NILP (l2)) | |
2349 { | |
2350 UNGCPRO; | |
2351 if (NILP (tail)) | |
2352 return l1; | |
2353 Fsetcdr (tail, l1); | |
2354 return value; | |
2355 } | |
2356 | |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2357 if (NILP (c_predicate (Fcar (l2), Fcar (l1), predicate, key_func))) |
428 | 2358 { |
2359 tem = l1; | |
2360 l1 = Fcdr (l1); | |
2361 org_l1 = l1; | |
5283
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2362 |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2363 if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH) |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2364 { |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2365 if (l1_count & 1) |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2366 { |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2367 if (!CONSP (tortoises[0])) |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2368 { |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2369 mapping_interaction_error (Qmerge, tortoises[0]); |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2370 } |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2371 |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2372 tortoises[0] = XCDR (tortoises[0]); |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2373 } |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2374 |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2375 if (EQ (org_l1, tortoises[0])) |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2376 { |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2377 signal_circular_list_error (org_l1); |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2378 } |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2379 } |
428 | 2380 } |
2381 else | |
2382 { | |
2383 tem = l2; | |
2384 l2 = Fcdr (l2); | |
2385 org_l2 = l2; | |
5283
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2386 |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2387 if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH) |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2388 { |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2389 if (l2_count & 1) |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2390 { |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2391 if (!CONSP (tortoises[1])) |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2392 { |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2393 mapping_interaction_error (Qmerge, tortoises[1]); |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2394 } |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2395 |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2396 tortoises[1] = XCDR (tortoises[1]); |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2397 } |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2398 |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2399 if (EQ (org_l2, tortoises[1])) |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2400 { |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2401 signal_circular_list_error (org_l2); |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2402 } |
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2403 } |
428 | 2404 } |
5283
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2405 |
428 | 2406 if (NILP (tail)) |
2407 value = tem; | |
2408 else | |
2409 Fsetcdr (tail, tem); | |
5283
be436ac36ba4
Don't share a counter when checking for circularity, list_merge().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2410 |
428 | 2411 tail = tem; |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2412 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2413 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2414 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2415 static void |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2416 array_merge (Lisp_Object *dest, Elemcount dest_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2417 Lisp_Object *front, Elemcount front_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2418 Lisp_Object *back, Elemcount back_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2419 Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2420 Lisp_Object, Lisp_Object), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2421 Lisp_Object predicate, Lisp_Object key_func) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2422 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2423 Elemcount ii, fronting, backing; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2424 Lisp_Object *front_staging = front; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2425 Lisp_Object *back_staging = back; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2426 struct gcpro gcpro1, gcpro2; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2427 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2428 assert (dest_len == (back_len + front_len)); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2429 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2430 if (0 == dest_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2431 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2432 return; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2433 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2434 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2435 if (front >= dest && front < (dest + dest_len)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2436 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2437 front_staging = alloca_array (Lisp_Object, front_len); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2438 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2439 for (ii = 0; ii < front_len; ++ii) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2440 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2441 front_staging[ii] = front[ii]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2442 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2443 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2444 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2445 if (back >= dest && back < (dest + dest_len)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2446 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2447 back_staging = alloca_array (Lisp_Object, back_len); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2448 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2449 for (ii = 0; ii < back_len; ++ii) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2450 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2451 back_staging[ii] = back[ii]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2452 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2453 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2454 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2455 GCPRO2 (front_staging[0], back_staging[0]); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2456 gcpro1.nvars = front_len; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2457 gcpro2.nvars = back_len; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2458 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2459 for (ii = fronting = backing = 0; ii < dest_len; ++ii) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2460 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2461 if (fronting >= front_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2462 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2463 while (ii < dest_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2464 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2465 dest[ii] = back_staging[backing]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2466 ++ii, ++backing; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2467 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2468 UNGCPRO; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2469 return; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2470 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2471 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2472 if (backing >= back_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2473 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2474 while (ii < dest_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2475 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2476 dest[ii] = front_staging[fronting]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2477 ++ii, ++fronting; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2478 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2479 UNGCPRO; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2480 return; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2481 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2482 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2483 if (NILP (c_predicate (back_staging[backing], front_staging[fronting], |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2484 predicate, key_func))) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2485 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2486 dest[ii] = front_staging[fronting]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2487 ++fronting; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2488 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2489 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2490 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2491 dest[ii] = back_staging[backing]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2492 ++backing; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2493 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2494 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2495 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2496 UNGCPRO; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2497 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2498 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2499 static Lisp_Object |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2500 list_array_merge_into_list (Lisp_Object list, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2501 Lisp_Object *array, Elemcount array_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2502 Lisp_Object (*c_predicate) (Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2503 Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2504 Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2505 Lisp_Object), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2506 Lisp_Object predicate, Lisp_Object key_func, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2507 Boolint reverse_order) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2508 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2509 Lisp_Object tail = Qnil, value = Qnil, tortoise = list; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2510 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2511 Elemcount array_index = 0; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2512 int looped = 0; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2513 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2514 GCPRO4 (list, tail, value, tortoise); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2515 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2516 while (1) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2517 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2518 if (NILP (list)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2519 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2520 UNGCPRO; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2521 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2522 if (NILP (tail)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2523 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2524 return Flist (array_len, array); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2525 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2526 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2527 Fsetcdr (tail, Flist (array_len - array_index, array + array_index)); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2528 return value; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2529 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2530 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2531 if (array_index >= array_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2532 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2533 UNGCPRO; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2534 if (NILP (tail)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2535 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2536 return list; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2537 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2538 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2539 Fsetcdr (tail, list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2540 return value; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2541 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2542 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2543 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2544 if (reverse_order ? |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2545 !NILP (c_predicate (Fcar (list), array [array_index], predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2546 key_func)) : |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2547 NILP (c_predicate (array [array_index], Fcar (list), predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2548 key_func))) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2549 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2550 if (NILP (tail)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2551 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2552 value = tail = list; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2553 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2554 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2555 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2556 Fsetcdr (tail, list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2557 tail = XCDR (tail); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2558 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2559 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2560 list = Fcdr (list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2561 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2562 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2563 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2564 if (NILP (tail)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2565 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2566 value = tail = Fcons (array [array_index], Qnil); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2567 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2568 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2569 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2570 Fsetcdr (tail, Fcons (array [array_index], tail)); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2571 tail = XCDR (tail); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2572 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2573 ++array_index; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2574 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2575 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2576 if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2577 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2578 if (looped & 1) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2579 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2580 tortoise = XCDR (tortoise); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2581 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2582 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2583 if (EQ (list, tortoise)) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2584 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2585 signal_circular_list_error (list); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2586 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2587 } |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2588 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2589 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2590 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2591 static void |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2592 list_list_merge_into_array (Lisp_Object *output, Elemcount output_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2593 Lisp_Object list_one, Lisp_Object list_two, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2594 Lisp_Object (*c_predicate) (Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2595 Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2596 Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2597 Lisp_Object), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2598 Lisp_Object predicate, Lisp_Object key_func) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2599 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2600 Elemcount output_index = 0; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2601 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2602 while (output_index < output_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2603 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2604 if (NILP (list_one)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2605 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2606 while (output_index < output_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2607 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2608 output [output_index] = Fcar (list_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2609 list_two = Fcdr (list_two), ++output_index; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2610 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2611 return; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2612 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2613 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2614 if (NILP (list_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2615 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2616 while (output_index < output_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2617 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2618 output [output_index] = Fcar (list_one); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2619 list_one = Fcdr (list_one), ++output_index; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2620 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2621 return; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2622 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2623 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2624 if (NILP (c_predicate (Fcar (list_two), Fcar (list_one), predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2625 key_func))) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2626 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2627 output [output_index] = XCAR (list_one); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2628 list_one = XCDR (list_one); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2629 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2630 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2631 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2632 output [output_index] = XCAR (list_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2633 list_two = XCDR (list_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2634 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2635 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2636 ++output_index; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2637 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2638 /* No need to check for circularity. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2639 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2640 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2641 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2642 static void |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2643 list_array_merge_into_array (Lisp_Object *output, Elemcount output_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2644 Lisp_Object list, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2645 Lisp_Object *array, Elemcount array_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2646 Lisp_Object (*c_predicate) (Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2647 Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2648 Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2649 Lisp_Object), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2650 Lisp_Object predicate, Lisp_Object key_func, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2651 Boolint reverse_order) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2652 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2653 Elemcount output_index = 0, array_index = 0; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2654 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2655 while (output_index < output_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2656 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2657 if (NILP (list)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2658 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2659 if (array_len - array_index != output_len - output_index) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2660 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
2661 mapping_interaction_error (Qmerge, list); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2662 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2663 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2664 while (array_index < array_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2665 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2666 output [output_index++] = array [array_index++]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2667 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2668 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2669 return; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2670 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2671 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2672 if (array_index >= array_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2673 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2674 while (output_index < output_len) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2675 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2676 output [output_index++] = Fcar (list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2677 list = Fcdr (list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2678 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2679 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2680 return; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2681 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2682 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2683 if (reverse_order ? |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2684 !NILP (c_predicate (Fcar (list), array [array_index], predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2685 key_func)) : |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2686 NILP (c_predicate (array [array_index], Fcar (list), predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2687 key_func))) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2688 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2689 output [output_index] = XCAR (list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2690 list = XCDR (list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2691 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2692 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2693 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2694 output [output_index] = array [array_index]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2695 ++array_index; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2696 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2697 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2698 ++output_index; |
428 | 2699 } |
2700 } | |
2701 | |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2702 #define STRING_DATA_TO_OBJECT_ARRAY(strdata, c_array, counter, len) \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2703 do { \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2704 c_array = alloca_array (Lisp_Object, len); \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2705 for (counter = 0; counter < len; ++counter) \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2706 { \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2707 c_array[counter] = make_char (itext_ichar (strdata)); \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2708 INC_IBYTEPTR (strdata); \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2709 } \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2710 } while (0) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2711 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2712 #define BIT_VECTOR_TO_OBJECT_ARRAY(v, c_array, counter, len) do { \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2713 c_array = alloca_array (Lisp_Object, len); \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2714 for (counter = 0; counter < len; ++counter) \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2715 { \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2716 c_array[counter] = make_int (bit_vector_bit (v, counter)); \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2717 } \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2718 } while (0) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2719 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2720 /* This macro might eventually find a better home than here. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2721 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2722 #define CHECK_KEY_ARGUMENT(key) \ |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2723 do { \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2724 if (NILP (key)) \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2725 { \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2726 key = Qidentity; \ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2727 } \ |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2728 \ |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2729 if (!EQ (key, Qidentity)) \ |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2730 { \ |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2731 key = indirect_function (key, 1); \ |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2732 } \ |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2733 } while (0) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2734 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2735 DEFUN ("merge", Fmerge, 4, MANY, 0, /* |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2736 Destructively merge SEQUENCE-ONE and SEQUENCE-TWO, producing a new sequence. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2737 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2738 TYPE is the type of sequence to return. PREDICATE is a `less-than' |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2739 predicate on the elements. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2740 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2741 Optional keyword argument KEY is a function used to extract an object to be |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2742 used for comparison from each element of SEQUENCE-ONE and SEQUENCE-TWO. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2743 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2744 arguments: (TYPE SEQUENCE-ONE SEQUENCE-TWO PREDICATE &key (KEY #'IDENTITY)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2745 */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2746 (int nargs, Lisp_Object *args)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2747 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2748 Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2], |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2749 predicate = args[3], result = Qnil; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2750 Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2751 Lisp_Object); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2752 |
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5275
diff
changeset
|
2753 PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2754 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2755 CHECK_SEQUENCE (sequence_one); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2756 CHECK_SEQUENCE (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2757 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2758 CHECK_KEY_ARGUMENT (key); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2759 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2760 c_predicate = EQ (key, Qidentity) ? |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
2761 c_merge_predicate_nokey : c_merge_predicate_key; |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2762 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2763 if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two))) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2764 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2765 if (NILP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2766 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2767 result = Fappend (2, args + 1); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2768 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2769 else if (NILP (sequence_one)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2770 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2771 args[3] = Qnil; /* Overwriting PREDICATE, and losing its GC |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2772 protection, but that doesn't matter. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2773 result = Fappend (2, args + 2); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2774 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2775 else if (CONSP (sequence_one) && CONSP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2776 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2777 result = list_merge (sequence_one, sequence_two, c_predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2778 predicate, key); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2779 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2780 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2781 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2782 Lisp_Object *array_storage, swap; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2783 Elemcount array_length, i; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2784 Boolint reverse_order = 0; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2785 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2786 if (!CONSP (sequence_one)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2787 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2788 /* Make sequence_one the cons, sequence_two the array: */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2789 swap = sequence_one; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2790 sequence_one = sequence_two; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2791 sequence_two = swap; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2792 reverse_order = 1; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2793 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2794 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2795 if (VECTORP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2796 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2797 array_storage = XVECTOR_DATA (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2798 array_length = XVECTOR_LENGTH (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2799 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2800 else if (STRINGP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2801 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2802 Ibyte *strdata = XSTRING_DATA (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2803 array_length = string_char_length (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2804 /* No need to GCPRO, characters are immediate. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2805 STRING_DATA_TO_OBJECT_ARRAY (strdata, array_storage, i, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2806 array_length); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2807 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2808 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2809 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2810 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2811 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2812 array_length = bit_vector_length (v); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2813 /* No need to GCPRO, fixnums are immediate. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2814 BIT_VECTOR_TO_OBJECT_ARRAY (v, array_storage, i, array_length); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2815 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2816 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2817 result = list_array_merge_into_list (sequence_one, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2818 array_storage, array_length, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2819 c_predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2820 predicate, key, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2821 reverse_order); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2822 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2823 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2824 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2825 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2826 Elemcount sequence_one_len = XINT (Flength (sequence_one)), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2827 sequence_two_len = XINT (Flength (sequence_two)), i; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2828 Elemcount output_len = 1 + sequence_one_len + sequence_two_len; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2829 Lisp_Object *output = alloca_array (Lisp_Object, output_len), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2830 *sequence_one_storage = NULL, *sequence_two_storage = NULL; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2831 Boolint do_coerce = !(EQ (type, Qvector) || EQ (type, Qstring) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2832 || EQ (type, Qbit_vector) || EQ (type, Qlist)); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2833 Ibyte *strdata = NULL; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2834 Lisp_Bit_Vector *v = NULL; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2835 struct gcpro gcpro1; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2836 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2837 output[0] = do_coerce ? Qlist : type; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2838 for (i = 1; i < output_len; ++i) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2839 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2840 output[i] = Qnil; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2841 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2842 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2843 GCPRO1 (output[0]); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2844 gcpro1.nvars = output_len; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2845 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2846 if (VECTORP (sequence_one)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2847 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2848 sequence_one_storage = XVECTOR_DATA (sequence_one); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2849 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2850 else if (STRINGP (sequence_one)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2851 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2852 strdata = XSTRING_DATA (sequence_one); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2853 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_one_storage, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2854 i, sequence_one_len); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2855 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2856 else if (BIT_VECTORP (sequence_one)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2857 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2858 v = XBIT_VECTOR (sequence_one); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2859 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_one_storage, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2860 i, sequence_one_len); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2861 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2862 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2863 if (VECTORP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2864 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2865 sequence_two_storage = XVECTOR_DATA (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2866 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2867 else if (STRINGP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2868 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2869 strdata = XSTRING_DATA (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2870 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_two_storage, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2871 i, sequence_two_len); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2872 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2873 else if (BIT_VECTORP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2874 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2875 v = XBIT_VECTOR (sequence_two); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2876 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_two_storage, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2877 i, sequence_two_len); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2878 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2879 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2880 if (LISTP (sequence_one) && LISTP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2881 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2882 list_list_merge_into_array (output + 1, output_len - 1, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2883 sequence_one, sequence_two, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2884 c_predicate, predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2885 key); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2886 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2887 else if (LISTP (sequence_one)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2888 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2889 list_array_merge_into_array (output + 1, output_len - 1, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2890 sequence_one, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2891 sequence_two_storage, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2892 sequence_two_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2893 c_predicate, predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2894 key, 0); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2895 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2896 else if (LISTP (sequence_two)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2897 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2898 list_array_merge_into_array (output + 1, output_len - 1, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2899 sequence_two, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2900 sequence_one_storage, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2901 sequence_one_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2902 c_predicate, predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2903 key, 1); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2904 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2905 else |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2906 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2907 array_merge (output + 1, output_len - 1, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2908 sequence_one_storage, sequence_one_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2909 sequence_two_storage, sequence_two_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2910 c_predicate, predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2911 key); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2912 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2913 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2914 result = Ffuncall (output_len, output); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2915 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2916 if (do_coerce) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2917 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2918 result = call2 (Qcoerce, result, type); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2919 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2920 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2921 UNGCPRO; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2922 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2923 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2924 return result; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2925 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2926 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2927 /* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2928 NOTE: This is backwards from the way qsort() works. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2929 Lisp_Object |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2930 list_sort (Lisp_Object list, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2931 Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2932 Lisp_Object, Lisp_Object), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2933 Lisp_Object predicate, Lisp_Object key_func) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2934 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2935 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2936 Lisp_Object back, tem; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2937 Lisp_Object front = list; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2938 Lisp_Object len = Flength (list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2939 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2940 if (XINT (len) < 2) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2941 return list; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2942 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2943 if (NULL == c_predicate) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2944 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2945 c_predicate = EQ (key_func, Qidentity) ? c_merge_predicate_nokey : |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2946 c_merge_predicate_key; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2947 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2948 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2949 len = make_int (XINT (len) / 2 - 1); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2950 tem = Fnthcdr (len, list); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2951 back = Fcdr (tem); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2952 Fsetcdr (tem, Qnil); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2953 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2954 GCPRO4 (front, back, predicate, key_func); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2955 front = list_sort (front, c_predicate, predicate, key_func); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2956 back = list_sort (back, c_predicate, predicate, key_func); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2957 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2958 RETURN_UNGCPRO (list_merge (front, back, c_predicate, predicate, key_func)); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2959 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2960 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2961 static void |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2962 array_sort (Lisp_Object *array, Elemcount array_len, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2963 Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2964 Lisp_Object, Lisp_Object), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2965 Lisp_Object predicate, Lisp_Object key_func) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2966 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2967 Elemcount split; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2968 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2969 if (array_len < 2) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2970 return; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2971 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2972 split = array_len / 2; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2973 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2974 array_sort (array, split, c_predicate, predicate, key_func); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2975 array_sort (array + split, array_len - split, c_predicate, predicate, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2976 key_func); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2977 array_merge (array, array_len, array, split, array + split, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2978 array_len - split, c_predicate, predicate, key_func); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2979 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2980 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2981 DEFUN ("sort*", FsortX, 2, MANY, 0, /* |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2982 Sort SEQUENCE, comparing elements using PREDICATE. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2983 Returns the sorted sequence. SEQUENCE is modified by side effect. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2984 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2985 PREDICATE is called with two elements of SEQUENCE, and should return t if |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2986 the first element is `less' than the second. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2987 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2988 Optional keyword argument KEY is a function used to extract an object to be |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2989 used for comparison from each element of SEQUENCE. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2990 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2991 In this implementation, sorting is always stable; but call `stable-sort' if |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2992 this stability is important to you, other implementations may not make the |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2993 same guarantees. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2994 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2995 arguments: (SEQUENCE PREDICATE &key (KEY #'IDENTITY)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2996 */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2997 (int nargs, Lisp_Object *args)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2998 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
2999 Lisp_Object sequence = args[0], predicate = args[1]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3000 Lisp_Object *sequence_carray; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3001 Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object, |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3002 Lisp_Object); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3003 Elemcount sequence_len, i; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3004 |
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5275
diff
changeset
|
3005 PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3006 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3007 CHECK_SEQUENCE (sequence); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3008 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
3009 CHECK_KEY_ARGUMENT (key); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
3010 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
3011 c_predicate = EQ (key, Qidentity) ? |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
3012 c_merge_predicate_nokey : c_merge_predicate_key; |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3013 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3014 if (LISTP (sequence)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3015 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3016 sequence = list_sort (sequence, c_predicate, predicate, key); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3017 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3018 else if (VECTORP (sequence)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3019 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3020 array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence), |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3021 c_predicate, predicate, key); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3022 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3023 else if (STRINGP (sequence)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3024 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3025 Ibyte *strdata = XSTRING_DATA (sequence); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3026 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3027 sequence_len = string_char_length (sequence); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3028 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3029 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3030 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3031 /* No GCPRO necessary, characters are immediate. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3032 array_sort (sequence_carray, sequence_len, c_predicate, predicate, key); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3033 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3034 strdata = XSTRING_DATA (sequence); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3035 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3036 CHECK_LISP_WRITEABLE (sequence); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3037 for (i = 0; i < sequence_len; ++i) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3038 { |
5184
039d9a7f2e6d
Call init_string_ascii_begin() in #'sort*, #'fill, don't be clever.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5182
diff
changeset
|
3039 strdata += set_itext_ichar (strdata, XCHAR (sequence_carray[i])); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3040 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3041 |
5184
039d9a7f2e6d
Call init_string_ascii_begin() in #'sort*, #'fill, don't be clever.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5182
diff
changeset
|
3042 init_string_ascii_begin (sequence); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3043 bump_string_modiff (sequence); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3044 sledgehammer_check_ascii_begin (sequence); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3045 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3046 else if (BIT_VECTORP (sequence)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3047 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3048 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3049 sequence_len = bit_vector_length (v); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3050 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3051 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3052 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3053 /* No GCPRO necessary, bits are immediate. */ |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3054 array_sort (sequence_carray, sequence_len, c_predicate, predicate, key); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3055 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3056 for (i = 0; i < sequence_len; ++i) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3057 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3058 set_bit_vector_bit (v, i, XINT (sequence_carray [i])); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3059 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3060 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3061 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3062 return sequence; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
3063 } |
428 | 3064 |
3065 /************************************************************************/ | |
3066 /* property-list functions */ | |
3067 /************************************************************************/ | |
3068 | |
3069 /* For properties of text, we need to do order-insensitive comparison of | |
3070 plists. That is, we need to compare two plists such that they are the | |
3071 same if they have the same set of keys, and equivalent values. | |
3072 So (a 1 b 2) would be equal to (b 2 a 1). | |
3073 | |
3074 NIL_MEANS_NOT_PRESENT is as in `plists-eq' etc. | |
3075 LAXP means use `equal' for comparisons. | |
3076 */ | |
3077 int | |
3078 plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present, | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3079 int laxp, int depth, int foldcase) |
428 | 3080 { |
438 | 3081 int eqp = (depth == -1); /* -1 as depth means use eq, not equal. */ |
428 | 3082 int la, lb, m, i, fill; |
3083 Lisp_Object *keys, *vals; | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
3084 Boolbyte *flags; |
428 | 3085 Lisp_Object rest; |
3086 | |
3087 if (NILP (a) && NILP (b)) | |
3088 return 0; | |
3089 | |
3090 Fcheck_valid_plist (a); | |
3091 Fcheck_valid_plist (b); | |
3092 | |
3093 la = XINT (Flength (a)); | |
3094 lb = XINT (Flength (b)); | |
3095 m = (la > lb ? la : lb); | |
3096 fill = 0; | |
3097 keys = alloca_array (Lisp_Object, m); | |
3098 vals = alloca_array (Lisp_Object, m); | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
3099 flags = alloca_array (Boolbyte, m); |
428 | 3100 |
3101 /* First extract the pairs from A. */ | |
3102 for (rest = a; !NILP (rest); rest = XCDR (XCDR (rest))) | |
3103 { | |
3104 Lisp_Object k = XCAR (rest); | |
3105 Lisp_Object v = XCAR (XCDR (rest)); | |
3106 /* Maybe be Ebolified. */ | |
3107 if (nil_means_not_present && NILP (v)) continue; | |
3108 keys [fill] = k; | |
3109 vals [fill] = v; | |
3110 flags[fill] = 0; | |
3111 fill++; | |
3112 } | |
3113 /* Now iterate over B, and stop if we find something that's not in A, | |
3114 or that doesn't match. As we match, mark them. */ | |
3115 for (rest = b; !NILP (rest); rest = XCDR (XCDR (rest))) | |
3116 { | |
3117 Lisp_Object k = XCAR (rest); | |
3118 Lisp_Object v = XCAR (XCDR (rest)); | |
3119 /* Maybe be Ebolified. */ | |
3120 if (nil_means_not_present && NILP (v)) continue; | |
3121 for (i = 0; i < fill; i++) | |
3122 { | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3123 if (!laxp ? EQ (k, keys [i]) : |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3124 internal_equal_0 (k, keys [i], depth, foldcase)) |
428 | 3125 { |
434 | 3126 if (eqp |
3127 /* We narrowly escaped being Ebolified here. */ | |
3128 ? !EQ_WITH_EBOLA_NOTICE (v, vals [i]) | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3129 : !internal_equal_0 (v, vals [i], depth, foldcase)) |
428 | 3130 /* a property in B has a different value than in A */ |
3131 goto MISMATCH; | |
3132 flags [i] = 1; | |
3133 break; | |
3134 } | |
3135 } | |
3136 if (i == fill) | |
3137 /* there are some properties in B that are not in A */ | |
3138 goto MISMATCH; | |
3139 } | |
3140 /* Now check to see that all the properties in A were also in B */ | |
3141 for (i = 0; i < fill; i++) | |
3142 if (flags [i] == 0) | |
3143 goto MISMATCH; | |
3144 | |
3145 /* Ok. */ | |
3146 return 0; | |
3147 | |
3148 MISMATCH: | |
3149 return 1; | |
3150 } | |
3151 | |
3152 DEFUN ("plists-eq", Fplists_eq, 2, 3, 0, /* | |
3153 Return non-nil if property lists A and B are `eq'. | |
3154 A property list is an alternating list of keywords and values. | |
3155 This function does order-insensitive comparisons of the property lists: | |
3156 For example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal. | |
3157 Comparison between values is done using `eq'. See also `plists-equal'. | |
3158 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with | |
3159 a nil value is ignored. This feature is a virus that has infected | |
3160 old Lisp implementations, but should not be used except for backward | |
3161 compatibility. | |
3162 */ | |
3163 (a, b, nil_means_not_present)) | |
3164 { | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3165 return (plists_differ (a, b, !NILP (nil_means_not_present), 0, -1, 0) |
428 | 3166 ? Qnil : Qt); |
3167 } | |
3168 | |
3169 DEFUN ("plists-equal", Fplists_equal, 2, 3, 0, /* | |
3170 Return non-nil if property lists A and B are `equal'. | |
3171 A property list is an alternating list of keywords and values. This | |
3172 function does order-insensitive comparisons of the property lists: For | |
3173 example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal. | |
3174 Comparison between values is done using `equal'. See also `plists-eq'. | |
3175 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with | |
3176 a nil value is ignored. This feature is a virus that has infected | |
3177 old Lisp implementations, but should not be used except for backward | |
3178 compatibility. | |
3179 */ | |
3180 (a, b, nil_means_not_present)) | |
3181 { | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3182 return (plists_differ (a, b, !NILP (nil_means_not_present), 0, 1, 0) |
428 | 3183 ? Qnil : Qt); |
3184 } | |
3185 | |
3186 | |
3187 DEFUN ("lax-plists-eq", Flax_plists_eq, 2, 3, 0, /* | |
3188 Return non-nil if lax property lists A and B are `eq'. | |
3189 A property list is an alternating list of keywords and values. | |
3190 This function does order-insensitive comparisons of the property lists: | |
3191 For example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal. | |
3192 Comparison between values is done using `eq'. See also `plists-equal'. | |
3193 A lax property list is like a regular one except that comparisons between | |
3194 keywords is done using `equal' instead of `eq'. | |
3195 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with | |
3196 a nil value is ignored. This feature is a virus that has infected | |
3197 old Lisp implementations, but should not be used except for backward | |
3198 compatibility. | |
3199 */ | |
3200 (a, b, nil_means_not_present)) | |
3201 { | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3202 return (plists_differ (a, b, !NILP (nil_means_not_present), 1, -1, 0) |
428 | 3203 ? Qnil : Qt); |
3204 } | |
3205 | |
3206 DEFUN ("lax-plists-equal", Flax_plists_equal, 2, 3, 0, /* | |
3207 Return non-nil if lax property lists A and B are `equal'. | |
3208 A property list is an alternating list of keywords and values. This | |
3209 function does order-insensitive comparisons of the property lists: For | |
3210 example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal. | |
3211 Comparison between values is done using `equal'. See also `plists-eq'. | |
3212 A lax property list is like a regular one except that comparisons between | |
3213 keywords is done using `equal' instead of `eq'. | |
3214 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with | |
3215 a nil value is ignored. This feature is a virus that has infected | |
3216 old Lisp implementations, but should not be used except for backward | |
3217 compatibility. | |
3218 */ | |
3219 (a, b, nil_means_not_present)) | |
3220 { | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3221 return (plists_differ (a, b, !NILP (nil_means_not_present), 1, 1, 0) |
428 | 3222 ? Qnil : Qt); |
3223 } | |
3224 | |
3225 /* Return the value associated with key PROPERTY in property list PLIST. | |
3226 Return nil if key not found. This function is used for internal | |
3227 property lists that cannot be directly manipulated by the user. | |
3228 */ | |
3229 | |
3230 Lisp_Object | |
3231 internal_plist_get (Lisp_Object plist, Lisp_Object property) | |
3232 { | |
3233 Lisp_Object tail; | |
3234 | |
3235 for (tail = plist; !NILP (tail); tail = XCDR (XCDR (tail))) | |
3236 { | |
3237 if (EQ (XCAR (tail), property)) | |
3238 return XCAR (XCDR (tail)); | |
3239 } | |
3240 | |
3241 return Qunbound; | |
3242 } | |
3243 | |
3244 /* Set PLIST's value for PROPERTY to VALUE. Analogous to | |
3245 internal_plist_get(). */ | |
3246 | |
3247 void | |
3248 internal_plist_put (Lisp_Object *plist, Lisp_Object property, | |
3249 Lisp_Object value) | |
3250 { | |
3251 Lisp_Object tail; | |
3252 | |
3253 for (tail = *plist; !NILP (tail); tail = XCDR (XCDR (tail))) | |
3254 { | |
3255 if (EQ (XCAR (tail), property)) | |
3256 { | |
3257 XCAR (XCDR (tail)) = value; | |
3258 return; | |
3259 } | |
3260 } | |
3261 | |
3262 *plist = Fcons (property, Fcons (value, *plist)); | |
3263 } | |
3264 | |
3265 int | |
3266 internal_remprop (Lisp_Object *plist, Lisp_Object property) | |
3267 { | |
3268 Lisp_Object tail, prev; | |
3269 | |
3270 for (tail = *plist, prev = Qnil; | |
3271 !NILP (tail); | |
3272 tail = XCDR (XCDR (tail))) | |
3273 { | |
3274 if (EQ (XCAR (tail), property)) | |
3275 { | |
3276 if (NILP (prev)) | |
3277 *plist = XCDR (XCDR (tail)); | |
3278 else | |
3279 XCDR (XCDR (prev)) = XCDR (XCDR (tail)); | |
3280 return 1; | |
3281 } | |
3282 else | |
3283 prev = tail; | |
3284 } | |
3285 | |
3286 return 0; | |
3287 } | |
3288 | |
3289 /* Called on a malformed property list. BADPLACE should be some | |
3290 place where truncating will form a good list -- i.e. we shouldn't | |
3291 result in a list with an odd length. */ | |
3292 | |
3293 static Lisp_Object | |
578 | 3294 bad_bad_bunny (Lisp_Object *plist, Lisp_Object *badplace, Error_Behavior errb) |
428 | 3295 { |
3296 if (ERRB_EQ (errb, ERROR_ME)) | |
3297 return Fsignal (Qmalformed_property_list, list2 (*plist, *badplace)); | |
3298 else | |
3299 { | |
3300 if (ERRB_EQ (errb, ERROR_ME_WARN)) | |
3301 { | |
3302 warn_when_safe_lispobj | |
3303 (Qlist, Qwarning, | |
771 | 3304 list2 (build_msg_string |
428 | 3305 ("Malformed property list -- list has been truncated"), |
3306 *plist)); | |
793 | 3307 /* #### WARNING: This is more dangerous than it seems; perhaps |
3308 not a good idea. It also violates the principle of least | |
3309 surprise -- passing in ERROR_ME_WARN causes truncation, but | |
3310 ERROR_ME and ERROR_ME_NOT don't. */ | |
428 | 3311 *badplace = Qnil; |
3312 } | |
3313 return Qunbound; | |
3314 } | |
3315 } | |
3316 | |
3317 /* Called on a circular property list. BADPLACE should be some place | |
3318 where truncating will result in an even-length list, as above. | |
3319 If doesn't particularly matter where we truncate -- anywhere we | |
3320 truncate along the entire list will break the circularity, because | |
3321 it will create a terminus and the list currently doesn't have one. | |
3322 */ | |
3323 | |
3324 static Lisp_Object | |
578 | 3325 bad_bad_turtle (Lisp_Object *plist, Lisp_Object *badplace, Error_Behavior errb) |
428 | 3326 { |
3327 if (ERRB_EQ (errb, ERROR_ME)) | |
3328 return Fsignal (Qcircular_property_list, list1 (*plist)); | |
3329 else | |
3330 { | |
3331 if (ERRB_EQ (errb, ERROR_ME_WARN)) | |
3332 { | |
3333 warn_when_safe_lispobj | |
3334 (Qlist, Qwarning, | |
771 | 3335 list2 (build_msg_string |
428 | 3336 ("Circular property list -- list has been truncated"), |
3337 *plist)); | |
793 | 3338 /* #### WARNING: This is more dangerous than it seems; perhaps |
3339 not a good idea. It also violates the principle of least | |
3340 surprise -- passing in ERROR_ME_WARN causes truncation, but | |
3341 ERROR_ME and ERROR_ME_NOT don't. */ | |
428 | 3342 *badplace = Qnil; |
3343 } | |
3344 return Qunbound; | |
3345 } | |
3346 } | |
3347 | |
3348 /* Advance the tortoise pointer by two (one iteration of a property-list | |
3349 loop) and the hare pointer by four and verify that no malformations | |
3350 or circularities exist. If so, return zero and store a value into | |
3351 RETVAL that should be returned by the calling function. Otherwise, | |
3352 return 1. See external_plist_get(). | |
3353 */ | |
3354 | |
3355 static int | |
3356 advance_plist_pointers (Lisp_Object *plist, | |
3357 Lisp_Object **tortoise, Lisp_Object **hare, | |
578 | 3358 Error_Behavior errb, Lisp_Object *retval) |
428 | 3359 { |
3360 int i; | |
3361 Lisp_Object *tortsave = *tortoise; | |
3362 | |
3363 /* Note that our "fixing" may be more brutal than necessary, | |
3364 but it's the user's own problem, not ours, if they went in and | |
3365 manually fucked up a plist. */ | |
3366 | |
3367 for (i = 0; i < 2; i++) | |
3368 { | |
3369 /* This is a standard iteration of a defensive-loop-checking | |
3370 loop. We just do it twice because we want to advance past | |
3371 both the property and its value. | |
3372 | |
3373 If the pointer indirection is confusing you, remember that | |
3374 one level of indirection on the hare and tortoise pointers | |
3375 is only due to pass-by-reference for this function. The other | |
3376 level is so that the plist can be fixed in place. */ | |
3377 | |
3378 /* When we reach the end of a well-formed plist, **HARE is | |
3379 nil. In that case, we don't do anything at all except | |
3380 advance TORTOISE by one. Otherwise, we advance HARE | |
3381 by two (making sure it's OK to do so), then advance | |
3382 TORTOISE by one (it will always be OK to do so because | |
3383 the HARE is always ahead of the TORTOISE and will have | |
3384 already verified the path), then make sure TORTOISE and | |
3385 HARE don't contain the same non-nil object -- if the | |
3386 TORTOISE and the HARE ever meet, then obviously we're | |
3387 in a circularity, and if we're in a circularity, then | |
3388 the TORTOISE and the HARE can't cross paths without | |
3389 meeting, since the HARE only gains one step over the | |
3390 TORTOISE per iteration. */ | |
3391 | |
3392 if (!NILP (**hare)) | |
3393 { | |
3394 Lisp_Object *haresave = *hare; | |
3395 if (!CONSP (**hare)) | |
3396 { | |
3397 *retval = bad_bad_bunny (plist, haresave, errb); | |
3398 return 0; | |
3399 } | |
3400 *hare = &XCDR (**hare); | |
3401 /* In a non-plist, we'd check here for a nil value for | |
3402 **HARE, which is OK (it just means the list has an | |
3403 odd number of elements). In a plist, it's not OK | |
3404 for the list to have an odd number of elements. */ | |
3405 if (!CONSP (**hare)) | |
3406 { | |
3407 *retval = bad_bad_bunny (plist, haresave, errb); | |
3408 return 0; | |
3409 } | |
3410 *hare = &XCDR (**hare); | |
3411 } | |
3412 | |
3413 *tortoise = &XCDR (**tortoise); | |
3414 if (!NILP (**hare) && EQ (**tortoise, **hare)) | |
3415 { | |
3416 *retval = bad_bad_turtle (plist, tortsave, errb); | |
3417 return 0; | |
3418 } | |
3419 } | |
3420 | |
3421 return 1; | |
3422 } | |
3423 | |
3424 /* Return the value of PROPERTY from PLIST, or Qunbound if | |
3425 property is not on the list. | |
3426 | |
3427 PLIST is a Lisp-accessible property list, meaning that it | |
3428 has to be checked for malformations and circularities. | |
3429 | |
3430 If ERRB is ERROR_ME, an error will be signalled. Otherwise, the | |
3431 function will never signal an error; and if ERRB is ERROR_ME_WARN, | |
3432 on finding a malformation or a circularity, it issues a warning and | |
3433 attempts to silently fix the problem. | |
3434 | |
3435 A pointer to PLIST is passed in so that PLIST can be successfully | |
3436 "fixed" even if the error is at the beginning of the plist. */ | |
3437 | |
3438 Lisp_Object | |
3439 external_plist_get (Lisp_Object *plist, Lisp_Object property, | |
578 | 3440 int laxp, Error_Behavior errb) |
428 | 3441 { |
3442 Lisp_Object *tortoise = plist; | |
3443 Lisp_Object *hare = plist; | |
3444 | |
3445 while (!NILP (*tortoise)) | |
3446 { | |
3447 Lisp_Object *tortsave = tortoise; | |
3448 Lisp_Object retval; | |
3449 | |
3450 /* We do the standard tortoise/hare march. We isolate the | |
3451 grungy stuff to do this in advance_plist_pointers(), though. | |
3452 To us, all this function does is advance the tortoise | |
3453 pointer by two and the hare pointer by four and make sure | |
3454 everything's OK. We first advance the pointers and then | |
3455 check if a property matched; this ensures that our | |
3456 check for a matching property is safe. */ | |
3457 | |
3458 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval)) | |
3459 return retval; | |
3460 | |
3461 if (!laxp ? EQ (XCAR (*tortsave), property) | |
3462 : internal_equal (XCAR (*tortsave), property, 0)) | |
3463 return XCAR (XCDR (*tortsave)); | |
3464 } | |
3465 | |
3466 return Qunbound; | |
3467 } | |
3468 | |
3469 /* Set PLIST's value for PROPERTY to VALUE, given a possibly | |
3470 malformed or circular plist. Analogous to external_plist_get(). */ | |
3471 | |
3472 void | |
3473 external_plist_put (Lisp_Object *plist, Lisp_Object property, | |
578 | 3474 Lisp_Object value, int laxp, Error_Behavior errb) |
428 | 3475 { |
3476 Lisp_Object *tortoise = plist; | |
3477 Lisp_Object *hare = plist; | |
3478 | |
3479 while (!NILP (*tortoise)) | |
3480 { | |
3481 Lisp_Object *tortsave = tortoise; | |
3482 Lisp_Object retval; | |
3483 | |
3484 /* See above */ | |
3485 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval)) | |
3486 return; | |
3487 | |
3488 if (!laxp ? EQ (XCAR (*tortsave), property) | |
3489 : internal_equal (XCAR (*tortsave), property, 0)) | |
3490 { | |
3491 XCAR (XCDR (*tortsave)) = value; | |
3492 return; | |
3493 } | |
3494 } | |
3495 | |
3496 *plist = Fcons (property, Fcons (value, *plist)); | |
3497 } | |
3498 | |
3499 int | |
3500 external_remprop (Lisp_Object *plist, Lisp_Object property, | |
578 | 3501 int laxp, Error_Behavior errb) |
428 | 3502 { |
3503 Lisp_Object *tortoise = plist; | |
3504 Lisp_Object *hare = plist; | |
3505 | |
3506 while (!NILP (*tortoise)) | |
3507 { | |
3508 Lisp_Object *tortsave = tortoise; | |
3509 Lisp_Object retval; | |
3510 | |
3511 /* See above */ | |
3512 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval)) | |
3513 return 0; | |
3514 | |
3515 if (!laxp ? EQ (XCAR (*tortsave), property) | |
3516 : internal_equal (XCAR (*tortsave), property, 0)) | |
3517 { | |
3518 /* Now you see why it's so convenient to have that level | |
3519 of indirection. */ | |
3520 *tortsave = XCDR (XCDR (*tortsave)); | |
3521 return 1; | |
3522 } | |
3523 } | |
3524 | |
3525 return 0; | |
3526 } | |
3527 | |
3528 DEFUN ("plist-get", Fplist_get, 2, 3, 0, /* | |
3529 Extract a value from a property list. | |
3530 PLIST is a property list, which is a list of the form | |
444 | 3531 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...). |
3532 PROPERTY is usually a symbol. | |
3533 This function returns the value corresponding to the PROPERTY, | |
3534 or DEFAULT if PROPERTY is not one of the properties on the list. | |
428 | 3535 */ |
444 | 3536 (plist, property, default_)) |
428 | 3537 { |
444 | 3538 Lisp_Object value = external_plist_get (&plist, property, 0, ERROR_ME); |
3539 return UNBOUNDP (value) ? default_ : value; | |
428 | 3540 } |
3541 | |
3542 DEFUN ("plist-put", Fplist_put, 3, 3, 0, /* | |
444 | 3543 Change value in PLIST of PROPERTY to VALUE. |
3544 PLIST is a property list, which is a list of the form | |
3545 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...). | |
3546 PROPERTY is usually a symbol and VALUE is any object. | |
3547 If PROPERTY is already a property on the list, its value is set to VALUE, | |
3548 otherwise the new PROPERTY VALUE pair is added. | |
3549 The new plist is returned; use `(setq x (plist-put x property value))' | |
3550 to be sure to use the new value. PLIST is modified by side effect. | |
428 | 3551 */ |
444 | 3552 (plist, property, value)) |
428 | 3553 { |
444 | 3554 external_plist_put (&plist, property, value, 0, ERROR_ME); |
428 | 3555 return plist; |
3556 } | |
3557 | |
3558 DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /* | |
444 | 3559 Remove from PLIST the property PROPERTY and its value. |
3560 PLIST is a property list, which is a list of the form | |
3561 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...). | |
3562 PROPERTY is usually a symbol. | |
3563 The new plist is returned; use `(setq x (plist-remprop x property))' | |
3564 to be sure to use the new value. PLIST is modified by side effect. | |
428 | 3565 */ |
444 | 3566 (plist, property)) |
428 | 3567 { |
444 | 3568 external_remprop (&plist, property, 0, ERROR_ME); |
428 | 3569 return plist; |
3570 } | |
3571 | |
3572 DEFUN ("plist-member", Fplist_member, 2, 2, 0, /* | |
444 | 3573 Return t if PROPERTY has a value specified in PLIST. |
428 | 3574 */ |
444 | 3575 (plist, property)) |
428 | 3576 { |
444 | 3577 Lisp_Object value = Fplist_get (plist, property, Qunbound); |
3578 return UNBOUNDP (value) ? Qnil : Qt; | |
428 | 3579 } |
3580 | |
3581 DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /* | |
3582 Given a plist, signal an error if there is anything wrong with it. | |
3583 This means that it's a malformed or circular plist. | |
3584 */ | |
3585 (plist)) | |
3586 { | |
3587 Lisp_Object *tortoise; | |
3588 Lisp_Object *hare; | |
3589 | |
3590 start_over: | |
3591 tortoise = &plist; | |
3592 hare = &plist; | |
3593 while (!NILP (*tortoise)) | |
3594 { | |
3595 Lisp_Object retval; | |
3596 | |
3597 /* See above */ | |
3598 if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME, | |
3599 &retval)) | |
3600 goto start_over; | |
3601 } | |
3602 | |
3603 return Qnil; | |
3604 } | |
3605 | |
3606 DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /* | |
3607 Given a plist, return non-nil if its format is correct. | |
3608 If it returns nil, `check-valid-plist' will signal an error when given | |
442 | 3609 the plist; that means it's a malformed or circular plist. |
428 | 3610 */ |
3611 (plist)) | |
3612 { | |
3613 Lisp_Object *tortoise; | |
3614 Lisp_Object *hare; | |
3615 | |
3616 tortoise = &plist; | |
3617 hare = &plist; | |
3618 while (!NILP (*tortoise)) | |
3619 { | |
3620 Lisp_Object retval; | |
3621 | |
3622 /* See above */ | |
3623 if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME_NOT, | |
3624 &retval)) | |
3625 return Qnil; | |
3626 } | |
3627 | |
3628 return Qt; | |
3629 } | |
3630 | |
3631 DEFUN ("canonicalize-plist", Fcanonicalize_plist, 1, 2, 0, /* | |
3632 Destructively remove any duplicate entries from a plist. | |
3633 In such cases, the first entry applies. | |
3634 | |
3635 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with | |
3636 a nil value is removed. This feature is a virus that has infected | |
3637 old Lisp implementations, but should not be used except for backward | |
3638 compatibility. | |
3639 | |
3640 The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the | |
3641 return value may not be EQ to the passed-in value, so make sure to | |
3642 `setq' the value back into where it came from. | |
3643 */ | |
3644 (plist, nil_means_not_present)) | |
3645 { | |
3646 Lisp_Object head = plist; | |
3647 | |
3648 Fcheck_valid_plist (plist); | |
3649 | |
3650 while (!NILP (plist)) | |
3651 { | |
3652 Lisp_Object prop = Fcar (plist); | |
3653 Lisp_Object next = Fcdr (plist); | |
3654 | |
3655 CHECK_CONS (next); /* just make doubly sure we catch any errors */ | |
3656 if (!NILP (nil_means_not_present) && NILP (Fcar (next))) | |
3657 { | |
3658 if (EQ (head, plist)) | |
3659 head = Fcdr (next); | |
3660 plist = Fcdr (next); | |
3661 continue; | |
3662 } | |
3663 /* external_remprop returns 1 if it removed any property. | |
3664 We have to loop till it didn't remove anything, in case | |
3665 the property occurs many times. */ | |
3666 while (external_remprop (&XCDR (next), prop, 0, ERROR_ME)) | |
3667 DO_NOTHING; | |
3668 plist = Fcdr (next); | |
3669 } | |
3670 | |
3671 return head; | |
3672 } | |
3673 | |
3674 DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /* | |
3675 Extract a value from a lax property list. | |
444 | 3676 LAX-PLIST is a lax property list, which is a list of the form |
3677 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between | |
3678 properties is done using `equal' instead of `eq'. | |
3679 PROPERTY is usually a symbol. | |
3680 This function returns the value corresponding to PROPERTY, | |
3681 or DEFAULT if PROPERTY is not one of the properties on the list. | |
428 | 3682 */ |
444 | 3683 (lax_plist, property, default_)) |
428 | 3684 { |
444 | 3685 Lisp_Object value = external_plist_get (&lax_plist, property, 1, ERROR_ME); |
3686 return UNBOUNDP (value) ? default_ : value; | |
428 | 3687 } |
3688 | |
3689 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /* | |
444 | 3690 Change value in LAX-PLIST of PROPERTY to VALUE. |
3691 LAX-PLIST is a lax property list, which is a list of the form | |
3692 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between | |
3693 properties is done using `equal' instead of `eq'. | |
3694 PROPERTY is usually a symbol and VALUE is any object. | |
3695 If PROPERTY is already a property on the list, its value is set to | |
3696 VALUE, otherwise the new PROPERTY VALUE pair is added. | |
3697 The new plist is returned; use `(setq x (lax-plist-put x property value))' | |
3698 to be sure to use the new value. LAX-PLIST is modified by side effect. | |
428 | 3699 */ |
444 | 3700 (lax_plist, property, value)) |
428 | 3701 { |
444 | 3702 external_plist_put (&lax_plist, property, value, 1, ERROR_ME); |
428 | 3703 return lax_plist; |
3704 } | |
3705 | |
3706 DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /* | |
444 | 3707 Remove from LAX-PLIST the property PROPERTY and its value. |
3708 LAX-PLIST is a lax property list, which is a list of the form | |
3709 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between | |
3710 properties is done using `equal' instead of `eq'. | |
3711 PROPERTY is usually a symbol. | |
3712 The new plist is returned; use `(setq x (lax-plist-remprop x property))' | |
3713 to be sure to use the new value. LAX-PLIST is modified by side effect. | |
428 | 3714 */ |
444 | 3715 (lax_plist, property)) |
428 | 3716 { |
444 | 3717 external_remprop (&lax_plist, property, 1, ERROR_ME); |
428 | 3718 return lax_plist; |
3719 } | |
3720 | |
3721 DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /* | |
444 | 3722 Return t if PROPERTY has a value specified in LAX-PLIST. |
3723 LAX-PLIST is a lax property list, which is a list of the form | |
3724 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between | |
3725 properties is done using `equal' instead of `eq'. | |
428 | 3726 */ |
444 | 3727 (lax_plist, property)) |
428 | 3728 { |
444 | 3729 return UNBOUNDP (Flax_plist_get (lax_plist, property, Qunbound)) ? Qnil : Qt; |
428 | 3730 } |
3731 | |
3732 DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /* | |
3733 Destructively remove any duplicate entries from a lax plist. | |
3734 In such cases, the first entry applies. | |
3735 | |
3736 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with | |
3737 a nil value is removed. This feature is a virus that has infected | |
3738 old Lisp implementations, but should not be used except for backward | |
3739 compatibility. | |
3740 | |
3741 The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the | |
3742 return value may not be EQ to the passed-in value, so make sure to | |
3743 `setq' the value back into where it came from. | |
3744 */ | |
3745 (lax_plist, nil_means_not_present)) | |
3746 { | |
3747 Lisp_Object head = lax_plist; | |
3748 | |
3749 Fcheck_valid_plist (lax_plist); | |
3750 | |
3751 while (!NILP (lax_plist)) | |
3752 { | |
3753 Lisp_Object prop = Fcar (lax_plist); | |
3754 Lisp_Object next = Fcdr (lax_plist); | |
3755 | |
3756 CHECK_CONS (next); /* just make doubly sure we catch any errors */ | |
3757 if (!NILP (nil_means_not_present) && NILP (Fcar (next))) | |
3758 { | |
3759 if (EQ (head, lax_plist)) | |
3760 head = Fcdr (next); | |
3761 lax_plist = Fcdr (next); | |
3762 continue; | |
3763 } | |
3764 /* external_remprop returns 1 if it removed any property. | |
3765 We have to loop till it didn't remove anything, in case | |
3766 the property occurs many times. */ | |
3767 while (external_remprop (&XCDR (next), prop, 1, ERROR_ME)) | |
3768 DO_NOTHING; | |
3769 lax_plist = Fcdr (next); | |
3770 } | |
3771 | |
3772 return head; | |
3773 } | |
3774 | |
3775 /* In C because the frame props stuff uses it */ | |
3776 | |
3777 DEFUN ("destructive-alist-to-plist", Fdestructive_alist_to_plist, 1, 1, 0, /* | |
3778 Convert association list ALIST into the equivalent property-list form. | |
3779 The plist is returned. This converts from | |
3780 | |
3781 \((a . 1) (b . 2) (c . 3)) | |
3782 | |
3783 into | |
3784 | |
3785 \(a 1 b 2 c 3) | |
3786 | |
3787 The original alist is destroyed in the process of constructing the plist. | |
3788 See also `alist-to-plist'. | |
3789 */ | |
3790 (alist)) | |
3791 { | |
3792 Lisp_Object head = alist; | |
3793 while (!NILP (alist)) | |
3794 { | |
3795 /* remember the alist element. */ | |
3796 Lisp_Object el = Fcar (alist); | |
3797 | |
3798 Fsetcar (alist, Fcar (el)); | |
3799 Fsetcar (el, Fcdr (el)); | |
3800 Fsetcdr (el, Fcdr (alist)); | |
3801 Fsetcdr (alist, el); | |
3802 alist = Fcdr (Fcdr (alist)); | |
3803 } | |
3804 | |
3805 return head; | |
3806 } | |
3807 | |
3808 DEFUN ("get", Fget, 2, 3, 0, /* | |
442 | 3809 Return the value of OBJECT's PROPERTY property. |
3810 This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'. | |
428 | 3811 If there is no such property, return optional third arg DEFAULT |
442 | 3812 \(which defaults to `nil'). OBJECT can be a symbol, string, extent, |
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3813 face, glyph, or process. See also `put', `remprop', `object-plist', and |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3814 `object-setplist'. |
428 | 3815 */ |
442 | 3816 (object, property, default_)) |
428 | 3817 { |
3818 /* Various places in emacs call Fget() and expect it not to quit, | |
3819 so don't quit. */ | |
442 | 3820 Lisp_Object val; |
3821 | |
3822 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->getprop) | |
3823 val = XRECORD_LHEADER_IMPLEMENTATION (object)->getprop (object, property); | |
428 | 3824 else |
563 | 3825 invalid_operation ("Object type has no properties", object); |
442 | 3826 |
3827 return UNBOUNDP (val) ? default_ : val; | |
428 | 3828 } |
3829 | |
3830 DEFUN ("put", Fput, 3, 3, 0, /* | |
442 | 3831 Set OBJECT's PROPERTY to VALUE. |
3832 It can be subsequently retrieved with `(get OBJECT PROPERTY)'. | |
3833 OBJECT can be a symbol, face, extent, or string. | |
428 | 3834 For a string, no properties currently have predefined meanings. |
3835 For the predefined properties for extents, see `set-extent-property'. | |
3836 For the predefined properties for faces, see `set-face-property'. | |
3837 See also `get', `remprop', and `object-plist'. | |
3838 */ | |
442 | 3839 (object, property, value)) |
428 | 3840 { |
1920 | 3841 /* This function cannot GC */ |
428 | 3842 CHECK_LISP_WRITEABLE (object); |
3843 | |
442 | 3844 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->putprop) |
428 | 3845 { |
442 | 3846 if (! XRECORD_LHEADER_IMPLEMENTATION (object)->putprop |
3847 (object, property, value)) | |
563 | 3848 invalid_change ("Can't set property on object", property); |
428 | 3849 } |
3850 else | |
563 | 3851 invalid_change ("Object type has no settable properties", object); |
428 | 3852 |
3853 return value; | |
3854 } | |
3855 | |
3856 DEFUN ("remprop", Fremprop, 2, 2, 0, /* | |
442 | 3857 Remove, from OBJECT's property list, PROPERTY and its corresponding value. |
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3858 OBJECT can be a symbol, string, extent, face, glyph, or process. |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3859 Return non-nil if the property list was actually modified (i.e. if PROPERTY |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3860 was present in the property list). See also `get', `put', `object-plist', |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3861 and `object-setplist'. |
428 | 3862 */ |
442 | 3863 (object, property)) |
428 | 3864 { |
442 | 3865 int ret = 0; |
3866 | |
428 | 3867 CHECK_LISP_WRITEABLE (object); |
3868 | |
442 | 3869 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->remprop) |
428 | 3870 { |
442 | 3871 ret = XRECORD_LHEADER_IMPLEMENTATION (object)->remprop (object, property); |
3872 if (ret == -1) | |
563 | 3873 invalid_change ("Can't remove property from object", property); |
428 | 3874 } |
3875 else | |
563 | 3876 invalid_change ("Object type has no removable properties", object); |
442 | 3877 |
3878 return ret ? Qt : Qnil; | |
428 | 3879 } |
3880 | |
3881 DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /* | |
442 | 3882 Return a property list of OBJECT's properties. |
3883 For a symbol, this is equivalent to `symbol-plist'. | |
3884 OBJECT can be a symbol, string, extent, face, or glyph. | |
3885 Do not modify the returned property list directly; | |
3886 this may or may not have the desired effects. Use `put' instead. | |
428 | 3887 */ |
3888 (object)) | |
3889 { | |
442 | 3890 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->plist) |
3891 return XRECORD_LHEADER_IMPLEMENTATION (object)->plist (object); | |
428 | 3892 else |
563 | 3893 invalid_operation ("Object type has no properties", object); |
428 | 3894 |
3895 return Qnil; | |
3896 } | |
3897 | |
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3898 DEFUN ("object-setplist", Fobject_setplist, 2, 2, 0, /* |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3899 Set OBJECT's property list to NEWPLIST, and return NEWPLIST. |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3900 For a symbol, this is equivalent to `setplist'. |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3901 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3902 OBJECT can be a symbol or a process, other objects with visible plists do |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3903 not allow their modification with `object-setplist'. |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3904 */ |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3905 (object, newplist)) |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3906 { |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3907 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->setplist) |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3908 { |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3909 return XRECORD_LHEADER_IMPLEMENTATION (object)->setplist (object, |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3910 newplist); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3911 } |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3912 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3913 invalid_operation ("Not possible to set object's plist", object); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3914 return Qnil; |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3915 } |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3916 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
3917 |
428 | 3918 |
853 | 3919 static Lisp_Object |
3920 tweaked_internal_equal (Lisp_Object obj1, Lisp_Object obj2, | |
3921 Lisp_Object depth) | |
3922 { | |
3923 return make_int (internal_equal (obj1, obj2, XINT (depth))); | |
3924 } | |
3925 | |
3926 int | |
3927 internal_equal_trapping_problems (Lisp_Object warning_class, | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
3928 const Ascbyte *warning_string, |
853 | 3929 int flags, |
3930 struct call_trapping_problems_result *p, | |
3931 int retval, | |
3932 Lisp_Object obj1, Lisp_Object obj2, | |
3933 int depth) | |
3934 { | |
3935 Lisp_Object glorp = | |
3936 va_call_trapping_problems (warning_class, warning_string, | |
3937 flags, p, | |
3938 (lisp_fn_t) tweaked_internal_equal, | |
3939 3, obj1, obj2, make_int (depth)); | |
3940 if (UNBOUNDP (glorp)) | |
3941 return retval; | |
3942 else | |
3943 return XINT (glorp); | |
3944 } | |
3945 | |
428 | 3946 int |
3947 internal_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
3948 { | |
3949 if (depth > 200) | |
563 | 3950 stack_overflow ("Stack overflow in equal", Qunbound); |
428 | 3951 QUIT; |
3952 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2)) | |
3953 return 1; | |
3954 /* Note that (equal 20 20.0) should be nil */ | |
3955 if (XTYPE (obj1) != XTYPE (obj2)) | |
3956 return 0; | |
3957 if (LRECORDP (obj1)) | |
3958 { | |
442 | 3959 const struct lrecord_implementation |
428 | 3960 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1), |
3961 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2); | |
3962 | |
3963 return (imp1 == imp2) && | |
3964 /* EQ-ness of the objects was noticed above */ | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3965 (imp1->equal && (imp1->equal) (obj1, obj2, depth, 0)); |
428 | 3966 } |
3967 | |
3968 return 0; | |
3969 } | |
3970 | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3971 enum array_type |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3972 { |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3973 ARRAY_NONE = 0, |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3974 ARRAY_STRING, |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3975 ARRAY_VECTOR, |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3976 ARRAY_BIT_VECTOR |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3977 }; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3978 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3979 static enum array_type |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3980 array_type (Lisp_Object obj) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3981 { |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3982 if (STRINGP (obj)) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3983 return ARRAY_STRING; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3984 if (VECTORP (obj)) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3985 return ARRAY_VECTOR; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3986 if (BIT_VECTORP (obj)) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3987 return ARRAY_BIT_VECTOR; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3988 return ARRAY_NONE; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3989 } |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3990 |
801 | 3991 int |
3992 internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
3993 { | |
3994 if (depth > 200) | |
3995 stack_overflow ("Stack overflow in equalp", Qunbound); | |
3996 QUIT; | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3997 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3998 /* 1. Objects that are `eq' are equal. This will catch the common case |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
3999 of two equal fixnums or the same object seen twice. */ |
801 | 4000 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2)) |
4001 return 1; | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4002 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4003 /* 2. If both numbers, compare with `='. */ |
1983 | 4004 if (NUMBERP (obj1) && NUMBERP (obj2)) |
4005 { | |
4910
6bc1f3f6cf0d
Make canoncase visible to Lisp; use it with chars in internal_equalp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4906
diff
changeset
|
4006 return (0 == bytecode_arithcompare (obj1, obj2)); |
1983 | 4007 } |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4008 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4009 /* 3. If characters, compare case-insensitively. */ |
801 | 4010 if (CHARP (obj1) && CHARP (obj2)) |
4910
6bc1f3f6cf0d
Make canoncase visible to Lisp; use it with chars in internal_equalp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4906
diff
changeset
|
4011 return CANONCASE (0, XCHAR (obj1)) == CANONCASE (0, XCHAR (obj2)); |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4012 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4013 /* 4. If arrays of different types, compare their lengths, and |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4014 then compare element-by-element. */ |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4015 { |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4016 enum array_type artype1, artype2; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4017 artype1 = array_type (obj1); |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4018 artype2 = array_type (obj2); |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4019 if (artype1 != artype2 && artype1 && artype2) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4020 { |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4021 EMACS_INT i; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4022 EMACS_INT l1 = XINT (Flength (obj1)); |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4023 EMACS_INT l2 = XINT (Flength (obj2)); |
4910
6bc1f3f6cf0d
Make canoncase visible to Lisp; use it with chars in internal_equalp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4906
diff
changeset
|
4024 /* Both arrays, but of different lengths */ |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4025 if (l1 != l2) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4026 return 0; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4027 for (i = 0; i < l1; i++) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4028 if (!internal_equalp (Faref (obj1, make_int (i)), |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4029 Faref (obj2, make_int (i)), depth + 1)) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4030 return 0; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4031 return 1; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4032 } |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4033 } |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4034 /* 5. Else, they must be the same type. If so, call the equal() method, |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4035 telling it to fold case. For objects that care about case-folding |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4036 their contents, the equal() method will call internal_equal_0(). */ |
801 | 4037 if (XTYPE (obj1) != XTYPE (obj2)) |
4038 return 0; | |
4039 if (LRECORDP (obj1)) | |
4040 { | |
4041 const struct lrecord_implementation | |
4042 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1), | |
4043 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2); | |
4044 | |
4045 return (imp1 == imp2) && | |
4046 /* EQ-ness of the objects was noticed above */ | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4047 (imp1->equal && (imp1->equal) (obj1, obj2, depth, 1)); |
801 | 4048 } |
4049 | |
4050 return 0; | |
4051 } | |
4052 | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4053 int |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4054 internal_equal_0 (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4055 { |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4056 if (foldcase) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4057 return internal_equalp (obj1, obj2, depth); |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4058 else |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4059 return internal_equal (obj1, obj2, depth); |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4060 } |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4061 |
428 | 4062 /* Note that we may be calling sub-objects that will use |
4063 internal_equal() (instead of internal_old_equal()). Oh well. | |
4064 We will get an Ebola note if there's any possibility of confusion, | |
4065 but that seems unlikely. */ | |
4066 | |
4067 static int | |
4068 internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
4069 { | |
4070 if (depth > 200) | |
563 | 4071 stack_overflow ("Stack overflow in equal", Qunbound); |
428 | 4072 QUIT; |
4073 if (HACKEQ_UNSAFE (obj1, obj2)) | |
4074 return 1; | |
4075 /* Note that (equal 20 20.0) should be nil */ | |
4076 if (XTYPE (obj1) != XTYPE (obj2)) | |
4077 return 0; | |
4078 | |
4079 return internal_equal (obj1, obj2, depth); | |
4080 } | |
4081 | |
4082 DEFUN ("equal", Fequal, 2, 2, 0, /* | |
4083 Return t if two Lisp objects have similar structure and contents. | |
4084 They must have the same data type. | |
4085 Conses are compared by comparing the cars and the cdrs. | |
4086 Vectors and strings are compared element by element. | |
4087 Numbers are compared by value. Symbols must match exactly. | |
4088 */ | |
444 | 4089 (object1, object2)) |
428 | 4090 { |
444 | 4091 return internal_equal (object1, object2, 0) ? Qt : Qnil; |
428 | 4092 } |
4093 | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4094 DEFUN ("equalp", Fequalp, 2, 2, 0, /* |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4095 Return t if two Lisp objects have similar structure and contents. |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4096 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4097 This is like `equal', except that it accepts numerically equal |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4098 numbers of different types (float, integer, bignum, bigfloat), and also |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4099 compares strings and characters case-insensitively. |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4100 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4101 Type objects that are arrays (that is, strings, bit-vectors, and vectors) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4102 of the same length and with contents that are `equalp' are themselves |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4103 `equalp', regardless of whether the two objects have the same type. |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4104 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4105 Other objects whose primary purpose is as containers of other objects are |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4106 `equalp' if they would otherwise be equal (same length, type, etc.) and |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4107 their contents are `equalp'. This goes for conses, weak lists, |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4108 weak boxes, ephemerons, specifiers, hash tables, char tables and range |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4109 tables. However, objects that happen to contain other objects but are not |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4110 primarily designed for this purpose (e.g. compiled functions, events or |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4111 display-related objects such as glyphs, faces or extents) are currently |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4112 compared using `equalp' the same way as using `equal'. |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4113 |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4114 More specifically, two hash tables are `equalp' if they have the same test |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4115 (see `hash-table-test'), the same number of entries, and the same value for |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4116 `hash-table-weakness', and if, for each entry in one hash table, its key is |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4117 equivalent to a key in the other hash table using the hash table test, and |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4118 its value is `equalp' to the other hash table's value for that key. |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4119 */ |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4120 (object1, object2)) |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4121 { |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4122 return internal_equalp (object1, object2, 0) ? Qt : Qnil; |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4123 } |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4124 |
428 | 4125 DEFUN ("old-equal", Fold_equal, 2, 2, 0, /* |
4126 Return t if two Lisp objects have similar structure and contents. | |
4127 They must have the same data type. | |
4128 \(Note, however, that an exception is made for characters and integers; | |
4129 this is known as the "char-int confoundance disease." See `eq' and | |
4130 `old-eq'.) | |
4131 This function is provided only for byte-code compatibility with v19. | |
4132 Do not use it. | |
4133 */ | |
444 | 4134 (object1, object2)) |
428 | 4135 { |
444 | 4136 return internal_old_equal (object1, object2, 0) ? Qt : Qnil; |
428 | 4137 } |
4138 | |
4139 | |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4140 static Lisp_Object replace_string_range_1 (Lisp_Object dest, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4141 Lisp_Object start, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4142 Lisp_Object end, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4143 const Ibyte *source, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4144 const Ibyte *source_limit, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4145 Lisp_Object item); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4146 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4147 /* Fill the substring of DEST beginning at START and ending before END with |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4148 the character ITEM. If DEST does not have sufficient space for END - |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4149 START characters at START, write as many as is possible without changing |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4150 the character length of DEST. Update the string modification flag and do |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4151 any sledgehammer checks we have turned on. |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4152 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4153 START must be a Lisp integer. END can be nil, indicating the length of the |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4154 string, or a Lisp integer. The condition (<= 0 START END (length DEST)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4155 must hold, or fill_string_range() will signal an error. */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4156 static Lisp_Object |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4157 fill_string_range (Lisp_Object dest, Lisp_Object item, Lisp_Object start, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4158 Lisp_Object end) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4159 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4160 return replace_string_range_1 (dest, start, end, NULL, NULL, item); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4161 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4162 |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4163 DEFUN ("fill", Ffill, 2, MANY, 0, /* |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4164 Destructively modify SEQUENCE by replacing each element with ITEM. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4165 SEQUENCE is a list, vector, bit vector, or string. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4166 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4167 Optional keyword START is the index of the first element of SEQUENCE |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4168 to be modified, and defaults to zero. Optional keyword END is the |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4169 exclusive upper bound on the elements of SEQUENCE to be modified, and |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4170 defaults to the length of SEQUENCE. |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4171 |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4172 arguments: (SEQUENCE ITEM &key (START 0) (END (length SEQUENCE))) |
428 | 4173 */ |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4174 (int nargs, Lisp_Object *args)) |
428 | 4175 { |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4176 Lisp_Object sequence = args[0]; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4177 Lisp_Object item = args[1]; |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4178 Elemcount starting = 0, ending = EMACS_INT_MAX, ii, len; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4179 |
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5275
diff
changeset
|
4180 PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero)); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4181 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4182 CHECK_NATNUM (start); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4183 starting = XINT (start); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4184 |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4185 if (!NILP (end)) |
428 | 4186 { |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4187 CHECK_NATNUM (end); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4188 ending = XINT (end); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4189 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4190 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4191 retry: |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4192 if (STRINGP (sequence)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4193 { |
428 | 4194 CHECK_CHAR_COERCE_INT (item); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4195 CHECK_LISP_WRITEABLE (sequence); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4196 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4197 fill_string_range (sequence, item, start, end); |
428 | 4198 } |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4199 else if (VECTORP (sequence)) |
428 | 4200 { |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4201 Lisp_Object *p = XVECTOR_DATA (sequence); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4202 |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4203 CHECK_LISP_WRITEABLE (sequence); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4204 len = XVECTOR_LENGTH (sequence); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4205 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4206 check_sequence_range (sequence, start, end, make_int (len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4207 ending = min (ending, len); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4208 |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4209 for (ii = starting; ii < ending; ++ii) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4210 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4211 p[ii] = item; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4212 } |
428 | 4213 } |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4214 else if (BIT_VECTORP (sequence)) |
428 | 4215 { |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4216 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); |
428 | 4217 int bit; |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4218 |
428 | 4219 CHECK_BIT (item); |
444 | 4220 bit = XINT (item); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4221 CHECK_LISP_WRITEABLE (sequence); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4222 len = bit_vector_length (v); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4223 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4224 check_sequence_range (sequence, start, end, make_int (len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4225 ending = min (ending, len); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4226 |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4227 for (ii = starting; ii < ending; ++ii) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4228 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4229 set_bit_vector_bit (v, ii, bit); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4230 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4231 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4232 else if (LISTP (sequence)) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4233 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4234 Elemcount counting = 0; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4235 |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4236 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4237 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4238 if (counting >= starting) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4239 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4240 if (counting < ending) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4241 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4242 XSETCAR (tail, item); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4243 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4244 else if (counting == ending) |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4245 { |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4246 break; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4247 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4248 } |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4249 ++counting; |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4250 } |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4251 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
4252 if (counting < starting || (counting != ending && !NILP (end))) |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4253 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
4254 check_sequence_range (args[0], start, end, Flength (args[0])); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4255 } |
428 | 4256 } |
4257 else | |
4258 { | |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4259 sequence = wrong_type_argument (Qsequencep, sequence); |
428 | 4260 goto retry; |
4261 } | |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
4262 return sequence; |
428 | 4263 } |
4264 | |
4265 Lisp_Object | |
4266 nconc2 (Lisp_Object arg1, Lisp_Object arg2) | |
4267 { | |
4268 Lisp_Object args[2]; | |
4269 struct gcpro gcpro1; | |
4270 args[0] = arg1; | |
4271 args[1] = arg2; | |
4272 | |
4273 GCPRO1 (args[0]); | |
4274 gcpro1.nvars = 2; | |
4275 | |
4276 RETURN_UNGCPRO (bytecode_nconc2 (args)); | |
4277 } | |
4278 | |
4279 Lisp_Object | |
4280 bytecode_nconc2 (Lisp_Object *args) | |
4281 { | |
4282 retry: | |
4283 | |
4284 if (CONSP (args[0])) | |
4285 { | |
4286 /* (setcdr (last args[0]) args[1]) */ | |
4287 Lisp_Object tortoise, hare; | |
665 | 4288 Elemcount count; |
428 | 4289 |
4290 for (hare = tortoise = args[0], count = 0; | |
4291 CONSP (XCDR (hare)); | |
4292 hare = XCDR (hare), count++) | |
4293 { | |
4294 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue; | |
4295 | |
4296 if (count & 1) | |
4297 tortoise = XCDR (tortoise); | |
4298 if (EQ (hare, tortoise)) | |
4299 signal_circular_list_error (args[0]); | |
4300 } | |
4301 XCDR (hare) = args[1]; | |
4302 return args[0]; | |
4303 } | |
4304 else if (NILP (args[0])) | |
4305 { | |
4306 return args[1]; | |
4307 } | |
4308 else | |
4309 { | |
4310 args[0] = wrong_type_argument (args[0], Qlistp); | |
4311 goto retry; | |
4312 } | |
4313 } | |
4314 | |
4315 DEFUN ("nconc", Fnconc, 0, MANY, 0, /* | |
4316 Concatenate any number of lists by altering them. | |
4317 Only the last argument is not altered, and need not be a list. | |
4318 Also see: `append'. | |
4319 If the first argument is nil, there is no way to modify it by side | |
4320 effect; therefore, write `(setq foo (nconc foo list))' to be sure of | |
4321 changing the value of `foo'. | |
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
4322 |
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3842
diff
changeset
|
4323 arguments: (&rest ARGS) |
428 | 4324 */ |
4325 (int nargs, Lisp_Object *args)) | |
4326 { | |
4327 int argnum = 0; | |
4328 struct gcpro gcpro1; | |
4329 | |
4330 /* The modus operandi in Emacs is "caller gc-protects args". | |
4331 However, nconc (particularly nconc2 ()) is called many times | |
4332 in Emacs on freshly created stuff (e.g. you see the idiom | |
4333 nconc2 (Fcopy_sequence (foo), bar) a lot). So we help those | |
4334 callers out by protecting the args ourselves to save them | |
4335 a lot of temporary-variable grief. */ | |
4336 | |
4337 GCPRO1 (args[0]); | |
4338 gcpro1.nvars = nargs; | |
4339 | |
4340 while (argnum < nargs) | |
4341 { | |
4342 Lisp_Object val; | |
4343 retry: | |
4344 val = args[argnum]; | |
4345 if (CONSP (val)) | |
4346 { | |
4347 /* `val' is the first cons, which will be our return value. */ | |
4348 /* `last_cons' will be the cons cell to mutate. */ | |
4349 Lisp_Object last_cons = val; | |
4350 Lisp_Object tortoise = val; | |
4351 | |
4352 for (argnum++; argnum < nargs; argnum++) | |
4353 { | |
4354 Lisp_Object next = args[argnum]; | |
4355 retry_next: | |
4356 if (CONSP (next) || argnum == nargs -1) | |
4357 { | |
4358 /* (setcdr (last val) next) */ | |
665 | 4359 Elemcount count; |
428 | 4360 |
4361 for (count = 0; | |
4362 CONSP (XCDR (last_cons)); | |
4363 last_cons = XCDR (last_cons), count++) | |
4364 { | |
4365 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue; | |
4366 | |
4367 if (count & 1) | |
4368 tortoise = XCDR (tortoise); | |
4369 if (EQ (last_cons, tortoise)) | |
4370 signal_circular_list_error (args[argnum-1]); | |
4371 } | |
4372 XCDR (last_cons) = next; | |
4373 } | |
4374 else if (NILP (next)) | |
4375 { | |
4376 continue; | |
4377 } | |
4378 else | |
4379 { | |
4380 next = wrong_type_argument (Qlistp, next); | |
4381 goto retry_next; | |
4382 } | |
4383 } | |
4384 RETURN_UNGCPRO (val); | |
4385 } | |
4386 else if (NILP (val)) | |
4387 argnum++; | |
4388 else if (argnum == nargs - 1) /* last arg? */ | |
4389 RETURN_UNGCPRO (val); | |
4390 else | |
4391 { | |
4392 args[argnum] = wrong_type_argument (Qlistp, val); | |
4393 goto retry; | |
4394 } | |
4395 } | |
4396 RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */ | |
4397 } | |
4398 | |
4399 | |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4400 /* Replace the substring of DEST beginning at START and ending before END |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4401 with the text at SOURCE, which is END - START characters long and |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4402 SOURCE_LIMIT - SOURCE octets long. If DEST does not have sufficient |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4403 space for END - START characters at START, write as many as is possible |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4404 without changing the length of DEST. Update the string modification flag |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4405 and do any sledgehammer checks we have turned on in this build. |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4406 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4407 START must be a Lisp integer. END can be nil, indicating the length of the |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4408 string, or a Lisp integer. The condition (<= 0 START END (length DEST)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4409 must hold, or replace_string_range() will signal an error. */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4410 static Lisp_Object |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4411 replace_string_range (Lisp_Object dest, Lisp_Object start, Lisp_Object end, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4412 const Ibyte *source, const Ibyte *source_limit) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4413 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4414 return replace_string_range_1 (dest, start, end, source, source_limit, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4415 Qnil); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4416 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4417 |
434 | 4418 /* This is the guts of several mapping functions. |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4419 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4420 Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time, |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4421 taking the elements from SEQUENCES. If VALS is non-NULL, store the |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4422 results into VALS, a C array of Lisp_Objects; else, if LISP_VALS is |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4423 non-nil, store the results into LISP_VALS, a sequence with sufficient |
5034
1b96882bdf37
Fix a multiple-value bug, mapcarX; correct a comment and a label name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5002
diff
changeset
|
4424 room for CALL_COUNT results (but see the documentation of SOME_OR_EVERY.) |
1b96882bdf37
Fix a multiple-value bug, mapcarX; correct a comment and a label name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5002
diff
changeset
|
4425 Else, do not accumulate any result. |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4426 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4427 If VALS is non-NULL, NSEQUENCES is one, and SEQUENCES[0] is a cons, |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4428 mapcarX will store the elements of SEQUENCES[0] in stack and GCPRO them, |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4429 so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4430 mapcarX. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4431 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4432 Otherwise, mapcarX signals an invalid state error (see |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4433 mapping_interaction_error(), above) if it encounters a non-cons, |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4434 non-array when traversing SEQUENCES. Common Lisp specifies in |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4435 MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4436 destructively modifies SEQUENCES in a way that might affect the ongoing |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4437 traversal operation. |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4438 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4439 CALLER is a symbol describing the Lisp-visible function that was called, |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4440 and any errors thrown because SEQUENCES was modified will reflect it. |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4441 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4442 If CALLER is Qsome, return the (possibly multiple) values given by |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4443 FUNCTION the first time it is non-nil, and abandon the iterations. |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4444 LISP_VALS must be the result of calling STORE_VOID_IN_LISP on the address |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4445 of a Lisp object, and the return value will be stored at that address. |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4446 If CALLER is Qevery, LISP_VALS must also reflect a pointer to a Lisp |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4447 object, and Qnil will be stored at that address if FUNCTION gives nil; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4448 otherwise it will be left alone. */ |
428 | 4449 |
4450 static void | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4451 mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals, |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4452 Lisp_Object function, int nsequences, Lisp_Object *sequences, |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4453 Lisp_Object caller) |
428 | 4454 { |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4455 Lisp_Object called, *args; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4456 struct gcpro gcpro1, gcpro2; |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4457 Ibyte *lisp_vals_staging = NULL, *cursor = NULL; |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4458 int i, j; |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4459 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4460 assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4461 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4462 args = alloca_array (Lisp_Object, nsequences + 1); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4463 args[0] = function; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4464 for (i = 1; i <= nsequences; ++i) |
428 | 4465 { |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4466 args[i] = Qnil; |
428 | 4467 } |
4468 | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4469 if (vals != NULL) |
428 | 4470 { |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4471 GCPRO2 (args[0], vals[0]); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4472 gcpro1.nvars = nsequences + 1; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4473 gcpro2.nvars = 0; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4474 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4475 else |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4476 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4477 GCPRO1 (args[0]); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4478 gcpro1.nvars = nsequences + 1; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4479 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4480 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4481 /* Be extra nice in the event that we've been handed one list and one |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4482 only; make it possible for FUNCTION to set cdrs not yet processed to |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4483 non-cons, non-nil objects without ill-effect, if we have been handed |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4484 the stack space to do that. */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4485 if (vals != NULL && 1 == nsequences && CONSP (sequences[0])) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4486 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4487 Lisp_Object lst = sequences[0]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4488 Lisp_Object *val = vals; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4489 for (i = 0; i < call_count; ++i) |
434 | 4490 { |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4491 *val++ = XCAR (lst); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4492 lst = XCDR (lst); |
428 | 4493 } |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4494 gcpro2.nvars = call_count; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4495 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4496 for (i = 0; i < call_count; ++i) |
428 | 4497 { |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4498 args[1] = vals[i]; |
5034
1b96882bdf37
Fix a multiple-value bug, mapcarX; correct a comment and a label name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5002
diff
changeset
|
4499 vals[i] = IGNORE_MULTIPLE_VALUES (Ffuncall (nsequences + 1, args)); |
428 | 4500 } |
4501 } | |
4502 else | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4503 { |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4504 enum lrecord_type lisp_vals_type = lrecord_type_symbol; |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4505 Binbyte *sequence_types = alloca_array (Binbyte, nsequences); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4506 for (j = 0; j < nsequences; ++j) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4507 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4508 sequence_types[j] = XRECORD_LHEADER (sequences[j])->type; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4509 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4510 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4511 if (!EQ (caller, Qsome) && !EQ (caller, Qevery)) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4512 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4513 assert (LRECORDP (lisp_vals)); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4514 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4515 lisp_vals_type |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4516 = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type; |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4517 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4518 if (lrecord_type_string == lisp_vals_type) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4519 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4520 lisp_vals_staging = cursor |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4521 = alloca_ibytes (call_count * MAX_ICHAR_LEN); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4522 } |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4523 else if (ARRAYP (lisp_vals)) |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4524 { |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4525 CHECK_LISP_WRITEABLE (lisp_vals); |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4526 } |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4527 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4528 |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4529 for (i = 0; i < call_count; ++i) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4530 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4531 for (j = 0; j < nsequences; ++j) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4532 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4533 switch (sequence_types[j]) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4534 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4535 case lrecord_type_cons: |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4536 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4537 if (!CONSP (sequences[j])) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4538 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4539 /* This means FUNCTION has messed around with a cons |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4540 in one of the sequences, since we checked the |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4541 type (CHECK_SEQUENCE()) and the length and |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4542 structure (with Flength()) correctly in our |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4543 callers. */ |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4544 mapping_interaction_error (caller, sequences[j]); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4545 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4546 args[j + 1] = XCAR (sequences[j]); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4547 sequences[j] = XCDR (sequences[j]); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4548 break; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4549 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4550 case lrecord_type_vector: |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4551 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4552 args[j + 1] = XVECTOR_DATA (sequences[j])[i]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4553 break; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4554 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4555 case lrecord_type_string: |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4556 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4557 args[j + 1] = make_char (string_ichar (sequences[j], i)); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4558 break; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4559 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4560 case lrecord_type_bit_vector: |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4561 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4562 args[j + 1] |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4563 = make_int (bit_vector_bit (XBIT_VECTOR (sequences[j]), |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4564 i)); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4565 break; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4566 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4567 default: |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4568 ABORT(); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4569 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4570 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4571 called = Ffuncall (nsequences + 1, args); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4572 if (vals != NULL) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4573 { |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4574 vals[i] = IGNORE_MULTIPLE_VALUES (called); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4575 gcpro2.nvars += 1; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4576 } |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4577 else if (EQ (Qsome, caller)) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4578 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4579 if (!NILP (IGNORE_MULTIPLE_VALUES (called))) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4580 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4581 Lisp_Object *result |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4582 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4583 *result = called; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4584 UNGCPRO; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4585 return; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4586 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4587 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4588 else if (EQ (Qevery, caller)) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4589 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4590 if (NILP (IGNORE_MULTIPLE_VALUES (called))) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4591 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4592 Lisp_Object *result |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4593 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4594 *result = Qnil; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4595 UNGCPRO; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4596 return; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4597 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4598 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4599 else |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4600 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4601 called = IGNORE_MULTIPLE_VALUES (called); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4602 switch (lisp_vals_type) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4603 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4604 case lrecord_type_symbol: |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4605 /* Discard the result of funcall. */ |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4606 break; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4607 case lrecord_type_cons: |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4608 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4609 if (!CONSP (lisp_vals)) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4610 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4611 /* If FUNCTION has inserted a non-cons non-nil |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4612 cdr into the list before we've processed the |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4613 relevant part, error. */ |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4614 mapping_interaction_error (caller, lisp_vals); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4615 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4616 XSETCAR (lisp_vals, called); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4617 lisp_vals = XCDR (lisp_vals); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4618 break; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4619 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4620 case lrecord_type_vector: |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4621 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4622 i < XVECTOR_LENGTH (lisp_vals) ? |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4623 (XVECTOR_DATA (lisp_vals)[i] = called) : |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4624 /* Let #'aset error. */ |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4625 Faset (lisp_vals, make_int (i), called); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4626 break; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4627 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4628 case lrecord_type_string: |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4629 { |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4630 CHECK_CHAR_COERCE_INT (called); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4631 cursor += set_itext_ichar (cursor, XCHAR (called)); |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4632 break; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4633 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4634 case lrecord_type_bit_vector: |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4635 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4636 (BITP (called) && |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4637 i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ? |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4638 set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i, |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4639 XINT (called)) : |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4640 (void) Faset (lisp_vals, make_int (i), called); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4641 break; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4642 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4643 default: |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4644 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4645 ABORT(); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4646 break; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4647 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4648 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4649 } |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4650 } |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4651 |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4652 if (lisp_vals_staging != NULL) |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4653 { |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4654 CHECK_LISP_WRITEABLE (lisp_vals); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4655 replace_string_range (lisp_vals, Qzero, make_int (call_count), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4656 lisp_vals_staging, cursor); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4657 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4658 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
4659 |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4660 UNGCPRO; |
428 | 4661 } |
4662 | |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4663 /* Given NSEQUENCES objects at the address pointed to by SEQUENCES, return |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4664 the length of the shortest sequence. Error if all are circular, or if any |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4665 one of them is not a sequence. */ |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4666 static Elemcount |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4667 shortest_length_among_sequences (int nsequences, Lisp_Object *sequences) |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4668 { |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4669 Elemcount len = EMACS_INT_MAX; |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4670 Lisp_Object length = Qnil; |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4671 int i; |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4672 |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4673 for (i = 0; i < nsequences; ++i) |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4674 { |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4675 if (CONSP (sequences[i])) |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4676 { |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4677 length = Flist_length (sequences[i]); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4678 if (!NILP (length)) |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4679 { |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4680 len = min (len, XINT (length)); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4681 } |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4682 } |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4683 else |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4684 { |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4685 CHECK_SEQUENCE (sequences[i]); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4686 length = Flength (sequences[i]); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4687 len = min (len, XINT (length)); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4688 } |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4689 } |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4690 |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4691 if (NILP (length)) |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4692 { |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4693 signal_circular_list_error (sequences[0]); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4694 } |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4695 |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4696 return len; |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4697 } |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4698 |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4699 DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4700 Call FUNCTION on each element of SEQUENCE, and concat results to a string. |
751 | 4701 Between each pair of results, insert SEPARATOR. |
4702 | |
4703 Each result, and SEPARATOR, should be strings. Thus, using " " as SEPARATOR | |
4704 results in spaces between the values returned by FUNCTION. SEQUENCE itself | |
4705 may be a list, a vector, a bit vector, or a string. | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4706 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4707 With optional SEQUENCES, call FUNCTION each time with as many arguments as |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4708 there are SEQUENCES, plus one for the element from SEQUENCE. One element |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4709 from each sequence will be used each time FUNCTION is called, and |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4710 `mapconcat' will give up once the shortest sequence is exhausted. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4711 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4712 arguments: (FUNCTION SEQUENCE SEPARATOR &rest SEQUENCES) |
428 | 4713 */ |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4714 (int nargs, Lisp_Object *args)) |
428 | 4715 { |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4716 Lisp_Object function = args[0]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4717 Lisp_Object sequence = args[1]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4718 Lisp_Object separator = args[2]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4719 Elemcount len = EMACS_INT_MAX; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4720 Lisp_Object *args0; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4721 EMACS_INT i, nargs0; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4722 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4723 args[2] = sequence; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4724 args[1] = separator; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4725 |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4726 len = shortest_length_among_sequences (nargs - 2, args + 2); |
428 | 4727 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
4728 if (len == 0) return build_ascstring (""); |
428 | 4729 |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4730 nargs0 = len + len - 1; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4731 args0 = alloca_array (Lisp_Object, nargs0); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4732 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4733 /* Special-case this, it's very common and doesn't require any |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4734 funcalls. Upside of doing it here, instead of cl-macs.el: no consing, |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4735 apart from the final string, we allocate everything on the stack. */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4736 if (EQ (function, Qidentity) && 3 == nargs && CONSP (sequence)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4737 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4738 for (i = 0; i < len; ++i) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4739 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4740 args0[i] = XCAR (sequence); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4741 sequence = XCDR (sequence); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4742 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4743 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4744 else |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4745 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4746 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmapconcat); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4747 } |
428 | 4748 |
4749 for (i = len - 1; i >= 0; i--) | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4750 args0[i + i] = args0[i]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4751 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4752 for (i = 1; i < nargs0; i += 2) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4753 args0[i] = separator; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4754 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4755 return Fconcat (nargs0, args0); |
428 | 4756 } |
4757 | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4758 DEFUN ("mapcar*", FmapcarX, 2, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4759 Call FUNCTION on each element of SEQUENCE; return a list of the results. |
434 | 4760 The result is a list of the same length as SEQUENCE. |
428 | 4761 SEQUENCE may be a list, a vector, a bit vector, or a string. |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4762 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4763 With optional SEQUENCES, call FUNCTION each time with as many arguments as |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4764 there are SEQUENCES, plus one for the element from SEQUENCE. One element |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4765 from each sequence will be used each time FUNCTION is called, and `mapcar' |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4766 stops calling FUNCTION once the shortest sequence is exhausted. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4767 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4768 arguments: (FUNCTION SEQUENCE &rest SEQUENCES) |
428 | 4769 */ |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4770 (int nargs, Lisp_Object *args)) |
428 | 4771 { |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4772 Lisp_Object function = args[0]; |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4773 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4774 Lisp_Object *args0; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4775 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4776 args0 = alloca_array (Lisp_Object, len); |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4777 mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4778 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4779 return Flist ((int) len, args0); |
428 | 4780 } |
4781 | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4782 DEFUN ("mapvector", Fmapvector, 2, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4783 Call FUNCTION on each element of SEQUENCE; return a vector of the results. |
428 | 4784 The result is a vector of the same length as SEQUENCE. |
434 | 4785 SEQUENCE may be a list, a vector, a bit vector, or a string. |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4786 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4787 With optional SEQUENCES, call FUNCTION each time with as many arguments as |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4788 there are SEQUENCES, plus one for the element from SEQUENCE. One element |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4789 from each sequence will be used each time FUNCTION is called, and |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4790 `mapvector' stops calling FUNCTION once the shortest sequence is exhausted. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4791 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4792 arguments: (FUNCTION SEQUENCE &rest SEQUENCES) |
428 | 4793 */ |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4794 (int nargs, Lisp_Object *args)) |
428 | 4795 { |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4796 Lisp_Object function = args[0]; |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4797 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4798 Lisp_Object result = make_vector (len, Qnil); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4799 |
428 | 4800 struct gcpro gcpro1; |
4801 GCPRO1 (result); | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4802 /* Don't pass result as the lisp_object argument, we want mapcarX to protect |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4803 a single list argument's elements from being garbage-collected. */ |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4804 mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1, |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4805 Qmapvector); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4806 RETURN_UNGCPRO (result); |
428 | 4807 } |
4808 | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4809 DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4810 Call FUNCTION on each element of SEQUENCE; chain the results together. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4811 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4812 FUNCTION must normally return a list; the results will be concatenated |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4813 together using `nconc'. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4814 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4815 With optional SEQUENCES, call FUNCTION each time with as many arguments as |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4816 there are SEQUENCES, plus one for the element from SEQUENCE. One element |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4817 from each sequence will be used each time FUNCTION is called, and |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4818 `mapcan' stops calling FUNCTION once the shortest sequence is exhausted. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4819 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4820 arguments: (FUNCTION SEQUENCE &rest SEQUENCES) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4821 */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4822 (int nargs, Lisp_Object *args)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4823 { |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4824 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4825 Lisp_Object function = args[0], *result = alloca_array (Lisp_Object, len); |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4826 |
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4827 mapcarX (len, result, Qnil, function, nargs - 1, args + 1, Qmapcan); |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4828 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4829 /* #'nconc GCPROs its args in case of signals and error. */ |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4830 return Fnconc (len, result); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4831 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4832 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4833 DEFUN ("mapc", Fmapc, 2, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4834 Call FUNCTION on each element of SEQUENCE. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4835 |
428 | 4836 SEQUENCE may be a list, a vector, a bit vector, or a string. |
4837 This function is like `mapcar' but does not accumulate the results, | |
4838 which is more efficient if you do not use the results. | |
4839 | |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4840 With optional SEQUENCES, call FUNCTION each time with as many arguments as |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4841 there are SEQUENCES, plus one for the elements from SEQUENCE. One element |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4842 from each sequence will be used each time FUNCTION is called, and |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4843 `mapc' stops calling FUNCTION once the shortest sequence is exhausted. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4844 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4845 Return SEQUENCE. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4846 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4847 arguments: (FUNCTION SEQUENCE &rest SEQUENCES) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4848 */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4849 (int nargs, Lisp_Object *args)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4850 { |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4851 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4852 Lisp_Object sequence = args[1]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4853 struct gcpro gcpro1; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4854 /* We need to GCPRO sequence, because mapcarX will modify the |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4855 elements of the args array handed to it, and this may involve |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4856 elements of sequence getting garbage collected. */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4857 GCPRO1 (sequence); |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4858 mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, Qmapc); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4859 RETURN_UNGCPRO (sequence); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4860 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4861 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4862 DEFUN ("map", Fmap, 3, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4863 Map FUNCTION across one or more sequences, returning a sequence. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4864 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4865 TYPE is the sequence type to return, FUNCTION is the function, SEQUENCE is |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4866 the first argument sequence, SEQUENCES are the other argument sequences. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4867 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4868 FUNCTION will be called with (1+ (length SEQUENCES)) arguments, and must be |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4869 capable of accepting this number of arguments. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4870 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4871 Certain TYPEs are recognised internally by `map', but others are not, and |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4872 `coerce' may throw an error on an attempt to convert to a TYPE it does not |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4873 understand. A null TYPE means do not accumulate any values. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4874 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4875 arguments: (TYPE FUNCTION SEQUENCE &rest SEQUENCES) |
428 | 4876 */ |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4877 (int nargs, Lisp_Object *args)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4878 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4879 Lisp_Object type = args[0]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4880 Lisp_Object function = args[1]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4881 Lisp_Object result = Qnil; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4882 Lisp_Object *args0 = NULL; |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4883 Elemcount len = shortest_length_among_sequences (nargs - 2, args + 2); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4884 struct gcpro gcpro1; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4885 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4886 if (!NILP (type)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4887 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4888 args0 = alloca_array (Lisp_Object, len); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4889 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4890 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4891 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmap); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4892 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4893 if (EQ (type, Qnil)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4894 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4895 return result; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4896 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4897 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4898 if (EQ (type, Qvector) || EQ (type, Qarray)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4899 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4900 result = Fvector (len, args0); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4901 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4902 else if (EQ (type, Qstring)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4903 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4904 result = Fstring (len, args0); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4905 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4906 else if (EQ (type, Qlist)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4907 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4908 result = Flist (len, args0); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4909 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4910 else if (EQ (type, Qbit_vector)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4911 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4912 result = Fbit_vector (len, args0); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4913 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4914 else |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4915 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4916 result = Flist (len, args0); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4917 GCPRO1 (result); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4918 result = call2 (Qcoerce, result, type); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4919 UNGCPRO; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4920 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4921 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4922 return result; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4923 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4924 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4925 DEFUN ("map-into", Fmap_into, 2, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4926 Modify RESULT-SEQUENCE using the return values of FUNCTION on SEQUENCES. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4927 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4928 RESULT-SEQUENCE and SEQUENCES can be lists or arrays. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4929 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4930 FUNCTION must accept at least as many arguments as there are SEQUENCES |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4931 \(possibly zero). If RESULT-SEQUENCE and the elements of SEQUENCES are not |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4932 the same length, stop when the shortest is exhausted; any elements of |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4933 RESULT-SEQUENCE beyond that are unmodified. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4934 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4935 Return RESULT-SEQUENCE. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4936 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4937 arguments: (RESULT-SEQUENCE FUNCTION &rest SEQUENCES) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4938 */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4939 (int nargs, Lisp_Object *args)) |
428 | 4940 { |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4941 Elemcount len; |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4942 Lisp_Object result_sequence = args[0]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4943 Lisp_Object function = args[1]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4944 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4945 args[0] = function; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4946 args[1] = result_sequence; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4947 |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4948 len = shortest_length_among_sequences (nargs - 1, args + 1); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4949 |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4950 mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2, |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4951 Qmap_into); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4952 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
4953 return result_sequence; |
428 | 4954 } |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4955 |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4956 DEFUN ("some", Fsome, 2, MANY, 0, /* |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4957 Return true if PREDICATE gives non-nil for an element of SEQUENCE. |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4958 |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4959 If so, return the value (possibly multiple) given by PREDICATE. |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4960 |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4961 With optional SEQUENCES, call PREDICATE each time with as many arguments as |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4962 there are SEQUENCES (plus one for the element from SEQUENCE). |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4963 |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4964 See also `find-if', which returns the corresponding element of SEQUENCE, |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4965 rather than the value given by PREDICATE, and accepts bounding index |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4966 keywords. |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
4967 |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4968 arguments: (PREDICATE SEQUENCE &rest SEQUENCES) |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4969 */ |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4970 (int nargs, Lisp_Object *args)) |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4971 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4972 Lisp_Object result = Qnil, |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4973 result_ptr = STORE_VOID_IN_LISP ((void *) &result); |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4974 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4975 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4976 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4977 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4978 return result; |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4979 } |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4980 |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4981 DEFUN ("every", Fevery, 2, MANY, 0, /* |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4982 Return true if PREDICATE is true of every element of SEQUENCE. |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4983 |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4984 With optional SEQUENCES, call PREDICATE each time with as many arguments as |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4985 there are SEQUENCES (plus one for the element from SEQUENCE). |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4986 |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4987 In contrast to `some', `every' never returns multiple values. |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4988 |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4989 arguments: (PREDICATE SEQUENCE &rest SEQUENCES) |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4990 */ |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4991 (int nargs, Lisp_Object *args)) |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4992 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4993 Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result); |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
4994 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1); |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4995 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4996 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4997 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
4998 return result; |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
4999 } |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5000 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5001 /* Call FUNCTION with NLISTS arguments repeatedly, each Nth argument |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5002 corresponding to the result of calling (nthcdr ITERATION-COUNT LISTS[N]), |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5003 until that #'nthcdr expression gives nil for some element of LISTS. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5004 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5005 CALLER is a symbol reflecting the Lisp-visible function that was called, |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5006 and any errors thrown because SEQUENCES was modified will reflect it. |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5007 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5008 If CALLER is Qmapl, return LISTS[0]. Otherwise, return a list of the |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5009 return values from FUNCTION; if caller is Qmapcan, nconc them together. |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5010 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5011 In contrast to mapcarX, we don't require our callers to check LISTS for |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5012 well-formedness, we signal wrong-type-argument if it's not a list, or |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5013 circular-list if it's circular. */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5014 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5015 static Lisp_Object |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5016 maplist (Lisp_Object function, int nlists, Lisp_Object *lists, |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5017 Lisp_Object caller) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5018 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5019 Lisp_Object nconcing[2], accum = Qnil, *args, *tortoises, funcalled; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5020 Lisp_Object result = EQ (caller, Qmapl) ? lists[0] : Qnil; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5021 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5022 int i, j, continuing = (nlists > 0), called_count = 0; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5023 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5024 args = alloca_array (Lisp_Object, nlists + 1); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5025 args[0] = function; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5026 for (i = 1; i <= nlists; ++i) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5027 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5028 args[i] = Qnil; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5029 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5030 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5031 tortoises = alloca_array (Lisp_Object, nlists); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5032 memcpy (tortoises, lists, nlists * sizeof (Lisp_Object)); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5033 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5034 if (EQ (caller, Qmapcon)) |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5035 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5036 nconcing[0] = Qnil; |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5037 nconcing[1] = Qnil; |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5038 GCPRO4 (args[0], nconcing[0], tortoises[0], result); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5039 gcpro1.nvars = 1; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5040 gcpro2.nvars = 2; |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5041 gcpro3.nvars = nlists; |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5042 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5043 else |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5044 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5045 GCPRO3 (args[0], tortoises[0], result); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5046 gcpro1.nvars = 1; |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5047 gcpro2.nvars = nlists; |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5048 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5049 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5050 while (continuing) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5051 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5052 for (j = 0; j < nlists; ++j) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5053 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5054 if (CONSP (lists[j])) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5055 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5056 args[j + 1] = lists[j]; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5057 lists[j] = XCDR (lists[j]); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5058 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5059 else if (NILP (lists[j])) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5060 { |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5061 continuing = 0; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5062 break; |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5063 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5064 else |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5065 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5066 lists[j] = wrong_type_argument (Qlistp, lists[j]); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5067 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5068 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5069 if (!continuing) break; |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
5070 funcalled = IGNORE_MULTIPLE_VALUES (Ffuncall (nlists + 1, args)); |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5071 |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5072 if (EQ (caller, Qmapl)) |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5073 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5074 DO_NOTHING; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5075 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5076 else if (EQ (caller, Qmapcon)) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5077 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5078 nconcing[1] = funcalled; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5079 accum = bytecode_nconc2 (nconcing); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5080 if (NILP (result)) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5081 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5082 result = accum; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5083 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5084 /* Only check a given stretch of result for well-formedness |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5085 once: */ |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5086 nconcing[0] = funcalled; |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5087 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5088 else if (NILP (accum)) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5089 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5090 accum = result = Fcons (funcalled, Qnil); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5091 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5092 else |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5093 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5094 /* Add to the end, avoiding the need to call nreverse |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5095 once we're done: */ |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5096 XSETCDR (accum, Fcons (funcalled, Qnil)); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5097 accum = XCDR (accum); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5098 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5099 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5100 if (++called_count > CIRCULAR_LIST_SUSPICION_LENGTH) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5101 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5102 if (called_count & 1) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5103 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5104 for (j = 0; j < nlists; ++j) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5105 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5106 tortoises[j] = XCDR (tortoises[j]); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5107 if (EQ (lists[j], tortoises[j])) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5108 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5109 signal_circular_list_error (lists[j]); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5110 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5111 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5112 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5113 else |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5114 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5115 for (j = 0; j < nlists; ++j) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5116 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5117 if (EQ (lists[j], tortoises[j])) |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5118 { |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5119 signal_circular_list_error (lists[j]); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5120 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5121 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5122 } |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5123 } |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5124 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5125 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5126 RETURN_UNGCPRO (result); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5127 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5128 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5129 DEFUN ("maplist", Fmaplist, 2, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5130 Call FUNCTION on each sublist of LIST and LISTS. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5131 Like `mapcar', except applies to lists and their cdr's rather than to |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5132 the elements themselves." |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5133 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5134 arguments: (FUNCTION LIST &rest LISTS) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5135 */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5136 (int nargs, Lisp_Object *args)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5137 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5138 return maplist (args[0], nargs - 1, args + 1, Qmaplist); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5139 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5140 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5141 DEFUN ("mapl", Fmapl, 2, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5142 Like `maplist', but do not accumulate values returned by the function. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5143 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5144 arguments: (FUNCTION LIST &rest LISTS) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5145 */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5146 (int nargs, Lisp_Object *args)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5147 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5148 return maplist (args[0], nargs - 1, args + 1, Qmapl); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5149 } |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5150 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5151 DEFUN ("mapcon", Fmapcon, 2, MANY, 0, /* |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5152 Like `maplist', but chains together the values returned by FUNCTION. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5153 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5154 FUNCTION must return a list (unless it happens to be the last |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5155 iteration); the results will be concatenated together using `nconc'. |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5156 |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5157 arguments: (FUNCTION LIST &rest LISTS) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5158 */ |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5159 (int nargs, Lisp_Object *args)) |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5160 { |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
5161 return maplist (args[0], nargs - 1, args + 1, Qmapcon); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
5162 } |
428 | 5163 |
771 | 5164 /* Extra random functions */ |
442 | 5165 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5166 DEFUN ("reduce", Freduce, 2, MANY, 0, /* |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5167 Combine the elements of sequence using FUNCTION, a binary operation. |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5168 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5169 For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5170 SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5171 in SEQUENCE. |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5172 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5173 Keywords supported: :start :end :from-end :initial-value :key |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5174 See `remove*' for the meaning of :start, :end, :from-end and :key. |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5175 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5176 :initial-value specifies an element (typically an identity element, such as |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5177 0) that is conceptually prepended to the sequence (or appended, when |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5178 :from-end is given). |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5179 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5180 If the sequence has one element, that element is returned directly. |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5181 If the sequence has no elements, :initial-value is returned if given; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5182 otherwise, FUNCTION is called with no arguments, and its result returned. |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5183 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5184 arguments: (FUNCTION SEQUENCE &key (START 0) (END (length SEQUENCE)) FROM-END INITIAL-VALUE (KEY #'identity)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5185 */ |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5186 (int nargs, Lisp_Object *args)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5187 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5188 Lisp_Object function = args[0], sequence = args[1], accum = Qunbound; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5189 Elemcount starting, ending = EMACS_INT_MAX, ii = 0; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5190 |
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5275
diff
changeset
|
5191 PARSE_KEYWORDS (Freduce, nargs, args, 5, |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5192 (start, end, from_end, initial_value, key), |
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5275
diff
changeset
|
5193 (start = Qzero, initial_value = Qunbound)); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5194 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5195 CHECK_SEQUENCE (sequence); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5196 CHECK_NATNUM (start); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5197 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5198 CHECK_KEY_ARGUMENT (key); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5199 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5200 #define KEY(key, item) (EQ (Qidentity, key) ? item : \ |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5201 IGNORE_MULTIPLE_VALUES (call1 (key, item))) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5202 #define CALL2(function, accum, item) \ |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5203 IGNORE_MULTIPLE_VALUES (call2 (function, accum, item)) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5204 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5205 starting = XINT (start); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5206 if (!NILP (end)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5207 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5208 CHECK_NATNUM (end); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5209 ending = XINT (end); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5210 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5211 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5212 if (!(starting <= ending)) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5213 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5214 check_sequence_range (sequence, start, end, Flength (sequence)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5215 } |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5216 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5217 if (VECTORP (sequence)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5218 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5219 Lisp_Vector *vv = XVECTOR (sequence); |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5220 struct gcpro gcpro1; |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5221 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5222 check_sequence_range (sequence, start, end, make_int (vv->size)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5223 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5224 ending = min (ending, vv->size); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5225 |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5226 GCPRO1 (accum); |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5227 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5228 if (!UNBOUNDP (initial_value)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5229 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5230 accum = initial_value; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5231 } |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5232 else if (ending - starting) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5233 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5234 if (NILP (from_end)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5235 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5236 accum = KEY (key, vv->contents[starting]); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5237 starting++; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5238 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5239 else |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5240 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5241 accum = KEY (key, vv->contents[ending - 1]); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5242 ending--; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5243 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5244 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5245 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5246 if (NILP (from_end)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5247 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5248 for (ii = starting; ii < ending; ++ii) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5249 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5250 accum = CALL2 (function, accum, KEY (key, vv->contents[ii])); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5251 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5252 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5253 else |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5254 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5255 for (ii = ending - 1; ii >= starting; --ii) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5256 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5257 accum = CALL2 (function, KEY (key, vv->contents[ii]), accum); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5258 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5259 } |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5260 |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5261 UNGCPRO; |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5262 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5263 else if (BIT_VECTORP (sequence)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5264 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5265 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence); |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5266 struct gcpro gcpro1; |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5267 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5268 check_sequence_range (sequence, start, end, make_int (bv->size)); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5269 ending = min (ending, bv->size); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5270 |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5271 GCPRO1 (accum); |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5272 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5273 if (!UNBOUNDP (initial_value)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5274 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5275 accum = initial_value; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5276 } |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5277 else if (ending - starting) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5278 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5279 if (NILP (from_end)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5280 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5281 accum = KEY (key, make_int (bit_vector_bit (bv, starting))); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5282 starting++; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5283 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5284 else |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5285 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5286 accum = KEY (key, make_int (bit_vector_bit (bv, ending - 1))); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5287 ending--; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5288 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5289 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5290 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5291 if (NILP (from_end)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5292 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5293 for (ii = starting; ii < ending; ++ii) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5294 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5295 accum = CALL2 (function, accum, |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5296 KEY (key, make_int (bit_vector_bit (bv, ii)))); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5297 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5298 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5299 else |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5300 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5301 for (ii = ending - 1; ii >= starting; --ii) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5302 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5303 accum = CALL2 (function, KEY (key, |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5304 make_int (bit_vector_bit (bv, |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5305 ii))), |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5306 accum); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5307 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5308 } |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5309 |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5310 UNGCPRO; |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5311 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5312 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5313 else if (STRINGP (sequence)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5314 { |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5315 struct gcpro gcpro1; |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5316 |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5317 GCPRO1 (accum); |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5318 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5319 if (NILP (from_end)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5320 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5321 Bytecount byte_len = XSTRING_LENGTH (sequence); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5322 Bytecount cursor_offset = 0; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5323 const Ibyte *startp = XSTRING_DATA (sequence); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5324 const Ibyte *cursor = startp; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5325 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5326 for (ii = 0; ii != starting && cursor_offset < byte_len; ++ii) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5327 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5328 INC_IBYTEPTR (cursor); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5329 cursor_offset = cursor - startp; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5330 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5331 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5332 if (!UNBOUNDP (initial_value)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5333 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5334 accum = initial_value; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5335 } |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5336 else if (ending - starting && cursor_offset < byte_len) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5337 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5338 accum = KEY (key, make_char (itext_ichar (cursor))); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5339 starting++; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5340 startp = XSTRING_DATA (sequence); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5341 cursor = startp + cursor_offset; |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5342 |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5343 if (byte_len != XSTRING_LENGTH (sequence) |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5344 || !valid_ibyteptr_p (cursor)) |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5345 { |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5346 mapping_interaction_error (Qreduce, sequence); |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5347 } |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5348 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5349 INC_IBYTEPTR (cursor); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5350 cursor_offset = cursor - startp; |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5351 ii++; |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5352 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5353 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5354 while (cursor_offset < byte_len && ii < ending) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5355 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5356 accum = CALL2 (function, accum, |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5357 KEY (key, make_char (itext_ichar (cursor)))); |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5358 |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5359 startp = XSTRING_DATA (sequence); |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5360 cursor = startp + cursor_offset; |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5361 |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5362 if (byte_len != XSTRING_LENGTH (sequence) |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5363 || !valid_ibyteptr_p (cursor)) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5364 { |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5365 mapping_interaction_error (Qreduce, sequence); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5366 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5367 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5368 INC_IBYTEPTR (cursor); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5369 cursor_offset = cursor - startp; |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5370 ++ii; |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5371 } |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5372 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5373 if (ii < starting || (ii < ending && !NILP (end))) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5374 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5375 check_sequence_range (sequence, start, end, Flength (sequence)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5376 } |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5377 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5378 else |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5379 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5380 Elemcount len = string_char_length (sequence); |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5381 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5382 const Ibyte *cursor; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5383 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5384 check_sequence_range (sequence, start, end, make_int (len)); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5385 ending = min (ending, len); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5386 cursor = string_char_addr (sequence, ending - 1); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5387 cursor_offset = cursor - XSTRING_DATA (sequence); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5388 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5389 if (!UNBOUNDP (initial_value)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5390 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5391 accum = initial_value; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5392 } |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5393 else if (ending - starting) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5394 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5395 accum = KEY (key, make_char (itext_ichar (cursor))); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5396 ending--; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5397 if (ending > 0) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5398 { |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5399 cursor = XSTRING_DATA (sequence) + cursor_offset; |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5400 |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5401 if (!valid_ibyteptr_p (cursor)) |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5402 { |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5403 mapping_interaction_error (Qreduce, sequence); |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5404 } |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5405 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5406 DEC_IBYTEPTR (cursor); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5407 cursor_offset = cursor - XSTRING_DATA (sequence); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5408 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5409 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5410 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5411 for (ii = ending - 1; ii >= starting; --ii) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5412 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5413 accum = CALL2 (function, KEY (key, |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5414 make_char (itext_ichar (cursor))), |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5415 accum); |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5416 if (ii > 0) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5417 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5418 cursor = XSTRING_DATA (sequence) + cursor_offset; |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5419 |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5420 if (byte_len != XSTRING_LENGTH (sequence) |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5421 || !valid_ibyteptr_p (cursor)) |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5422 { |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5423 mapping_interaction_error (Qreduce, sequence); |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5424 } |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5425 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5426 DEC_IBYTEPTR (cursor); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5427 cursor_offset = cursor - XSTRING_DATA (sequence); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5428 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5429 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5430 } |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5431 |
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5432 UNGCPRO; |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5433 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5434 else if (LISTP (sequence)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5435 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5436 if (NILP (from_end)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5437 { |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5438 struct gcpro gcpro1, gcpro2; |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5439 Lisp_Object tailed = Qnil; |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5440 |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5441 GCPRO2 (tailed, accum); |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5442 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5443 if (!UNBOUNDP (initial_value)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5444 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5445 accum = initial_value; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5446 } |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5447 else if (ending - starting) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5448 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5449 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5450 { |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5451 /* KEY may amputate the list behind us; make sure what |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5452 remains to be processed is still reachable. */ |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5453 tailed = tail; |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5454 if (ii == starting) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5455 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5456 accum = KEY (key, elt); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5457 starting++; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5458 break; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5459 } |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5460 ++ii; |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5461 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5462 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5463 |
5275
5a9aa6c40c9b
Avoid statement-before-declaration problems with strict C89 builds, fns.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5273
diff
changeset
|
5464 ii = 0; |
5a9aa6c40c9b
Avoid statement-before-declaration problems with strict C89 builds, fns.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5273
diff
changeset
|
5465 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5466 if (ending - starting) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5467 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5468 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5469 { |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5470 /* KEY or FUNCTION may amputate the list behind us; make |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5471 sure what remains to be processed is still |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5472 reachable. */ |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5473 tailed = tail; |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5474 if (ii >= starting) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5475 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5476 if (ii < ending) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5477 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5478 accum = CALL2 (function, accum, KEY (key, elt)); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5479 } |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5480 else if (ii == ending) |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5481 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5482 break; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5483 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5484 } |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5485 ++ii; |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5486 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5487 } |
5241
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5488 |
d579d76f3dcc
Be more careful about side-effects from Lisp code, #'reduce
Aidan Kehoe <kehoea@parhasard.net>
parents:
5227
diff
changeset
|
5489 UNGCPRO; |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5490 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5491 if (ii < starting || (ii < ending && !NILP (end))) |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5492 { |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5493 check_sequence_range (sequence, start, end, Flength (sequence)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5494 } |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5495 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5496 else |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5497 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5498 Boolint need_accum = 0; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5499 Lisp_Object *subsequence = NULL; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5500 Elemcount counting = 0, len = 0; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5501 struct gcpro gcpro1; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5502 |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5503 len = XINT (Flength (sequence)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5504 check_sequence_range (sequence, start, end, make_int (len)); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5505 ending = min (ending, len); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5506 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5507 /* :from-end with a list; make an alloca copy of the relevant list |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5508 data, attempting to go backwards isn't worth the trouble. */ |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5509 if (!UNBOUNDP (initial_value)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5510 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5511 accum = initial_value; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5512 if (ending - starting && starting < ending) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5513 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5514 subsequence = alloca_array (Lisp_Object, ending - starting); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5515 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5516 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5517 else if (ending - starting && starting < ending) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5518 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5519 subsequence = alloca_array (Lisp_Object, ending - starting); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5520 need_accum = 1; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5521 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5522 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5523 if (ending - starting && starting < ending) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5524 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5525 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5526 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5527 if (counting >= starting) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5528 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5529 if (counting < ending) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5530 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5531 subsequence[ii++] = elt; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5532 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5533 else if (counting == ending) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5534 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5535 break; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5536 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5537 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5538 ++counting; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5539 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5540 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5541 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5542 if (subsequence != NULL) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5543 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5544 len = ending - starting; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5545 /* If we could be sure that neither FUNCTION nor KEY modify |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5546 SEQUENCE, this wouldn't be necessary, since all the |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5547 elements of SUBSEQUENCE would definitely always be |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5548 reachable via SEQUENCE. */ |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5549 GCPRO1 (subsequence[0]); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5550 gcpro1.nvars = len; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5551 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5552 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5553 if (need_accum) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5554 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5555 accum = KEY (key, subsequence[len - 1]); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5556 --len; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5557 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5558 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5559 for (ii = len; ii != 0;) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5560 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5561 --ii; |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5562 accum = CALL2 (function, KEY (key, subsequence[ii]), accum); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5563 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5564 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5565 if (subsequence != NULL) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5566 { |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5567 UNGCPRO; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5568 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5569 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5570 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5571 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5572 /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5573 need to return the result of calling FUNCTION with zero |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5574 arguments. */ |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5575 if (UNBOUNDP (accum)) |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5576 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5577 accum = IGNORE_MULTIPLE_VALUES (call0 (function)); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5578 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5579 |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5580 return accum; |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5581 } |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
5582 |
442 | 5583 DEFUN ("replace-list", Freplace_list, 2, 2, 0, /* |
5584 Destructively replace the list OLD with NEW. | |
5585 This is like (copy-sequence NEW) except that it reuses the | |
5586 conses in OLD as much as possible. If OLD and NEW are the same | |
5587 length, no consing will take place. | |
5588 */ | |
3025 | 5589 (old, new_)) |
442 | 5590 { |
2367 | 5591 Lisp_Object oldtail = old, prevoldtail = Qnil; |
5592 | |
3025 | 5593 EXTERNAL_LIST_LOOP_2 (elt, new_) |
442 | 5594 { |
5595 if (!NILP (oldtail)) | |
5596 { | |
5597 CHECK_CONS (oldtail); | |
2367 | 5598 XCAR (oldtail) = elt; |
442 | 5599 } |
5600 else if (!NILP (prevoldtail)) | |
5601 { | |
2367 | 5602 XCDR (prevoldtail) = Fcons (elt, Qnil); |
442 | 5603 prevoldtail = XCDR (prevoldtail); |
5604 } | |
5605 else | |
2367 | 5606 old = oldtail = Fcons (elt, Qnil); |
442 | 5607 |
5608 if (!NILP (oldtail)) | |
5609 { | |
5610 prevoldtail = oldtail; | |
5611 oldtail = XCDR (oldtail); | |
5612 } | |
5613 } | |
5614 | |
5615 if (!NILP (prevoldtail)) | |
5616 XCDR (prevoldtail) = Qnil; | |
5617 else | |
5618 old = Qnil; | |
5619 | |
5620 return old; | |
5621 } | |
5622 | |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5623 /* This function is the implementation of fill_string_range() and |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5624 replace_string_range(); see the comments for those functions. */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5625 static Lisp_Object |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5626 replace_string_range_1 (Lisp_Object dest, Lisp_Object start, Lisp_Object end, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5627 const Ibyte *source, const Ibyte *source_limit, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5628 Lisp_Object item) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5629 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5630 Ibyte *destp = XSTRING_DATA (dest), *p = destp, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5631 *pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN]; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5632 Bytecount prefix_bytecount, source_len = source_limit - source; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5633 Charcount ii = 0, starting = XINT (start), ending, len; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5634 Elemcount delta; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5635 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5636 while (ii < starting && p < pend) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5637 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5638 INC_IBYTEPTR (p); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5639 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5640 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5641 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5642 pcursor = p; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5643 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5644 if (NILP (end)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5645 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5646 while (pcursor < pend) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5647 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5648 INC_IBYTEPTR (pcursor); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5649 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5650 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5651 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5652 ending = len = ii; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5653 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5654 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5655 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5656 ending = XINT (end); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5657 while (ii < ending && pcursor < pend) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5658 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5659 INC_IBYTEPTR (pcursor); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5660 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5661 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5662 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5663 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5664 if (pcursor == pend) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5665 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5666 /* We have the length, check it for our callers. */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5667 check_sequence_range (dest, start, end, make_int (ii)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5668 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5669 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5670 if (!(p == pend || p == pcursor)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5671 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5672 prefix_bytecount = p - destp; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5673 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5674 if (!NILP (item)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5675 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5676 assert (source == NULL && source_limit == NULL); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5677 source_len = set_itext_ichar (item_buf, XCHAR (item)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5678 delta = (source_len * (ending - starting)) - (pcursor - p); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5679 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5680 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5681 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5682 assert (source != NULL && source_limit != NULL); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5683 delta = source_len - (pcursor - p); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5684 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5685 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5686 if (delta) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5687 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5688 resize_string (dest, prefix_bytecount, delta); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5689 destp = XSTRING_DATA (dest); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5690 pcursor = destp + prefix_bytecount + (pcursor - p); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5691 p = destp + prefix_bytecount; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5692 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5693 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5694 if (CHARP (item)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5695 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5696 while (starting < ending) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5697 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5698 memcpy (p, item_buf, source_len); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5699 p += source_len; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5700 starting++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5701 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5702 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5703 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5704 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5705 while (starting < ending && source < source_limit) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5706 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5707 source_len = itext_copy_ichar (source, p); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5708 p += source_len, source += source_len; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5709 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5710 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5711 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5712 init_string_ascii_begin (dest); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5713 bump_string_modiff (dest); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5714 sledgehammer_check_ascii_begin (dest); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5715 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5716 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5717 return dest; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5718 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5719 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5720 DEFUN ("replace", Freplace, 2, MANY, 0, /* |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5721 Replace the elements of SEQUENCE-ONE with the elements of SEQUENCE-TWO. |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5722 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5723 SEQUENCE-ONE is destructively modified, and returned. Its length is not |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5724 changed. |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5725 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5726 Keywords :start1 and :end1 specify a subsequence of SEQUENCE-ONE, and |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5727 :start2 and :end2 a subsequence of SEQUENCE-TWO. See `search' for more |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5728 information. |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5729 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5730 arguments: (SEQUENCE-ONE SEQUENCE-TWO &key (START1 0) (END1 (length SEQUENCE-ONE)) (START2 0) (END2 (length SEQUENCE-TWO))) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5731 */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5732 (int nargs, Lisp_Object *args)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5733 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5734 Lisp_Object sequence1 = args[0], sequence2 = args[1], |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5735 result = sequence1; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5736 Elemcount starting1, ending1 = EMACS_INT_MAX, starting2; |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5737 Elemcount ending2 = EMACS_INT_MAX, counting = 0, startcounting; |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5738 Boolint sequence1_listp, sequence2_listp, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5739 overwriting = EQ (sequence1, sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5740 |
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5275
diff
changeset
|
5741 PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2), |
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5275
diff
changeset
|
5742 (start1 = start2 = Qzero)); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5743 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5744 CHECK_SEQUENCE (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5745 CHECK_LISP_WRITEABLE (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5746 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5747 CHECK_SEQUENCE (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5748 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5749 CHECK_NATNUM (start1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5750 starting1 = XINT (start1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5751 CHECK_NATNUM (start2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5752 starting2 = XINT (start2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5753 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5754 if (!NILP (end1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5755 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5756 CHECK_NATNUM (end1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5757 ending1 = XINT (end1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5758 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5759 if (!(starting1 <= ending1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5760 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5761 args_out_of_range_3 (sequence1, start1, end1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5762 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5763 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5764 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5765 if (!NILP (end2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5766 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5767 CHECK_NATNUM (end2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5768 ending2 = XINT (end2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5769 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5770 if (!(starting2 <= ending2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5771 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5772 args_out_of_range_3 (sequence1, start2, end2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5773 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5774 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5775 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5776 sequence1_listp = LISTP (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5777 sequence2_listp = LISTP (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5778 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5779 overwriting = overwriting && starting2 <= starting1; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5780 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5781 if (sequence1_listp && !ZEROP (start1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5782 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5783 sequence1 = Fnthcdr (start1, sequence1); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5784 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5785 if (NILP (sequence1)) |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5786 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5787 check_sequence_range (args[0], start1, end1, Flength (args[0])); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5788 /* Give up early here. */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5789 return result; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5790 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5791 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5792 ending1 -= starting1; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5793 starting1 = 0; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5794 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5795 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5796 if (sequence2_listp && !ZEROP (start2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5797 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5798 sequence2 = Fnthcdr (start2, sequence2); |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5799 |
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5800 if (NILP (sequence2)) |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5801 { |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5802 check_sequence_range (args[1], start1, end1, Flength (args[1])); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5803 /* Nothing available to replace sequence1's contents. */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5804 return result; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5805 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5806 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5807 ending2 -= starting2; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5808 starting2 = 0; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5809 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5810 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5811 if (overwriting) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5812 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5813 if (EQ (start1, start2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5814 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5815 return result; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5816 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5817 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5818 /* Our ranges may overlap. Save the data that might be overwritten. */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5819 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5820 if (CONSP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5821 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5822 Elemcount len = XINT (Flength (sequence2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5823 Lisp_Object *subsequence |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5824 = alloca_array (Lisp_Object, min (ending2, len)); |
5272
66dbef5f8076
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5262
diff
changeset
|
5825 Elemcount ii = 0; |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5826 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5827 LIST_LOOP_2 (elt, sequence2) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5828 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5829 if (counting == ending2) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5830 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5831 break; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5832 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5833 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5834 subsequence[ii++] = elt; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5835 counting++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5836 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5837 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5838 check_sequence_range (sequence1, start1, end1, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5839 /* The XINT (start2) is intentional here; we |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5840 called #'length after doing (nthcdr |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5841 start2 sequence2). */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5842 make_int (XINT (start2) + len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5843 check_sequence_range (sequence2, start2, end2, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5844 make_int (XINT (start2) + len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5845 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5846 while (starting1 < ending1 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5847 && starting2 < ending2 && !NILP (sequence1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5848 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5849 XSETCAR (sequence1, subsequence[starting2]); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5850 sequence1 = XCDR (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5851 starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5852 starting2++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5853 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5854 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5855 else if (STRINGP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5856 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5857 Ibyte *p = XSTRING_DATA (sequence2), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5858 *pend = p + XSTRING_LENGTH (sequence2), *pcursor, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5859 *staging; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5860 Bytecount ii = 0; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5861 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5862 while (ii < starting2 && p < pend) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5863 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5864 INC_IBYTEPTR (p); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5865 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5866 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5867 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5868 pcursor = p; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5869 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5870 while (ii < ending2 && starting1 < ending1 && pcursor < pend) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5871 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5872 INC_IBYTEPTR (pcursor); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5873 starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5874 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5875 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5876 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5877 if (pcursor == pend) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5878 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5879 check_sequence_range (sequence1, start1, end1, make_int (ii)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5880 check_sequence_range (sequence2, start2, end2, make_int (ii)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5881 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5882 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5883 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5884 assert ((pcursor - p) > 0); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5885 staging = alloca_ibytes (pcursor - p); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5886 memcpy (staging, p, pcursor - p); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5887 replace_string_range (result, start1, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5888 make_int (starting1), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5889 staging, staging + (pcursor - p)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5890 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5891 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5892 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5893 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5894 Elemcount seq_len = XINT (Flength (sequence2)), ii = 0, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5895 subseq_len = min (min (ending1 - starting1, seq_len - starting1), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5896 min (ending2 - starting2, seq_len - starting2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5897 Lisp_Object *subsequence = alloca_array (Lisp_Object, subseq_len); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5898 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5899 check_sequence_range (sequence1, start1, end1, make_int (seq_len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5900 check_sequence_range (sequence2, start2, end2, make_int (seq_len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5901 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5902 while (starting2 < ending2 && ii < seq_len) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5903 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5904 subsequence[ii] = Faref (sequence2, make_int (starting2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5905 ii++, starting2++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5906 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5907 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5908 ii = 0; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5909 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5910 while (starting1 < ending1 && ii < seq_len) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5911 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5912 Faset (sequence1, make_int (starting1), subsequence[ii]); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5913 ii++, starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5914 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5915 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5916 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5917 else if (sequence1_listp && sequence2_listp) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5918 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5919 Lisp_Object sequence1_tortoise = sequence1, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5920 sequence2_tortoise = sequence2; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5921 Elemcount shortest_len = 0; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5922 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5923 counting = startcounting = min (ending1, ending2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5924 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5925 while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5926 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5927 XSETCAR (sequence1, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5928 CONSP (sequence2) ? XCAR (sequence2) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5929 : Fcar (sequence2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5930 sequence1 = CONSP (sequence1) ? XCDR (sequence1) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5931 : Fcdr (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5932 sequence2 = CONSP (sequence2) ? XCDR (sequence2) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5933 : Fcdr (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5934 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5935 shortest_len++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5936 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5937 if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5938 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5939 if (counting & 1) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5940 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5941 sequence1_tortoise = XCDR (sequence1_tortoise); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5942 sequence2_tortoise = XCDR (sequence2_tortoise); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5943 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5944 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5945 if (EQ (sequence1, sequence1_tortoise)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5946 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5947 signal_circular_list_error (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5948 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5949 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5950 if (EQ (sequence2, sequence2_tortoise)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5951 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5952 signal_circular_list_error (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5953 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5954 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5955 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5956 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5957 if (NILP (sequence1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5958 { |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5959 check_sequence_range (args[0], start1, end1, |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5960 make_int (XINT (start1) + shortest_len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5961 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5962 else if (NILP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5963 { |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
5964 check_sequence_range (args[1], start2, end2, |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5965 make_int (XINT (start2) + shortest_len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5966 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5967 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5968 else if (sequence1_listp) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5969 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5970 if (STRINGP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5971 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5972 Ibyte *s2_data = XSTRING_DATA (sequence2), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5973 *s2_end = s2_data + XSTRING_LENGTH (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5974 Elemcount char_count = 0; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5975 Lisp_Object character; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5976 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5977 while (char_count < starting2 && s2_data < s2_end) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5978 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5979 INC_IBYTEPTR (s2_data); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5980 char_count++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5981 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5982 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5983 while (starting1 < ending1 && starting2 < ending2 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5984 && s2_data < s2_end && !NILP (sequence1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5985 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5986 character = make_char (itext_ichar (s2_data)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5987 CONSP (sequence1) ? |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5988 XSETCAR (sequence1, character) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5989 : Fsetcar (sequence1, character); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5990 sequence1 = XCDR (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5991 starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5992 starting2++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5993 char_count++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5994 INC_IBYTEPTR (s2_data); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5995 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5996 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5997 if (NILP (sequence1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5998 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
5999 check_sequence_range (sequence1, start1, end1, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6000 make_int (XINT (start1) + starting1)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6001 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6002 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6003 if (s2_data == s2_end) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6004 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6005 check_sequence_range (sequence2, start2, end2, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6006 make_int (char_count)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6007 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6008 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6009 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6010 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6011 Elemcount len2 = XINT (Flength (sequence2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6012 check_sequence_range (sequence2, start2, end2, make_int (len2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6013 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6014 ending2 = min (ending2, len2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6015 while (starting2 < ending2 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6016 && starting1 < ending1 && !NILP (sequence1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6017 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6018 CHECK_CONS (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6019 XSETCAR (sequence1, Faref (sequence2, make_int (starting2))); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6020 sequence1 = XCDR (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6021 starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6022 starting2++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6023 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6024 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6025 if (NILP (sequence1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6026 { |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
6027 check_sequence_range (args[0], start1, end1, |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6028 make_int (XINT (start1) + starting1)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6029 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6030 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6031 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6032 else if (sequence2_listp) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6033 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6034 if (STRINGP (sequence1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6035 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6036 Elemcount ii = 0, count, len = string_char_length (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6037 Ibyte *staging, *cursor; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6038 Lisp_Object obj; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6039 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6040 check_sequence_range (sequence1, start1, end1, make_int (len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6041 ending1 = min (ending1, len); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6042 count = ending1 - starting1; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6043 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6044 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6045 while (ii < count && !NILP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6046 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6047 obj = CONSP (sequence2) ? XCAR (sequence2) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6048 : Fcar (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6049 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6050 CHECK_CHAR_COERCE_INT (obj); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6051 cursor += set_itext_ichar (cursor, XCHAR (obj)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6052 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6053 sequence2 = XCDR (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6054 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6055 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6056 if (NILP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6057 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6058 check_sequence_range (sequence2, start2, end2, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6059 make_int (XINT (start2) + ii)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6060 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6061 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6062 replace_string_range (result, start1, make_int (XINT (start1) + ii), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6063 staging, cursor); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6064 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6065 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6066 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6067 Elemcount len = XINT (Flength (sequence1)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6068 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6069 check_sequence_range (sequence1, start2, end1, make_int (len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6070 ending1 = min (ending2, min (ending1, len)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6071 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6072 while (starting1 < ending1 && !NILP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6073 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6074 Faset (sequence1, make_int (starting1), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6075 CONSP (sequence2) ? XCAR (sequence2) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6076 : Fcar (sequence2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6077 sequence2 = XCDR (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6078 starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6079 starting2++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6080 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6081 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6082 if (NILP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6083 { |
5303
4c4085177ca5
Fix some bugs in fns.c, discovered in passing while doing other work.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5302
diff
changeset
|
6084 check_sequence_range (args[1], start2, end2, |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6085 make_int (XINT (start2) + starting2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6086 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6087 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6088 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6089 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6090 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6091 if (STRINGP (sequence1) && STRINGP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6092 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6093 Ibyte *p2 = XSTRING_DATA (sequence2), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6094 *p2end = p2 + XSTRING_LENGTH (sequence2), *p2cursor; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6095 Charcount ii = 0, len1 = string_char_length (sequence1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6096 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6097 while (ii < starting2 && p2 < p2end) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6098 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6099 INC_IBYTEPTR (p2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6100 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6101 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6102 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6103 p2cursor = p2; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6104 ending1 = min (ending1, len1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6105 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6106 while (ii < ending2 && starting1 < ending1 && p2cursor < p2end) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6107 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6108 INC_IBYTEPTR (p2cursor); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6109 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6110 starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6111 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6112 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6113 if (p2cursor == p2end) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6114 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6115 check_sequence_range (sequence2, start2, end2, make_int (ii)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6116 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6117 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6118 /* This isn't great; any error message won't necessarily reflect |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6119 the END1 that was supplied to #'replace. */ |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6120 replace_string_range (result, start1, make_int (starting1), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6121 p2, p2cursor); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6122 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6123 else if (STRINGP (sequence1)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6124 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6125 Ibyte *staging, *cursor; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6126 Elemcount count, len1 = string_char_length (sequence1); |
5262
75bcb5bef459
Replace a doubled semi-colon with a single semi-colon, fns.c, for VS6's sake.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5261
diff
changeset
|
6127 Elemcount len2 = XINT (Flength (sequence2)), ii = 0; |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6128 Lisp_Object obj; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6129 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6130 check_sequence_range (sequence1, start1, end1, make_int (len1)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6131 check_sequence_range (sequence2, start2, end2, make_int (len2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6132 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6133 ending1 = min (ending1, len1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6134 ending2 = min (ending2, len2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6135 count = min (ending1 - starting1, ending2 - starting2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6136 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6137 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6138 ii = 0; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6139 while (ii < count) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6140 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6141 obj = Faref (sequence2, make_int (starting2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6142 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6143 CHECK_CHAR_COERCE_INT (obj); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6144 cursor += set_itext_ichar (cursor, XCHAR (obj)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6145 starting2++, ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6146 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6147 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6148 replace_string_range (result, start1, |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6149 make_int (XINT (start1) + count), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6150 staging, cursor); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6151 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6152 else if (STRINGP (sequence2)) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6153 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6154 Ibyte *p2 = XSTRING_DATA (sequence2), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6155 *p2end = p2 + XSTRING_LENGTH (sequence2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6156 Elemcount len1 = XINT (Flength (sequence1)), ii = 0; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6157 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6158 check_sequence_range (sequence1, start1, end1, make_int (len1)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6159 ending1 = min (ending1, len1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6160 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6161 while (ii < starting2 && p2 < p2end) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6162 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6163 INC_IBYTEPTR (p2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6164 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6165 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6166 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6167 while (p2 < p2end && starting1 < ending1 && starting2 < ending2) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6168 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6169 Faset (sequence1, make_int (starting1), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6170 make_char (itext_ichar (p2))); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6171 INC_IBYTEPTR (p2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6172 starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6173 starting2++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6174 ii++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6175 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6176 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6177 if (p2 == p2end) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6178 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6179 check_sequence_range (sequence2, start2, end2, make_int (ii)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6180 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6181 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6182 else |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6183 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6184 Elemcount len1 = XINT (Flength (sequence1)), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6185 len2 = XINT (Flength (sequence2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6186 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6187 check_sequence_range (sequence1, start1, end1, make_int (len1)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6188 check_sequence_range (sequence2, start2, end2, make_int (len2)); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6189 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6190 ending1 = min (ending1, len1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6191 ending2 = min (ending2, len2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6192 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6193 while (starting1 < ending1 && starting2 < ending2) |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6194 { |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6195 Faset (sequence1, make_int (starting1), |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6196 Faref (sequence2, make_int (starting2))); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6197 starting1++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6198 starting2++; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6199 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6200 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6201 } |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6202 |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6203 return result; |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6204 } |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6205 |
771 | 6206 Lisp_Object |
2367 | 6207 add_suffix_to_symbol (Lisp_Object symbol, const Ascbyte *ascii_string) |
771 | 6208 { |
6209 return Fintern (concat2 (Fsymbol_name (symbol), | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
6210 build_ascstring (ascii_string)), |
771 | 6211 Qnil); |
6212 } | |
6213 | |
6214 Lisp_Object | |
2367 | 6215 add_prefix_to_symbol (const Ascbyte *ascii_string, Lisp_Object symbol) |
771 | 6216 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
6217 return Fintern (concat2 (build_ascstring (ascii_string), |
771 | 6218 Fsymbol_name (symbol)), |
6219 Qnil); | |
6220 } | |
6221 | |
442 | 6222 |
428 | 6223 /* #### this function doesn't belong in this file! */ |
6224 | |
442 | 6225 #ifdef HAVE_GETLOADAVG |
6226 #ifdef HAVE_SYS_LOADAVG_H | |
6227 #include <sys/loadavg.h> | |
6228 #endif | |
6229 #else | |
6230 int getloadavg (double loadavg[], int nelem); /* Defined in getloadavg.c */ | |
6231 #endif | |
6232 | |
428 | 6233 DEFUN ("load-average", Fload_average, 0, 1, 0, /* |
6234 Return list of 1 minute, 5 minute and 15 minute load averages. | |
6235 Each of the three load averages is multiplied by 100, | |
6236 then converted to integer. | |
6237 | |
6238 When USE-FLOATS is non-nil, floats will be used instead of integers. | |
6239 These floats are not multiplied by 100. | |
6240 | |
6241 If the 5-minute or 15-minute load averages are not available, return a | |
6242 shortened list, containing only those averages which are available. | |
6243 | |
6244 On some systems, this won't work due to permissions on /dev/kmem, | |
6245 in which case you can't use this. | |
6246 */ | |
6247 (use_floats)) | |
6248 { | |
6249 double load_ave[3]; | |
6250 int loads = getloadavg (load_ave, countof (load_ave)); | |
6251 Lisp_Object ret = Qnil; | |
6252 | |
6253 if (loads == -2) | |
563 | 6254 signal_error (Qunimplemented, |
6255 "load-average not implemented for this operating system", | |
6256 Qunbound); | |
428 | 6257 else if (loads < 0) |
563 | 6258 invalid_operation ("Could not get load-average", lisp_strerror (errno)); |
428 | 6259 |
6260 while (loads-- > 0) | |
6261 { | |
6262 Lisp_Object load = (NILP (use_floats) ? | |
6263 make_int ((int) (100.0 * load_ave[loads])) | |
6264 : make_float (load_ave[loads])); | |
6265 ret = Fcons (load, ret); | |
6266 } | |
6267 return ret; | |
6268 } | |
6269 | |
6270 | |
6271 Lisp_Object Vfeatures; | |
6272 | |
6273 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /* | |
6274 Return non-nil if feature FEXP is present in this Emacs. | |
6275 Use this to conditionalize execution of lisp code based on the | |
6276 presence or absence of emacs or environment extensions. | |
6277 FEXP can be a symbol, a number, or a list. | |
6278 If it is a symbol, that symbol is looked up in the `features' variable, | |
6279 and non-nil will be returned if found. | |
6280 If it is a number, the function will return non-nil if this Emacs | |
6281 has an equal or greater version number than FEXP. | |
6282 If it is a list whose car is the symbol `and', it will return | |
6283 non-nil if all the features in its cdr are non-nil. | |
6284 If it is a list whose car is the symbol `or', it will return non-nil | |
6285 if any of the features in its cdr are non-nil. | |
6286 If it is a list whose car is the symbol `not', it will return | |
6287 non-nil if the feature is not present. | |
6288 | |
6289 Examples: | |
6290 | |
6291 (featurep 'xemacs) | |
6292 => ; Non-nil on XEmacs. | |
6293 | |
6294 (featurep '(and xemacs gnus)) | |
6295 => ; Non-nil on XEmacs with Gnus loaded. | |
6296 | |
6297 (featurep '(or tty-frames (and emacs 19.30))) | |
6298 => ; Non-nil if this Emacs supports TTY frames. | |
6299 | |
6300 (featurep '(or (and xemacs 19.15) (and emacs 19.34))) | |
6301 => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later. | |
6302 | |
442 | 6303 (featurep '(and xemacs 21.02)) |
6304 => ; Non-nil on XEmacs 21.2 and later. | |
6305 | |
428 | 6306 NOTE: The advanced arguments of this function (anything other than a |
6307 symbol) are not yet supported by FSF Emacs. If you feel they are useful | |
6308 for supporting multiple Emacs variants, lobby Richard Stallman at | |
442 | 6309 <bug-gnu-emacs@gnu.org>. |
428 | 6310 */ |
6311 (fexp)) | |
6312 { | |
6313 #ifndef FEATUREP_SYNTAX | |
6314 CHECK_SYMBOL (fexp); | |
6315 return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt; | |
6316 #else /* FEATUREP_SYNTAX */ | |
6317 static double featurep_emacs_version; | |
6318 | |
6319 /* Brute force translation from Erik Naggum's lisp function. */ | |
6320 if (SYMBOLP (fexp)) | |
6321 { | |
6322 /* Original definition */ | |
6323 return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt; | |
6324 } | |
6325 else if (INTP (fexp) || FLOATP (fexp)) | |
6326 { | |
6327 double d = extract_float (fexp); | |
6328 | |
6329 if (featurep_emacs_version == 0.0) | |
6330 { | |
6331 featurep_emacs_version = XINT (Vemacs_major_version) + | |
6332 (XINT (Vemacs_minor_version) / 100.0); | |
6333 } | |
6334 return featurep_emacs_version >= d ? Qt : Qnil; | |
6335 } | |
6336 else if (CONSP (fexp)) | |
6337 { | |
6338 Lisp_Object tem = XCAR (fexp); | |
6339 if (EQ (tem, Qnot)) | |
6340 { | |
6341 Lisp_Object negate; | |
6342 | |
6343 tem = XCDR (fexp); | |
6344 negate = Fcar (tem); | |
6345 if (!NILP (tem)) | |
6346 return NILP (call1 (Qfeaturep, negate)) ? Qt : Qnil; | |
6347 else | |
6348 return Fsignal (Qinvalid_read_syntax, list1 (tem)); | |
6349 } | |
6350 else if (EQ (tem, Qand)) | |
6351 { | |
6352 tem = XCDR (fexp); | |
6353 /* Use Fcar/Fcdr for error-checking. */ | |
6354 while (!NILP (tem) && !NILP (call1 (Qfeaturep, Fcar (tem)))) | |
6355 { | |
6356 tem = Fcdr (tem); | |
6357 } | |
6358 return NILP (tem) ? Qt : Qnil; | |
6359 } | |
6360 else if (EQ (tem, Qor)) | |
6361 { | |
6362 tem = XCDR (fexp); | |
6363 /* Use Fcar/Fcdr for error-checking. */ | |
6364 while (!NILP (tem) && NILP (call1 (Qfeaturep, Fcar (tem)))) | |
6365 { | |
6366 tem = Fcdr (tem); | |
6367 } | |
6368 return NILP (tem) ? Qnil : Qt; | |
6369 } | |
6370 else | |
6371 { | |
6372 return Fsignal (Qinvalid_read_syntax, list1 (XCDR (fexp))); | |
6373 } | |
6374 } | |
6375 else | |
6376 { | |
6377 return Fsignal (Qinvalid_read_syntax, list1 (fexp)); | |
6378 } | |
6379 } | |
6380 #endif /* FEATUREP_SYNTAX */ | |
6381 | |
6382 DEFUN ("provide", Fprovide, 1, 1, 0, /* | |
6383 Announce that FEATURE is a feature of the current Emacs. | |
6384 This function updates the value of the variable `features'. | |
6385 */ | |
6386 (feature)) | |
6387 { | |
6388 Lisp_Object tem; | |
6389 CHECK_SYMBOL (feature); | |
6390 if (!NILP (Vautoload_queue)) | |
6391 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); | |
6392 tem = Fmemq (feature, Vfeatures); | |
6393 if (NILP (tem)) | |
6394 Vfeatures = Fcons (feature, Vfeatures); | |
6395 LOADHIST_ATTACH (Fcons (Qprovide, feature)); | |
6396 return feature; | |
6397 } | |
6398 | |
1067 | 6399 DEFUN ("require", Frequire, 1, 3, 0, /* |
3842 | 6400 Ensure that FEATURE is present in the Lisp environment. |
6401 FEATURE is a symbol naming a collection of resources (functions, etc). | |
6402 Optional FILENAME is a library from which to load resources; it defaults to | |
6403 the print name of FEATURE. | |
6404 Optional NOERROR, if non-nil, causes require to return nil rather than signal | |
6405 `file-error' if loading the library fails. | |
6406 | |
6407 If feature FEATURE is present in `features', update `load-history' to reflect | |
6408 the require and return FEATURE. Otherwise, try to load it from a library. | |
6409 The normal messages at start and end of loading are suppressed. | |
6410 If the library is successfully loaded and it calls `(provide FEATURE)', add | |
6411 FEATURE to `features', update `load-history' and return FEATURE. | |
6412 If the load succeeds but FEATURE is not provided by the library, signal | |
6413 `invalid-state'. | |
6414 | |
6415 The byte-compiler treats top-level calls to `require' specially, by evaluating | |
6416 them at compile time (and then compiling them normally). Thus a library may | |
6417 request that definitions that should be inlined such as macros and defsubsts | |
6418 be loaded into its compilation environment. Achieving this in other contexts | |
6419 requires an explicit \(eval-and-compile ...\) block. | |
428 | 6420 */ |
1067 | 6421 (feature, filename, noerror)) |
428 | 6422 { |
6423 Lisp_Object tem; | |
6424 CHECK_SYMBOL (feature); | |
6425 tem = Fmemq (feature, Vfeatures); | |
6426 LOADHIST_ATTACH (Fcons (Qrequire, feature)); | |
6427 if (!NILP (tem)) | |
6428 return feature; | |
6429 else | |
6430 { | |
6431 int speccount = specpdl_depth (); | |
6432 | |
6433 /* Value saved here is to be restored into Vautoload_queue */ | |
6434 record_unwind_protect (un_autoload, Vautoload_queue); | |
6435 Vautoload_queue = Qt; | |
6436 | |
1067 | 6437 tem = call4 (Qload, NILP (filename) ? Fsymbol_name (feature) : filename, |
1261 | 6438 noerror, Qrequire, Qnil); |
1067 | 6439 /* If load failed entirely, return nil. */ |
6440 if (NILP (tem)) | |
6441 return unbind_to_1 (speccount, Qnil); | |
428 | 6442 |
6443 tem = Fmemq (feature, Vfeatures); | |
6444 if (NILP (tem)) | |
563 | 6445 invalid_state ("Required feature was not provided", feature); |
428 | 6446 |
6447 /* Once loading finishes, don't undo it. */ | |
6448 Vautoload_queue = Qt; | |
771 | 6449 return unbind_to_1 (speccount, feature); |
428 | 6450 } |
6451 } | |
6452 | |
6453 /* base64 encode/decode functions. | |
6454 | |
6455 Originally based on code from GNU recode. Ported to FSF Emacs by | |
6456 Lars Magne Ingebrigtsen and Karl Heuer. Ported to XEmacs and | |
6457 subsequently heavily hacked by Hrvoje Niksic. */ | |
6458 | |
6459 #define MIME_LINE_LENGTH 72 | |
6460 | |
6461 #define IS_ASCII(Character) \ | |
6462 ((Character) < 128) | |
6463 #define IS_BASE64(Character) \ | |
6464 (IS_ASCII (Character) && base64_char_to_value[Character] >= 0) | |
6465 | |
6466 /* Table of characters coding the 64 values. */ | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
6467 static Ascbyte base64_value_to_char[64] = |
428 | 6468 { |
6469 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', /* 0- 9 */ | |
6470 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', /* 10-19 */ | |
6471 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', /* 20-29 */ | |
6472 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', /* 30-39 */ | |
6473 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', /* 40-49 */ | |
6474 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', /* 50-59 */ | |
6475 '8', '9', '+', '/' /* 60-63 */ | |
6476 }; | |
6477 | |
6478 /* Table of base64 values for first 128 characters. */ | |
6479 static short base64_char_to_value[128] = | |
6480 { | |
6481 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0- 9 */ | |
6482 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */ | |
6483 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 20- 29 */ | |
6484 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 30- 39 */ | |
6485 -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, /* 40- 49 */ | |
6486 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, /* 50- 59 */ | |
6487 -1, -1, -1, -1, -1, 0, 1, 2, 3, 4, /* 60- 69 */ | |
6488 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, /* 70- 79 */ | |
6489 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, /* 80- 89 */ | |
6490 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, /* 90- 99 */ | |
6491 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, /* 100-109 */ | |
6492 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, /* 110-119 */ | |
6493 49, 50, 51, -1, -1, -1, -1, -1 /* 120-127 */ | |
6494 }; | |
6495 | |
6496 /* The following diagram shows the logical steps by which three octets | |
6497 get transformed into four base64 characters. | |
6498 | |
6499 .--------. .--------. .--------. | |
6500 |aaaaaabb| |bbbbcccc| |ccdddddd| | |
6501 `--------' `--------' `--------' | |
6502 6 2 4 4 2 6 | |
6503 .--------+--------+--------+--------. | |
6504 |00aaaaaa|00bbbbbb|00cccccc|00dddddd| | |
6505 `--------+--------+--------+--------' | |
6506 | |
6507 .--------+--------+--------+--------. | |
6508 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| | |
6509 `--------+--------+--------+--------' | |
6510 | |
6511 The octets are divided into 6 bit chunks, which are then encoded into | |
6512 base64 characters. */ | |
6513 | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
6514 static DECLARE_DOESNT_RETURN (base64_conversion_error (const Ascbyte *, |
2268 | 6515 Lisp_Object)); |
6516 | |
575 | 6517 static DOESNT_RETURN |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
6518 base64_conversion_error (const Ascbyte *reason, Lisp_Object frob) |
563 | 6519 { |
6520 signal_error (Qbase64_conversion_error, reason, frob); | |
6521 } | |
6522 | |
6523 #define ADVANCE_INPUT(c, stream) \ | |
867 | 6524 ((ec = Lstream_get_ichar (stream)) == -1 ? 0 : \ |
563 | 6525 ((ec > 255) ? \ |
6526 (base64_conversion_error ("Non-ascii character in base64 input", \ | |
6527 make_char (ec)), 0) \ | |
867 | 6528 : (c = (Ibyte)ec), 1)) |
665 | 6529 |
6530 static Bytebpos | |
867 | 6531 base64_encode_1 (Lstream *istream, Ibyte *to, int line_break) |
428 | 6532 { |
6533 EMACS_INT counter = 0; | |
867 | 6534 Ibyte *e = to; |
6535 Ichar ec; | |
428 | 6536 unsigned int value; |
6537 | |
6538 while (1) | |
6539 { | |
1204 | 6540 Ibyte c = 0; |
428 | 6541 if (!ADVANCE_INPUT (c, istream)) |
6542 break; | |
6543 | |
6544 /* Wrap line every 76 characters. */ | |
6545 if (line_break) | |
6546 { | |
6547 if (counter < MIME_LINE_LENGTH / 4) | |
6548 counter++; | |
6549 else | |
6550 { | |
6551 *e++ = '\n'; | |
6552 counter = 1; | |
6553 } | |
6554 } | |
6555 | |
6556 /* Process first byte of a triplet. */ | |
6557 *e++ = base64_value_to_char[0x3f & c >> 2]; | |
6558 value = (0x03 & c) << 4; | |
6559 | |
6560 /* Process second byte of a triplet. */ | |
6561 if (!ADVANCE_INPUT (c, istream)) | |
6562 { | |
6563 *e++ = base64_value_to_char[value]; | |
6564 *e++ = '='; | |
6565 *e++ = '='; | |
6566 break; | |
6567 } | |
6568 | |
6569 *e++ = base64_value_to_char[value | (0x0f & c >> 4)]; | |
6570 value = (0x0f & c) << 2; | |
6571 | |
6572 /* Process third byte of a triplet. */ | |
6573 if (!ADVANCE_INPUT (c, istream)) | |
6574 { | |
6575 *e++ = base64_value_to_char[value]; | |
6576 *e++ = '='; | |
6577 break; | |
6578 } | |
6579 | |
6580 *e++ = base64_value_to_char[value | (0x03 & c >> 6)]; | |
6581 *e++ = base64_value_to_char[0x3f & c]; | |
6582 } | |
6583 | |
6584 return e - to; | |
6585 } | |
6586 #undef ADVANCE_INPUT | |
6587 | |
6588 /* Get next character from the stream, except that non-base64 | |
6589 characters are ignored. This is in accordance with rfc2045. EC | |
867 | 6590 should be an Ichar, so that it can hold -1 as the value for EOF. */ |
428 | 6591 #define ADVANCE_INPUT_IGNORE_NONBASE64(ec, stream, streampos) do { \ |
867 | 6592 ec = Lstream_get_ichar (stream); \ |
428 | 6593 ++streampos; \ |
6594 /* IS_BASE64 may not be called with negative arguments so check for \ | |
6595 EOF first. */ \ | |
6596 if (ec < 0 || IS_BASE64 (ec) || ec == '=') \ | |
6597 break; \ | |
6598 } while (1) | |
6599 | |
6600 #define STORE_BYTE(pos, val, ccnt) do { \ | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
6601 pos += set_itext_ichar (pos, (Ichar)((Binbyte)(val))); \ |
428 | 6602 ++ccnt; \ |
6603 } while (0) | |
6604 | |
665 | 6605 static Bytebpos |
867 | 6606 base64_decode_1 (Lstream *istream, Ibyte *to, Charcount *ccptr) |
428 | 6607 { |
6608 Charcount ccnt = 0; | |
867 | 6609 Ibyte *e = to; |
428 | 6610 EMACS_INT streampos = 0; |
6611 | |
6612 while (1) | |
6613 { | |
867 | 6614 Ichar ec; |
428 | 6615 unsigned long value; |
6616 | |
6617 /* Process first byte of a quadruplet. */ | |
6618 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); | |
6619 if (ec < 0) | |
6620 break; | |
6621 if (ec == '=') | |
563 | 6622 base64_conversion_error ("Illegal `=' character while decoding base64", |
6623 make_int (streampos)); | |
428 | 6624 value = base64_char_to_value[ec] << 18; |
6625 | |
6626 /* Process second byte of a quadruplet. */ | |
6627 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); | |
6628 if (ec < 0) | |
563 | 6629 base64_conversion_error ("Premature EOF while decoding base64", |
6630 Qunbound); | |
428 | 6631 if (ec == '=') |
563 | 6632 base64_conversion_error ("Illegal `=' character while decoding base64", |
6633 make_int (streampos)); | |
428 | 6634 value |= base64_char_to_value[ec] << 12; |
6635 STORE_BYTE (e, value >> 16, ccnt); | |
6636 | |
6637 /* Process third byte of a quadruplet. */ | |
6638 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); | |
6639 if (ec < 0) | |
563 | 6640 base64_conversion_error ("Premature EOF while decoding base64", |
6641 Qunbound); | |
428 | 6642 |
6643 if (ec == '=') | |
6644 { | |
6645 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); | |
6646 if (ec < 0) | |
563 | 6647 base64_conversion_error ("Premature EOF while decoding base64", |
6648 Qunbound); | |
428 | 6649 if (ec != '=') |
563 | 6650 base64_conversion_error |
6651 ("Padding `=' expected but not found while decoding base64", | |
6652 make_int (streampos)); | |
428 | 6653 continue; |
6654 } | |
6655 | |
6656 value |= base64_char_to_value[ec] << 6; | |
6657 STORE_BYTE (e, 0xff & value >> 8, ccnt); | |
6658 | |
6659 /* Process fourth byte of a quadruplet. */ | |
6660 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); | |
6661 if (ec < 0) | |
563 | 6662 base64_conversion_error ("Premature EOF while decoding base64", |
6663 Qunbound); | |
428 | 6664 if (ec == '=') |
6665 continue; | |
6666 | |
6667 value |= base64_char_to_value[ec]; | |
6668 STORE_BYTE (e, 0xff & value, ccnt); | |
6669 } | |
6670 | |
6671 *ccptr = ccnt; | |
6672 return e - to; | |
6673 } | |
6674 #undef ADVANCE_INPUT | |
6675 #undef ADVANCE_INPUT_IGNORE_NONBASE64 | |
6676 #undef STORE_BYTE | |
6677 | |
6678 DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /* | |
444 | 6679 Base64-encode the region between START and END. |
428 | 6680 Return the length of the encoded text. |
6681 Optional third argument NO-LINE-BREAK means do not break long lines | |
6682 into shorter lines. | |
6683 */ | |
444 | 6684 (start, end, no_line_break)) |
428 | 6685 { |
867 | 6686 Ibyte *encoded; |
665 | 6687 Bytebpos encoded_length; |
428 | 6688 Charcount allength, length; |
6689 struct buffer *buf = current_buffer; | |
665 | 6690 Charbpos begv, zv, old_pt = BUF_PT (buf); |
428 | 6691 Lisp_Object input; |
851 | 6692 int speccount = specpdl_depth (); |
428 | 6693 |
444 | 6694 get_buffer_range_char (buf, start, end, &begv, &zv, 0); |
428 | 6695 barf_if_buffer_read_only (buf, begv, zv); |
6696 | |
6697 /* We need to allocate enough room for encoding the text. | |
6698 We need 33 1/3% more space, plus a newline every 76 | |
6699 characters, and then we round up. */ | |
6700 length = zv - begv; | |
6701 allength = length + length/3 + 1; | |
6702 allength += allength / MIME_LINE_LENGTH + 1 + 6; | |
6703 | |
6704 input = make_lisp_buffer_input_stream (buf, begv, zv, 0); | |
867 | 6705 /* We needn't multiply allength with MAX_ICHAR_LEN because all the |
428 | 6706 base64 characters will be single-byte. */ |
867 | 6707 encoded = (Ibyte *) MALLOC_OR_ALLOCA (allength); |
428 | 6708 encoded_length = base64_encode_1 (XLSTREAM (input), encoded, |
6709 NILP (no_line_break)); | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5002
diff
changeset
|
6710 assert (encoded_length <= allength); |
428 | 6711 Lstream_delete (XLSTREAM (input)); |
6712 | |
6713 /* Now we have encoded the region, so we insert the new contents | |
6714 and delete the old. (Insert first in order to preserve markers.) */ | |
6715 buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0); | |
851 | 6716 unbind_to (speccount); |
428 | 6717 buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0); |
6718 | |
6719 /* Simulate FSF Emacs implementation of this function: if point was | |
6720 in the region, place it at the beginning. */ | |
6721 if (old_pt >= begv && old_pt < zv) | |
6722 BUF_SET_PT (buf, begv); | |
6723 | |
6724 /* We return the length of the encoded text. */ | |
6725 return make_int (encoded_length); | |
6726 } | |
6727 | |
6728 DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 2, 0, /* | |
6729 Base64 encode STRING and return the result. | |
444 | 6730 Optional argument NO-LINE-BREAK means do not break long lines |
6731 into shorter lines. | |
428 | 6732 */ |
6733 (string, no_line_break)) | |
6734 { | |
6735 Charcount allength, length; | |
665 | 6736 Bytebpos encoded_length; |
867 | 6737 Ibyte *encoded; |
428 | 6738 Lisp_Object input, result; |
6739 int speccount = specpdl_depth(); | |
6740 | |
6741 CHECK_STRING (string); | |
6742 | |
826 | 6743 length = string_char_length (string); |
428 | 6744 allength = length + length/3 + 1; |
6745 allength += allength / MIME_LINE_LENGTH + 1 + 6; | |
6746 | |
6747 input = make_lisp_string_input_stream (string, 0, -1); | |
867 | 6748 encoded = (Ibyte *) MALLOC_OR_ALLOCA (allength); |
428 | 6749 encoded_length = base64_encode_1 (XLSTREAM (input), encoded, |
6750 NILP (no_line_break)); | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5002
diff
changeset
|
6751 assert (encoded_length <= allength); |
428 | 6752 Lstream_delete (XLSTREAM (input)); |
6753 result = make_string (encoded, encoded_length); | |
851 | 6754 unbind_to (speccount); |
428 | 6755 return result; |
6756 } | |
6757 | |
6758 DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /* | |
444 | 6759 Base64-decode the region between START and END. |
428 | 6760 Return the length of the decoded text. |
6761 If the region can't be decoded, return nil and don't modify the buffer. | |
6762 Characters out of the base64 alphabet are ignored. | |
6763 */ | |
444 | 6764 (start, end)) |
428 | 6765 { |
6766 struct buffer *buf = current_buffer; | |
665 | 6767 Charbpos begv, zv, old_pt = BUF_PT (buf); |
867 | 6768 Ibyte *decoded; |
665 | 6769 Bytebpos decoded_length; |
428 | 6770 Charcount length, cc_decoded_length; |
6771 Lisp_Object input; | |
6772 int speccount = specpdl_depth(); | |
6773 | |
444 | 6774 get_buffer_range_char (buf, start, end, &begv, &zv, 0); |
428 | 6775 barf_if_buffer_read_only (buf, begv, zv); |
6776 | |
6777 length = zv - begv; | |
6778 | |
6779 input = make_lisp_buffer_input_stream (buf, begv, zv, 0); | |
6780 /* We need to allocate enough room for decoding the text. */ | |
867 | 6781 decoded = (Ibyte *) MALLOC_OR_ALLOCA (length * MAX_ICHAR_LEN); |
428 | 6782 decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length); |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5002
diff
changeset
|
6783 assert (decoded_length <= length * MAX_ICHAR_LEN); |
428 | 6784 Lstream_delete (XLSTREAM (input)); |
6785 | |
6786 /* Now we have decoded the region, so we insert the new contents | |
6787 and delete the old. (Insert first in order to preserve markers.) */ | |
6788 BUF_SET_PT (buf, begv); | |
6789 buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0); | |
851 | 6790 unbind_to (speccount); |
428 | 6791 buffer_delete_range (buf, begv + cc_decoded_length, |
6792 zv + cc_decoded_length, 0); | |
6793 | |
6794 /* Simulate FSF Emacs implementation of this function: if point was | |
6795 in the region, place it at the beginning. */ | |
6796 if (old_pt >= begv && old_pt < zv) | |
6797 BUF_SET_PT (buf, begv); | |
6798 | |
6799 return make_int (cc_decoded_length); | |
6800 } | |
6801 | |
6802 DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /* | |
6803 Base64-decode STRING and return the result. | |
6804 Characters out of the base64 alphabet are ignored. | |
6805 */ | |
6806 (string)) | |
6807 { | |
867 | 6808 Ibyte *decoded; |
665 | 6809 Bytebpos decoded_length; |
428 | 6810 Charcount length, cc_decoded_length; |
6811 Lisp_Object input, result; | |
6812 int speccount = specpdl_depth(); | |
6813 | |
6814 CHECK_STRING (string); | |
6815 | |
826 | 6816 length = string_char_length (string); |
428 | 6817 /* We need to allocate enough room for decoding the text. */ |
867 | 6818 decoded = (Ibyte *) MALLOC_OR_ALLOCA (length * MAX_ICHAR_LEN); |
428 | 6819 |
6820 input = make_lisp_string_input_stream (string, 0, -1); | |
6821 decoded_length = base64_decode_1 (XLSTREAM (input), decoded, | |
6822 &cc_decoded_length); | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5002
diff
changeset
|
6823 assert (decoded_length <= length * MAX_ICHAR_LEN); |
428 | 6824 Lstream_delete (XLSTREAM (input)); |
6825 | |
6826 result = make_string (decoded, decoded_length); | |
851 | 6827 unbind_to (speccount); |
428 | 6828 return result; |
6829 } | |
6830 | |
6831 Lisp_Object Qyes_or_no_p; | |
6832 | |
6833 void | |
6834 syms_of_fns (void) | |
6835 { | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
6836 INIT_LISP_OBJECT (bit_vector); |
442 | 6837 |
563 | 6838 DEFSYMBOL (Qstring_lessp); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6839 DEFSYMBOL (Qsort); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6840 DEFSYMBOL (Qmerge); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6841 DEFSYMBOL (Qfill); |
563 | 6842 DEFSYMBOL (Qidentity); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6843 DEFSYMBOL (Qvector); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6844 DEFSYMBOL (Qarray); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6845 DEFSYMBOL (Qstring); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6846 DEFSYMBOL (Qlist); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6847 DEFSYMBOL (Qbit_vector); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6848 defsymbol (&QsortX, "sort*"); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
6849 DEFSYMBOL (Qreduce); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6850 DEFSYMBOL (Qreplace); |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
6851 |
5253
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6852 DEFSYMBOL (Qmapconcat); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6853 defsymbol (&QmapcarX, "mapcar*"); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6854 DEFSYMBOL (Qmapvector); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6855 DEFSYMBOL (Qmapcan); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6856 DEFSYMBOL (Qmapc); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6857 DEFSYMBOL (Qmap); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6858 DEFSYMBOL (Qmap_into); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6859 DEFSYMBOL (Qsome); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6860 DEFSYMBOL (Qevery); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6861 DEFSYMBOL (Qmaplist); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6862 DEFSYMBOL (Qmapl); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6863 DEFSYMBOL (Qmapcon); |
b6a398dbb403
Fewer algorithmic complexity surprises, nicer errors, mapcarX(), maplist()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5241
diff
changeset
|
6864 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
6865 DEFKEYWORD (Q_from_end); |
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
6866 DEFKEYWORD (Q_initial_value); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6867 DEFKEYWORD (Q_start1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6868 DEFKEYWORD (Q_start2); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6869 DEFKEYWORD (Q_end1); |
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6870 DEFKEYWORD (Q_end2); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6871 |
563 | 6872 DEFSYMBOL (Qyes_or_no_p); |
6873 | |
6874 DEFERROR_STANDARD (Qbase64_conversion_error, Qconversion_error); | |
428 | 6875 |
6876 DEFSUBR (Fidentity); | |
6877 DEFSUBR (Frandom); | |
6878 DEFSUBR (Flength); | |
6879 DEFSUBR (Fsafe_length); | |
5273
799742b751c8
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5272
diff
changeset
|
6880 DEFSUBR (Flist_length); |
428 | 6881 DEFSUBR (Fstring_equal); |
801 | 6882 DEFSUBR (Fcompare_strings); |
428 | 6883 DEFSUBR (Fstring_lessp); |
6884 DEFSUBR (Fstring_modified_tick); | |
6885 DEFSUBR (Fappend); | |
6886 DEFSUBR (Fconcat); | |
6887 DEFSUBR (Fvconcat); | |
6888 DEFSUBR (Fbvconcat); | |
6889 DEFSUBR (Fcopy_list); | |
6890 DEFSUBR (Fcopy_sequence); | |
6891 DEFSUBR (Fcopy_alist); | |
6892 DEFSUBR (Fcopy_tree); | |
6893 DEFSUBR (Fsubseq); | |
6894 DEFSUBR (Fnthcdr); | |
6895 DEFSUBR (Fnth); | |
6896 DEFSUBR (Felt); | |
6897 DEFSUBR (Flast); | |
6898 DEFSUBR (Fbutlast); | |
6899 DEFSUBR (Fnbutlast); | |
6900 DEFSUBR (Fmember); | |
6901 DEFSUBR (Fold_member); | |
6902 DEFSUBR (Fmemq); | |
6903 DEFSUBR (Fold_memq); | |
6904 DEFSUBR (Fassoc); | |
6905 DEFSUBR (Fold_assoc); | |
6906 DEFSUBR (Fassq); | |
6907 DEFSUBR (Fold_assq); | |
6908 DEFSUBR (Frassoc); | |
6909 DEFSUBR (Fold_rassoc); | |
6910 DEFSUBR (Frassq); | |
6911 DEFSUBR (Fold_rassq); | |
6912 DEFSUBR (Fdelete); | |
6913 DEFSUBR (Fold_delete); | |
6914 DEFSUBR (Fdelq); | |
6915 DEFSUBR (Fold_delq); | |
6916 DEFSUBR (Fremassoc); | |
6917 DEFSUBR (Fremassq); | |
6918 DEFSUBR (Fremrassoc); | |
6919 DEFSUBR (Fremrassq); | |
6920 DEFSUBR (Fnreverse); | |
6921 DEFSUBR (Freverse); | |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6922 DEFSUBR (FsortX); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6923 Ffset (intern ("sort"), QsortX); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6924 DEFSUBR (Fmerge); |
428 | 6925 DEFSUBR (Fplists_eq); |
6926 DEFSUBR (Fplists_equal); | |
6927 DEFSUBR (Flax_plists_eq); | |
6928 DEFSUBR (Flax_plists_equal); | |
6929 DEFSUBR (Fplist_get); | |
6930 DEFSUBR (Fplist_put); | |
6931 DEFSUBR (Fplist_remprop); | |
6932 DEFSUBR (Fplist_member); | |
6933 DEFSUBR (Fcheck_valid_plist); | |
6934 DEFSUBR (Fvalid_plist_p); | |
6935 DEFSUBR (Fcanonicalize_plist); | |
6936 DEFSUBR (Flax_plist_get); | |
6937 DEFSUBR (Flax_plist_put); | |
6938 DEFSUBR (Flax_plist_remprop); | |
6939 DEFSUBR (Flax_plist_member); | |
6940 DEFSUBR (Fcanonicalize_lax_plist); | |
6941 DEFSUBR (Fdestructive_alist_to_plist); | |
6942 DEFSUBR (Fget); | |
6943 DEFSUBR (Fput); | |
6944 DEFSUBR (Fremprop); | |
6945 DEFSUBR (Fobject_plist); | |
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5253
diff
changeset
|
6946 DEFSUBR (Fobject_setplist); |
428 | 6947 DEFSUBR (Fequal); |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4797
diff
changeset
|
6948 DEFSUBR (Fequalp); |
428 | 6949 DEFSUBR (Fold_equal); |
5182
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6950 DEFSUBR (Ffill); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6951 Ffset (intern ("fillarray"), Qfill); |
2e528066e2fc
Move #'sort*, #'fill, #'merge to C from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5128
diff
changeset
|
6952 |
428 | 6953 DEFSUBR (Fnconc); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6954 DEFSUBR (FmapcarX); |
428 | 6955 DEFSUBR (Fmapvector); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6956 DEFSUBR (Fmapcan); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6957 DEFSUBR (Fmapc); |
428 | 6958 DEFSUBR (Fmapconcat); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6959 DEFSUBR (Fmap); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6960 DEFSUBR (Fmap_into); |
4997
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
6961 DEFSUBR (Fsome); |
8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4996
diff
changeset
|
6962 DEFSUBR (Fevery); |
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6963 Ffset (intern ("mapc-internal"), Fsymbol_function (intern ("mapc"))); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6964 Ffset (intern ("mapcar"), Fsymbol_function (intern ("mapcar*"))); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6965 DEFSUBR (Fmaplist); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6966 DEFSUBR (Fmapl); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6967 DEFSUBR (Fmapcon); |
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4797
diff
changeset
|
6968 |
5227
fbd1485af104
Move #'reduce to fns.c from cl-seq.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5224
diff
changeset
|
6969 DEFSUBR (Freduce); |
442 | 6970 DEFSUBR (Freplace_list); |
5261
69f687b3ba9d
Move #'replace to C, add bounds-checking to it and to #'fill.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
6971 DEFSUBR (Freplace); |
428 | 6972 DEFSUBR (Fload_average); |
6973 DEFSUBR (Ffeaturep); | |
6974 DEFSUBR (Frequire); | |
6975 DEFSUBR (Fprovide); | |
6976 DEFSUBR (Fbase64_encode_region); | |
6977 DEFSUBR (Fbase64_encode_string); | |
6978 DEFSUBR (Fbase64_decode_region); | |
6979 DEFSUBR (Fbase64_decode_string); | |
771 | 6980 |
5224
35c2b7e9c03f
Add #'substring-no-properties, omitting any extent data.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
6981 DEFSUBR (Fsubstring_no_properties); |
771 | 6982 DEFSUBR (Fsplit_string_by_char); |
6983 DEFSUBR (Fsplit_path); /* #### */ | |
6984 } | |
6985 | |
6986 void | |
6987 vars_of_fns (void) | |
6988 { | |
6989 DEFVAR_LISP ("path-separator", &Vpath_separator /* | |
6990 The directory separator in search paths, as a string. | |
6991 */ ); | |
6992 { | |
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4966
diff
changeset
|
6993 Ascbyte c = SEPCHAR; |
867 | 6994 Vpath_separator = make_string ((Ibyte *) &c, 1); |
771 | 6995 } |
428 | 6996 } |
6997 | |
6998 void | |
6999 init_provide_once (void) | |
7000 { | |
7001 DEFVAR_LISP ("features", &Vfeatures /* | |
7002 A list of symbols which are the features of the executing emacs. | |
7003 Used by `featurep' and `require', and altered by `provide'. | |
7004 */ ); | |
7005 Vfeatures = Qnil; | |
7006 | |
7007 Fprovide (intern ("base64")); | |
7008 } |