annotate src/sequence.c @ 5856:27876789edc5

Be more careful about saving a non-nil value for START in message-stack. lisp/ChangeLog addition: 2015-03-12 Aidan Kehoe <kehoea@parhasard.net> * simple.el (append-message): Be more careful about saving a non-nil value for START in message-stack.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 12 Mar 2015 00:59:27 +0000
parents e9bb3688e654
children a0e751d6c3ad
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1 /* Various functions that operate on sequences, split out from fns.c
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2 Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2010 Ben Wing.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5 This file is part of XEmacs.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7 XEmacs is free software: you can redistribute it and/or modify it
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
9 Free Software Foundation, either version 3 of the License, or (at your
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
10 option) any later version.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
11
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
15 for more details.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
16
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
19
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
20 #include <config.h>
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
21 #include "lisp.h"
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
22 #include "extents.h"
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
23
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
24 Lisp_Object Qadjoin, Qarray, QassocX, Qbit_vector, Qcar_less_than_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
25 Lisp_Object QdeleteX, Qdelete_duplicates, Qevery, Qfill, Qfind, Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
26 Lisp_Object Qintersection, Qmap, Qmap_into, Qmapc, Qmapcan, QmapcarX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
27 Lisp_Object Qmapconcat, Qmapvector, Qmerge, Qmismatch, Qnintersection;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
28 Lisp_Object Qnset_difference, Qnsubstitute, Qnunion, Qposition, QrassocX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
29 Lisp_Object Qreduce, QremoveX, Qreplace, Qset_difference, Qsome, QsortX;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
30 Lisp_Object Qstring_lessp, Qsubsetp, Qsubstitute, Qvector;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
31
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
32 Lisp_Object Q_count, Q_descend_structures, Q_end1, Q_end2, Q_from_end;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
33 Lisp_Object Q_if_, Q_if_not, Q_initial_value, Q_stable, Q_start1, Q_start2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
34 Lisp_Object Q_test_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
35
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
36 extern Fixnum max_lisp_eval_depth;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
37 extern int lisp_eval_depth;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
38
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
39 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
40
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
41 static DOESNT_RETURN
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
42 mapping_interaction_error (Lisp_Object func, Lisp_Object object)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
43 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
44 invalid_state_2 ("object modified while traversing it", func, object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
45 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
46
5772
cd4f5f1f1f4c Add #'write-sequence, on the model of #'write-char, API from Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5752
diff changeset
47 void
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
48 check_sequence_range (Lisp_Object sequence, Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
49 Lisp_Object end, Lisp_Object length)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
50 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
51 Lisp_Object args[] = { Qzero, start, NILP (end) ? length : end, length };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
52
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
53 if (NILP (Fleq (countof (args), args)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
54 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
55 args_out_of_range_3 (sequence, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
56 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
57 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
58
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
59 DEFUN ("length", Flength, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
60 Return the length of vector, bit vector, list or string SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
61 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
62 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
63 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
64 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
65 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
66 return make_fixnum (string_char_length (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
67 else if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
68 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
69 Elemcount len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
70 GET_EXTERNAL_LIST_LENGTH (sequence, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
71 return make_fixnum (len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
72 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
73 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
74 return make_fixnum (XVECTOR_LENGTH (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
75 else if (NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
76 return Qzero;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
77 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
78 return make_fixnum (bit_vector_length (XBIT_VECTOR (sequence)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
79 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
80 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
81 check_losing_bytecode ("length", sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
82 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
83 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
84 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
85 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
86
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
87 /* Various test functions for #'member*, #'assoc* and the other functions
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
88 that take both TEST and KEY arguments. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
89
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
90 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
91 check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
92 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
93 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
94 return EQ (item, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
95 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
96
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
97 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
98 check_eq_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
99 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
101 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
102 return EQ (item, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
105 /* The next two are not used by #'member* and #'assoc*, since we can decide
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
106 on #'eq vs. #'equal when we have the type of ITEM. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
107 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
108 check_eql_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
109 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
111 return EQ (elt1, elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
112 || (NON_FIXNUM_NUMBER_P (elt1) && internal_equal (elt1, elt2, 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
113 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
114
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
115 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
116 check_eql_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
117 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
119 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
120 return EQ (item, elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
121 || (NON_FIXNUM_NUMBER_P (item) && internal_equal (item, elt, 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
122 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
123
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
124 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
125 check_equal_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
126 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
127 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
128 return internal_equal (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
129 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
130
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
131 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
132 check_equal_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
133 Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
135 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
136 return internal_equal (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
137 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
138
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
139 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
140 check_equalp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
141 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
142 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
143 return internal_equalp (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
144 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
145
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
146 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
147 check_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
148 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
149 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
150 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
151 return internal_equalp (item, elt, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
153
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
154 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
155 check_string_match_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
156 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
158 return !NILP (Fstring_match (item, elt, Qnil, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
159 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
160
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
161 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
162 check_string_match_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
163 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
164 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
165 elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
166 return !NILP (Fstring_match (item, elt, Qnil, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
168
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
169 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
170 check_other_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
171 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
172 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
173 Lisp_Object args[] = { test, item, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
174 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
175
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
176 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
177 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
178 item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
179 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
181 return !NILP (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
182 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
183
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
184 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
185 check_other_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
186 Lisp_Object item, Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
187 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
188 Lisp_Object args[] = { item, key, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
189 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
190
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
191 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
192 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
193 args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args) - 1, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
194 args[1] = item;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
195 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
196 item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
197 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
199 return !NILP (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
202 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
203 check_if_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
204 Lisp_Object UNUSED (item), Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
205 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
206 elt = IGNORE_MULTIPLE_VALUES (call1 (test, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
207 return !NILP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
208 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
209
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
210 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
211 check_if_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
212 Lisp_Object UNUSED (item), Lisp_Object elt)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
213 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
214 Lisp_Object args[] = { key, elt };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
215 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
216
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
217 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
218 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
219 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
220 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
221 elt = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
222 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
223
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
224 return !NILP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
225 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
227 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
228 check_match_eq_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
229 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
230 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
231 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
232 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
234 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
235 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
236 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
237 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
238 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
239 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
240
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
241 return EQ (args[0], args[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
242 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
243
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
244 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
245 check_match_eql_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
246 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
248 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
249 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
250
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
251 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
252 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
253 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
254 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
255 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
256 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
257
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
258 return EQ (args[0], args[1]) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
259 (NON_FIXNUM_NUMBER_P (args[0]) && internal_equal (args[0], args[1], 0));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
262 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
263 check_match_equal_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
264 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
266 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
267 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
269 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
270 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
271 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
272 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
273 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
274 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
276 return internal_equal (args[0], args[1], 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
277 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
278
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
279 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
280 check_match_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
281 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
283 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
284 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
285
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
286 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
287 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
288 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
289 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
290 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
291 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
293 return internal_equalp (args[0], args[1], 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
294 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
295
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
296 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
297 check_match_other_key (Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
298 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
300 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
301 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
302
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
303 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
304 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
305 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
306 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
307 args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
308 args[1] = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
309 args[0] = test;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
310
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
311 elt1 = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
312 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
314 return !NILP (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
316
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
317 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
318 check_lss_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
319 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
320 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
321 return bytecode_arithcompare (elt1, elt2) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
324 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
325 check_lss_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
326 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
327 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
328 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
329 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
331 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
332 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
333 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
334 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
335 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
336 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
337
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
338 return bytecode_arithcompare (args[0], args[1]) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
339 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
340
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
341 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
342 check_lss_key_car (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
343 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
344 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
345 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
346
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
347 GCPRO2 (elt1, elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
348 elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
349 elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
350 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
351
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
352 return bytecode_arithcompare (elt1, elt2) < 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
353 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
354
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
355 Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
356 check_string_lessp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
357 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
359 return !NILP (Fstring_lessp (elt1, elt2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
360 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
362 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
363 check_string_lessp_key (Lisp_Object UNUSED (test), Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
364 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
365 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
366 Lisp_Object args[] = { key, elt1, elt2 };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
367 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
369 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
370 gcpro1.nvars = countof (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
371 args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
372 args[1] = key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
373 args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
374 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
376 return !NILP (Fstring_lessp (args[0], args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
377 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
378
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
379 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
380 check_string_lessp_key_car (Lisp_Object UNUSED (test),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
381 Lisp_Object UNUSED (key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
382 Lisp_Object elt1, Lisp_Object elt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
384 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
386 GCPRO2 (elt1, elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
387 elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
388 elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
389 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
391 return !NILP (Fstring_lessp (elt1, elt2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
394 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
395 get_check_match_function_1 (Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
396 Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
397 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
398 Lisp_Object key, Boolint *test_not_unboundp_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
399 check_test_func_t *test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
401 Lisp_Object test = *test_inout;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
402 check_test_func_t result = NULL, test_func = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
403 Boolint force_if = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
405 if (!NILP (if_))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
406 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
407 if (!(NILP (test) && NILP (test_not) && NILP (if_not)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
408 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
409 invalid_argument ("only one keyword among :test :test-not "
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
410 ":if :if-not allowed", if_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
411 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
412
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
413 test = *test_inout = if_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
414 force_if = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
416 else if (!NILP (if_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
417 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
418 if (!(NILP (test) && NILP (test_not)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
419 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
420 invalid_argument ("only one keyword among :test :test-not "
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
421 ":if :if-not allowed", if_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
422 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
423
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
424 test_not = if_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
425 force_if = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
426 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
427
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
428 if (NILP (test))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
429 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
430 if (!NILP (test_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
431 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
432 test = *test_inout = test_not;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
433 if (NULL != test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
435 *test_not_unboundp_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
436 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
437 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
438 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
439 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
440 test = Qeql;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
441 if (NULL != test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
443 *test_not_unboundp_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
444 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
445 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
446 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
447 else if (!NILP (test_not))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
448 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
449 invalid_argument_2 ("conflicting :test and :test-not keyword arguments",
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
450 test, test_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
452
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
453 test = indirect_function (test, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
455 if (NILP (key) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
456 EQ (indirect_function (key, 1), XSYMBOL_FUNCTION (Qidentity)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
458 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
461 if (force_if)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
462 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
463 result = EQ (key, Qidentity) ? check_if_nokey : check_if_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
465 if (NULL != test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
466 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
467 *test_func_out = result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
468 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
470 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
473 if (!UNBOUNDP (item) && EQ (test, XSYMBOL_FUNCTION (Qeql)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
474 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
475 test = XSYMBOL_FUNCTION (NON_FIXNUM_NUMBER_P (item) ? Qequal : Qeq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
476 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
477
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
478 #define FROB(known_test, eq_condition) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
479 if (EQ (test, XSYMBOL_FUNCTION (Q##known_test))) do \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
480 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
481 if (eq_condition) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
482 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
483 test = XSYMBOL_FUNCTION (Qeq); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
484 goto force_eq_check; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
485 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
486 \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
487 if (!EQ (Qidentity, key)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
488 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
489 test_func = check_##known_test##_key; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
490 result = check_match_##known_test##_key; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
491 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
492 else \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
493 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
494 result = test_func = check_##known_test##_nokey; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
495 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
496 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
498 FROB (eql, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
499 else if (SUBRP (test))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
500 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
501 force_eq_check:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
502 FROB (eq, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
503 else FROB (equal, (SYMBOLP (item) || FIXNUMP (item) || CHARP (item)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
504 else FROB (equalp, (SYMBOLP (item)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
505 else if (EQ (test, XSYMBOL_FUNCTION (Qstring_match)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
506 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
507 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
508 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
509 test_func = result = check_string_match_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
511 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
512 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
513 test_func = check_string_match_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
514 result = check_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
515 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
517 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
519 if (NULL == result)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
521 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
522 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
523 test_func = result = check_other_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
524 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
525 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
526 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
527 test_func = check_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
528 result = check_match_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
529 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
530 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
532 if (NULL != test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
533 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
534 *test_func_out = test_func;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
535 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
537 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
538 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
539 #undef FROB
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
541 /* Given TEST, TEST_NOT, IF, IF_NOT, KEY, and ITEM, return a C function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
542 pointer appropriate for use in deciding whether a given element of a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
543 sequence satisfies TEST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
545 Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
546 if it was bound, and set *test_inout to the value it was bound to. If
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
547 TEST was not bound, leave *test_inout alone; the value is not used by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
548 check_eq_*key() or check_equal_*key(), which are the defaults, depending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
549 on the type of ITEM.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
550
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
551 The returned function takes arguments (TEST, KEY, ITEM, ELT), where ITEM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
552 is the item being searched for and ELT is the element of the sequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
553 being examined.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
554
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
555 Error if both TEST and TEST_NOT were specified, which Common Lisp says is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
556 undefined behaviour. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
558 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
559 get_check_test_function (Lisp_Object item,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
560 Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
561 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
562 Lisp_Object key, Boolint *test_not_unboundp_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
563 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
564 check_test_func_t result = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
565 get_check_match_function_1 (item, test_inout, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
566 key, test_not_unboundp_out, &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
567 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
568 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
569
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
570 /* Given TEST, TEST_NOT, IF, IF_NOT and KEY, return a C function pointer
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
571 appropriate for use in deciding whether two given elements of a sequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
572 satisfy TEST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
574 Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
575 if it was bound, and set *test_inout to the value it was bound to. If
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
576 TEST was not bound, leave *test_inout alone; the value is not used by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
577 check_eql_*key().
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
578
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
579 The returned function takes arguments (TEST, KEY, ELT1, ELT2), where ELT1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
580 and ELT2 are elements of the sequence being examined.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
582 The value that would be given by get_check_test_function() is returned in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
583 *TEST_FUNC_OUT, which allows calling functions to do their own key checks
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
584 if they're processing one element at a time.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
585
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
586 Error if both TEST and TEST_NOT were specified, which Common Lisp says is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
587 undefined behaviour. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
589 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
590 get_check_match_function (Lisp_Object *test_inout, Lisp_Object test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
591 Lisp_Object if_, Lisp_Object if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
592 Lisp_Object key, Boolint *test_not_unboundp_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
593 check_test_func_t *test_func_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
594 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
595 return get_check_match_function_1 (Qunbound, test_inout, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
596 if_, if_not, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
597 test_not_unboundp_out, test_func_out);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
599
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
600 /* Given PREDICATE and KEY, return a C function pointer appropriate for use
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
601 in deciding whether one given element of a sequence is less than
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
602 another. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
604 static check_test_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
605 get_merge_predicate (Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
606 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
607 predicate = indirect_function (predicate, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
608
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
609 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
610 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
611 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
612 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
613 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
614 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
615 key = indirect_function (key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
616 if (EQ (key, XSYMBOL_FUNCTION (Qidentity)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
617 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
618 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
619 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
620 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
621
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
622 if (EQ (key, Qidentity) && EQ (predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
623 XSYMBOL_FUNCTION (Qcar_less_than_car)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
624 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
625 key = XSYMBOL_FUNCTION (Qcar);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
626 predicate = XSYMBOL_FUNCTION (Qlss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
627 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
628
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
629 if (EQ (predicate, XSYMBOL_FUNCTION (Qlss)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
631 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
633 return check_lss_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
634 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
635
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
636 if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
637 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
638 return check_lss_key_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
640
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
641 return check_lss_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
643
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
644 if (EQ (predicate, XSYMBOL_FUNCTION (Qstring_lessp)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
645 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
646 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
647 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
648 return check_string_lessp_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
649 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
651 if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
653 return check_string_lessp_key_car;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
655
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
656 return check_string_lessp_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
657 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
658
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
659 if (EQ (key, Qidentity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
661 return check_other_nokey;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
664 return check_match_other_key;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
666
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
667
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
668 static Lisp_Object string_count_from_end (Lisp_Object, Lisp_Object ,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
669 check_test_func_t, Boolint,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
670 Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
671 Lisp_Object, Lisp_Object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
672
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
673 static Lisp_Object list_count_from_end (Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
674 check_test_func_t, Boolint,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
675 Lisp_Object, Lisp_Object,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
676 Lisp_Object, Lisp_Object);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
677
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
678 /* Count the number of occurrences of ITEM in SEQUENCE; if SEQUENCE is a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
679 list, store the cons cell of which the car is the last ITEM in SEQUENCE,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
680 at the address given by tail_out. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
682 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
683 count_with_tail (Lisp_Object *tail_out, int nargs, Lisp_Object *args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
684 Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
686 Lisp_Object item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
687 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
688 Elemcount len, ii = 0, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
689 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
690 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
692 PARSE_KEYWORDS_8 (caller, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
693 (test, key, start, end, from_end, test_not, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
694 if_, if_not), (start = Qzero), 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
696 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
697 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
698 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
700 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
701 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
702 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
703 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
706 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
707 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
708 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
709 counting = BIGNUMP (count) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
711 /* Our callers should have filtered out non-positive COUNT. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
712 assert (counting >= 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
713 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
714
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
715 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
716 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
718 *tail_out = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
719
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
720 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
721 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
722 if (EQ (caller, Qcount) && !NILP (from_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
723 && (!EQ (key, Qnil) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
724 check_test == check_other_nokey || check_test == check_if_nokey))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
725 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
726 /* #'count, #'count-if, and #'count-if-not are documented to have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
727 a given traversal order if :from-end t is passed in, even
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
728 though forward traversal of the sequence has the same result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
729 and is algorithmically less expensive for lists and strings.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
730 This order isn't necessary for other callers, though. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
731 return list_count_from_end (item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
732 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
733 start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
734 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
735
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
736 /* If COUNT is non-nil and FROM-END is t, we can give the tail
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
737 containing the last match, since that's what #'remove* is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
738 interested in (a zero or negative COUNT won't ever reach
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
739 count_with_tail(), our callers will return immediately on seeing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
740 it). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
741 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
742 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
743 counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
746 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
747 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
748 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
749 if (!(ii < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
750 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
751 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
752 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
754 if (starting <= ii &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
755 check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
756 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
757 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
758 *tail_out = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
760 if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
761 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
762 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
763 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
764 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
765
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
766 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
767 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
768 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
769 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
770
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
771 if ((ii < starting || (ii < ending && !NILP (end))) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
772 encountered != counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
773 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
774 check_sequence_range (args[1], start, end, Flength (args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
775 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
776 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
777 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
778 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
779 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
780 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
781 Lisp_Object character = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
782
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
783 if (EQ (caller, Qcount) && !NILP (from_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
784 && (!EQ (key, Qnil) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
785 check_test == check_other_nokey || check_test == check_if_nokey))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
786 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
787 /* See comment above in the list code. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
788 return string_count_from_end (item, sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
789 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
790 test, key, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
791 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
792
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
793 while (cursor_offset < byte_len && ii < ending && encountered < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
794 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
795 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
796 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
797 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
798
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
799 if (check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
800 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
801 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
802 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
804
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
805 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
806 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
807 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
808 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
809 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
810 mapping_interaction_error (caller, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
811 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
812 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
813
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
814 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
815 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
816 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
817 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
819 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
820 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
821 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
822 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
823 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
824 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
825 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
826 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
827
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
828 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
829 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
831 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
832 if (0 == len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
833 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
834 /* Catches the case where we have nil. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
835 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
837
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
838 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
839 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
840 for (ii = starting; ii < ending && encountered < counting; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
841 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
842 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
843 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
845 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
847 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
848 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
849 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
850 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
851 for (ii = ending - 1; ii >= starting && encountered < counting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
852 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
853 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
854 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
855 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
856 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
857 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
858 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
859 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
860 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
861
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
862 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
863 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
864
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
865 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
866 list_count_from_end (Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
867 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
868 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
869 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
870 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
871 Elemcount length = XFIXNUM (Flength (sequence)), ii = 0, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
872 Elemcount ending = NILP (end) ? length : XFIXNUM (end), encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
873 Lisp_Object *storage;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
874 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
875
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
876 check_sequence_range (sequence, start, end, make_integer (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
877
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
878 storage = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
879
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
881 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
882 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
883 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
884 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
885 storage[ii - starting] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
886 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
887 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
889 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
890
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
891 GCPRO1 (storage[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
892 gcpro1.nvars = ending - starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
893
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
894 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
895 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
896 if (check_test (test, key, item, storage[ii - starting])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
897 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
898 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
899 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
900 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
901 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
902
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
903 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
905 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
906 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
908 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
909 string_count_from_end (Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
910 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
911 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
912 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
913 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
914 Elemcount length = string_char_length (sequence), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
915 Elemcount starting = XFIXNUM (start), ending = NILP (end) ? length : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
916 Elemcount encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
917 Ibyte *cursor = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
918 Ibyte *endp = cursor + XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
919 Ichar *storage;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
920
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
921 check_sequence_range (sequence, start, end, make_integer (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
922
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
923 storage = alloca_array (Ichar, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
924
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
925 while (cursor < endp && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
926 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
927 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
928 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
929 storage [ii - starting] = itext_ichar (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
930 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
931
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
932 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
933 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
934 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
935
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
936 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
937 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
938 if (check_test (test, key, item, make_char (storage [ii - starting]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
939 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
941 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
942 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
943 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
944
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
945 return make_integer (encountered);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
946 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
947
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
948 DEFUN ("count", Fcount, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
949 Count the number of occurrences of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
951 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
952
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
953 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
954 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
955 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
956 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
957 Lisp_Object tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
958
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
959 /* count_with_tail() accepts more keywords than we do, check those we've
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
960 been given. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
961 PARSE_KEYWORDS (Fcount, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
962 (test, test_not, if_, if_not, key, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
963 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
964
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
965 return count_with_tail (&tail, nargs, args, Qcount);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
966 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
967
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
968 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
969 Return the subsequence of SEQUENCE starting at START and ending before END.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
970 END may be omitted; then the subsequence runs to the end of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
972 If START or END is negative, it counts from the end, in contravention of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
973 Common Lisp.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
974 The returned subsequence is always of the same type as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
975 If SEQUENCE is a string, relevant parts of the string-extent-data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
976 are copied to the new string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
977
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
978 See also `substring-no-properties', which only operates on strings, and does
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
979 not copy extent data.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
980 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
981 (sequence, start, end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
982 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
983 Elemcount len, ss, ee = MOST_POSITIVE_FIXNUM, ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
984 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
985
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
986 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
987 CHECK_FIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
988 ss = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
989
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
990 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
991 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
992 CHECK_FIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
993 ee = XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
994 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
995
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
996 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
998 Bytecount bstart, blen;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
999
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1000 get_string_range_char (sequence, start, end, &ss, &ee,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1001 GB_HISTORICAL_STRING_BEHAVIOR);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1002 bstart = string_index_char_to_byte (sequence, ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1003 blen = string_offset_char_to_byte_len (sequence, bstart, ee - ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1004
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1005 result = make_string (XSTRING_DATA (sequence) + bstart, blen);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1006 /* Copy any applicable extent information into the new string. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1007 copy_string_extents (result, sequence, 0, bstart, blen);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1008 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1009 else if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1010 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1011 Lisp_Object result_tail, saved = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1013 if (ss < 0 || ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1014 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1015 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1016 if (ss < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1017 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1018 ss = len + ss;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1019 start = make_integer (ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1020 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1021
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1022 if (ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1023 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1024 ee = len + ee;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1025 end = make_integer (ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1026 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1027 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1028 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1029 ee = min (ee, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1030 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1031 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1032
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1033 if (0 != ss)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1034 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1035 sequence = Fnthcdr (make_fixnum (ss), sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1036 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1037
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1038 ii = ss + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1039
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1040 if (ss < ee && !NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1041 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1042 result = result_tail = Fcons (Fcar (sequence), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1043 sequence = Fcdr (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1044
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1045 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1046 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1047 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1048 if (!(ii < ee))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1049 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1050 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1051 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1052
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1053 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1054 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1055 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1056 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1057 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1058 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1059
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1060 if (NILP (result) || (ii < ee && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1061 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1062 /* We were handed a cons, which definitely has elements. nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1063 result means either ss >= ee or SEQUENCE was nil after the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1064 nthcdr; in both cases that means START and END were incorrectly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1065 specified for this sequence. ii < ee with a non-nil end means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1066 the user handed us a bogus end value. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1067 check_sequence_range (saved, start, end, Flength (saved));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1068 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1070 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1071 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1072 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1073 if (ss < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1074 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1075 ss = len + ss;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1076 start = make_integer (ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1077 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1078
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1079 if (ee < 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1080 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1081 ee = len + ee;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1082 end = make_integer (ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1083 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1084 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1085 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1086 ee = min (len, ee);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1087 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1088
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1089 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1090
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1091 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1092 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1093 result = Fvector (ee - ss, XVECTOR_DATA (sequence) + ss);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1094 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1095 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1096 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1097 result = make_bit_vector (ee - ss, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1098
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1099 for (ii = ss; ii < ee; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1101 set_bit_vector_bit (XBIT_VECTOR (result), ii - ss,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1102 bit_vector_bit (XBIT_VECTOR (sequence), ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1104 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1105 else if (NILP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1106 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1107 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1108 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1109 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1111 /* Won't happen, since CHECK_SEQUENCE didn't error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1112 ABORT ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1113 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1114 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1116 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1117 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1118
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1119 DEFUN ("elt", Felt, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1120 Return element of SEQUENCE at index N.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1121 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1122 (sequence, n))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1123 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1124 /* This function can GC */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1125 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1126 CHECK_FIXNUM_COERCE_CHAR (n); /* yuck! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1127 if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1128 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1129 Lisp_Object tem = Fnthcdr (n, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1130 /* #### Utterly, completely, fucking disgusting.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1131 * #### The whole point of "elt" is that it operates on
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1132 * #### sequences, and does error- (bounds-) checking.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1133 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1134 if (CONSP (tem))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1135 return XCAR (tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1136 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1137 #if 1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1138 /* This is The Way It Has Always Been. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1139 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1140 #else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1141 /* This is The Way Mly and Cltl2 say It Should Be. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1142 args_out_of_range (sequence, n);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1143 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1144 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1145 else if (STRINGP (sequence) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1146 VECTORP (sequence) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1147 BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1148 return Faref (sequence, n);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1149 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1150 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1151 check_losing_bytecode ("elt", sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1152 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1153 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1155 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1156
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1157 DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1158 Return a copy of a list and substructures.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1159 The argument is copied, and any lists contained within it are copied
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1160 recursively. Circularities and shared substructures are not preserved.
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1161 Second arg VECTORP causes vectors to be copied, too. Strings and bit
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1162 vectors are not copied.
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1163 */
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1164 (arg, vectorp))
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1165 {
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
1166 return safe_copy_tree (arg, vectorp, 0);
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1168
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1169 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1170 safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1172 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1173 stack_overflow ("Stack overflow in copy-tree", arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1174
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1175 if (CONSP (arg))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1176 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1177 Lisp_Object rest;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1178 rest = arg = Fcopy_sequence (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1179 while (CONSP (rest))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1180 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1181 Lisp_Object elt = XCAR (rest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1182 QUIT;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1183 if (CONSP (elt) || VECTORP (elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1184 XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1185 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1186 XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1187 rest = XCDR (rest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1188 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1189 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1190 else if (VECTORP (arg) && ! NILP (vecp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1191 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1192 int i = XVECTOR_LENGTH (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1193 int j;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1194 arg = Fcopy_sequence (arg);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1195 for (j = 0; j < i; j++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1196 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1197 Lisp_Object elt = XVECTOR_DATA (arg) [j];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1198 QUIT;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1199 if (CONSP (elt) || VECTORP (elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1200 XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1201 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1202 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1203 return arg;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1204 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1206 DEFUN ("member", Fmember, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1207 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1208 The value is actually the tail of LIST whose car is ELT.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1209 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1210 (elt, list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1211 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1212 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1213 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1214 if (internal_equal (elt, list_elt, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1215 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1216 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1217 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1218 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1219
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1220 DEFUN ("memq", Fmemq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1221 Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1222 The value is actually the tail of LIST whose car is ELT.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1223 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1224 (elt, list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1225 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1226 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1227 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1228 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1229 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1230 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1231 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1232 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1234 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1235 memq_no_quit (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1236 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1237 LIST_LOOP_3 (list_elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1238 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1239 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1240 return tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1241 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1242 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1243 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1244
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1245 /* Return the first index of ITEM in LIST. In CONS_OUT, return the cons cell
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1246 before that containing the element. If the element is in the first cons
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1247 cell, return Qnil in CONS_OUT. TEST, KEY, START, END are as in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1248 #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should have been initialized
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1249 with get_check_match_function() or get_check_test_function(). A non-zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1250 REVERSE_TEST_ORDER means call TEST with the element from LIST as its
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1251 first argument and ITEM as its second. Error if LIST is ill-formed, or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1252 circular. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1253 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1254 list_position_cons_before (Lisp_Object *cons_out,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1255 Lisp_Object item, Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1256 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1257 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1258 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1259 Boolint reverse_test_order,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1260 Lisp_Object start, Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1261 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1262 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1263 Lisp_Object tail_before = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1264 Elemcount ii = 0, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1265 Elemcount ending = NILP (end) ? MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1266
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1267 GCPRO1 (tail_before);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1269 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1270 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1271 /* TEST is #'eq, no need to call any C functions, and the test order
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1272 won't be visible. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1273 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1274 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1275 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1276 EQ (item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1278 *cons_out = tail_before;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1279 RETURN_UNGCPRO (make_integer (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1280 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1281 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1283 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1284 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1285 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1286 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1287 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1288 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1289 tail_before = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1290 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1291 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1292 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1293 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1294 GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1295 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1296 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1297 (reverse_test_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1298 check_test (test, key, elt, item) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1299 check_test (test, key, item, elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1300 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1301 *cons_out = tail_before;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1302 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1303 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1304 return make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1305 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1306 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1307 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1308 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1309 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1310 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1311 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1312 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1313 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1314 tail_before = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1316 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1317 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1318
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1319 RETURN_UNGCPRO (Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1320 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1321
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1322 DEFUN ("member*", FmemberX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1323 Return the first sublist of LIST with car ITEM, or nil if no such sublist.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1324
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1325 The keyword :test specifies a two-argument function that is used to compare
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1326 ITEM with elements in LIST; if omitted, it defaults to `eql'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1327
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1328 The keyword :test-not is similar, but specifies a negated function. That
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1329 is, ITEM is considered equal to an element in LIST if the given function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1330 returns nil. Common Lisp deprecates :test-not, and if both are specified,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1331 XEmacs signals an error.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1332
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1333 :key specifies a one-argument function that transforms elements of LIST into
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1334 \"comparison keys\" before the test predicate is applied. For example,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1335 if :key is #'car, then ITEM is compared with the car of elements from LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1336 The :key function, however, is not applied to ITEM, and does not affect the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1337 elements in the returned list, which are taken directly from the elements in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1338 LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1339
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1340 arguments: (ITEM LIST &key (TEST #'eql) TEST-NOT (KEY #'identity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1341 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1342 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1343 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1344 Lisp_Object item = args[0], list = args[1], result = Qnil, position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1345 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1346 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1347
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1348 PARSE_KEYWORDS (FmemberX, nargs, args, 5, (test, if_not, if_, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1349 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1350 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1351 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1352 position0
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1353 = list_position_cons_before (&result, item, list, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1354 test_not_unboundp, test, key, 0, Qzero, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1355
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1356 return CONSP (result) ? XCDR (result) : ZEROP (position0) ? list : Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1357 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1358
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1359 /* This macro might eventually find a better home than here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1360
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1361 #define CHECK_KEY_ARGUMENT(key) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1362 do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1363 if (NILP (key)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1364 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1365 key = Qidentity; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1366 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1367 \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1368 if (!EQ (key, Qidentity)) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1369 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1370 key = indirect_function (key, 1); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1371 if (EQ (key, XSYMBOL_FUNCTION (Qidentity))) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1372 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1373 key = Qidentity; \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1374 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1375 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1376 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1377
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1378 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1379 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1380
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1381 DEFUN ("adjoin", Fadjoin, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1382 Return ITEM consed onto the front of LIST, if not already in LIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1383
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1384 Otherwise, return LIST unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1386 See `member*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1387
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1388 arguments: (ITEM LIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1389 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1390 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1391 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1392 Lisp_Object item = args[0], list = args[1], keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1393 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1394 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1395 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1396
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1397 PARSE_KEYWORDS (Fadjoin, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1398 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1399
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1400 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1401
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1402 keyed = KEY (key, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1403
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1404 GCPRO1 (keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1405 check_test = get_check_test_function (keyed, &test, test_not, Qnil, Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1406 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1407 if (NILP (list_position_cons_before (&ignore, keyed, list, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1408 test_not_unboundp, test, key, 0, Qzero,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1409 Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1410 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1411 RETURN_UNGCPRO (Fcons (item, list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1412 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1413
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1414 RETURN_UNGCPRO (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1417 DEFUN ("assoc", Fassoc, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1418 Return non-nil if KEY is `equal' to the car of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1419 The value is actually the element of ALIST whose car equals KEY.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1420 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1421 (key, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1422 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1423 /* This function can GC. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1424 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1425 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1426 if (internal_equal (key, elt_car, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1427 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1428 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1429 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1430 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1431
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1432 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1433 assoc_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1435 int speccount = specpdl_depth ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1436 specbind (Qinhibit_quit, Qt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1437 return unbind_to_1 (speccount, Fassoc (key, alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1438 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1439
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1440 DEFUN ("assq", Fassq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1441 Return non-nil if KEY is `eq' to the car of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1442 The value is actually the element of ALIST whose car is KEY.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1443 Elements of ALIST that are not conses are ignored.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1444 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1445 (key, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1446 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1447 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1448 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1449 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1450 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1452 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1453 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1455 /* Like Fassq but never report an error and do not allow quits.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1456 Use only on lists known never to be circular. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1458 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1459 assq_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1460 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1461 /* This cannot GC. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1462 LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1463 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1464 Lisp_Object elt_car = XCAR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1465 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1466 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1467 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1468 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1469 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1470
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1471 DEFUN ("assoc*", FassocX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1472 Find the first item whose car matches ITEM in ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1473
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1474 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1475
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1476 arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1477 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1478 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1479 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1480 Lisp_Object item = args[0], alist = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1481 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1482 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1484 PARSE_KEYWORDS (FassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1485 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1486
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1487 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1488 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1489
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1490 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1491 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1492 /* TEST is #'eq, no need to call any C functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1493 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1494 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1495 if (EQ (item, elt_car) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1496 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1497 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1498 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1500 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1501 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1502 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1503 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1504 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1505 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1506 check_test (test, key, item, XCAR (elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1507 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1508 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1509 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1511 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1512 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1513 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1514
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1515 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1518 DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1519 Return non-nil if VALUE is `equal' to the cdr of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1520 The value is actually the element of ALIST whose cdr equals VALUE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1521 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1522 (value, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1523 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1524 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1525 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1526 if (internal_equal (value, elt_cdr, 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1527 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1528 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1529 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1530 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1532 DEFUN ("rassq", Frassq, 2, 2, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1533 Return non-nil if VALUE is `eq' to the cdr of an element of ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1534 The value is actually the element of ALIST whose cdr is VALUE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1535 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1536 (value, alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1537 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1538 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1539 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1540 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1541 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1542 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1543 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1544 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1546 /* Like Frassq, but caller must ensure that ALIST is properly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1547 nil-terminated and ebola-free. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1548 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1549 rassq_no_quit (Lisp_Object value, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1550 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1551 LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1552 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1553 Lisp_Object elt_cdr = XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1554 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1555 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1556 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1557 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1558 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1559
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1560 DEFUN ("rassoc*", FrassocX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1561 Find the first item whose cdr matches ITEM in ALIST.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1562
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1563 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1565 arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1566 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1567 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1569 Lisp_Object item = args[0], alist = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1570 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1571 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1572
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1573 PARSE_KEYWORDS (FrassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1574 NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1575
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1576 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1577 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1578
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1579 if (check_test == check_eq_nokey)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1580 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1581 /* TEST is #'eq, no need to call any C functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1582 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1583 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1584 if (EQ (item, elt_cdr) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1585 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1586 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1587 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1588 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1589 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1590 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1591 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1592 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1593 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1594 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1595 check_test (test, key, item, XCDR (elt)) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1596 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1597 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1598 return elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1599 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1600 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1601 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1602 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1604 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1605 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1606
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1607 /* This is the implementation of both #'find and #'position. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1608 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1609 position (Lisp_Object *object_out, Lisp_Object item, Lisp_Object sequence,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1610 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1611 Lisp_Object test, Lisp_Object key, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1612 Lisp_Object from_end, Lisp_Object default_, Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1613 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1614 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1615 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, len, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1616
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1617 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1618 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1619 starting = FIXNUMP (start) ? XFIXNUM (start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1620
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1621 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1622 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1623 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1624 ending = FIXNUMP (end) ? XFIXNUM (end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1627 *object_out = default_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1628
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1629 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1631 if (!(starting < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1633 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1634 /* starting could be equal to ending, in which case nil is what
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1635 we want to return. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1636 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1637 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1638
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1639 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1640 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1641 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1642 if (starting <= ii && ii < ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1643 && check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1644 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1645 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1646 *object_out = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1647
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1648 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1649 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1650 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1651 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1652 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1653 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1654 else if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1655 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1656 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1657 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1658
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1659 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1660 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1661 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1664 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1666 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1667 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1668 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1669 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1670 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1671 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1672 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1673 Lisp_Object character = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1674
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1675 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1676 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1677 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1678 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1679 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1680
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1681 if (check_test (test, key, item, character) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1682 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1683 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1684 *object_out = character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1685
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1686 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1687 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1688 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1689 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1690 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1692 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1693 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1694 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1695 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1696 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1697 mapping_interaction_error (caller, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1698 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1699 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1700
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1701 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1702 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1703 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1704 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1706 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1707 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1708 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1709 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1710 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1711 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1712 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1713 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1714 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1715 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1717 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1718 if (0 == len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1719 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1720 /* Catches the case where we have nil. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1721 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1722 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1724 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1725 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1726 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1727 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1728 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1729 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1730 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1731 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1732 *object_out = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1733 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1734 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1735 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1736 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1737 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1739 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1740 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1741 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1742 if (check_test (test, key, item, object) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1743 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1744 result = make_integer (ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1745 *object_out = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1746 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1747 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1748 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1749 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1750 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1751
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1752 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1753 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1754
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1755 DEFUN ("position", Fposition, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1756 Return the index of the first occurrence of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1757
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1758 Return nil if not found. See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1760 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1761 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1762 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1763 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1764 Lisp_Object object = Qnil, item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1765 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1766 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1767
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1768 PARSE_KEYWORDS (Fposition, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1769 (test, if_, test_not, if_not, key, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1770 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1771
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1772 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1773 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1775 return position (&object, item, sequence, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1776 test, key, start, end, from_end, Qnil, Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1777 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1778
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1779 DEFUN ("find", Ffind, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1780 Find the first occurrence of ITEM in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1781
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1782 Return the matching ITEM, or nil if not found. See `remove*' for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1783 meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1785 The keyword :default, not specified by Common Lisp, designates an object to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1786 return instead of nil if ITEM is not found.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1787
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1788 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) DEFAULT FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1789 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1790 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1791 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1792 Lisp_Object object = Qnil, item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1793 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1794 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1795
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1796 PARSE_KEYWORDS (Ffind, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1797 (test, if_, test_not, if_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1798 default_),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1799 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1800
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1801 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1802 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1803
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1804 position (&object, item, sequence, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1805 test, key, start, end, from_end, default_, Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1806
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1807 return object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1808 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1810 /* Like #'delq, but caller must ensure that LIST is properly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1811 nil-terminated and ebola-free. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1812
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1813 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1814 delq_no_quit (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1815 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1816 LIST_LOOP_DELETE_IF (list_elt, list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1817 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1818 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1819 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1820
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1821 /* Be VERY careful with this. This is like delq_no_quit() but
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1822 also calls free_cons() on the removed conses. You must be SURE
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1823 that no pointers to the freed conses remain around (e.g.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1824 someone else is pointing to part of the list). This function
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1825 is useful on internal lists that are used frequently and where
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1826 the actual list doesn't escape beyond known code bounds. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1827
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1828 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1829 delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1831 REGISTER Lisp_Object tail = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1832 REGISTER Lisp_Object prev = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1834 while (!NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1835 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1836 REGISTER Lisp_Object tem = XCAR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1837 if (EQ (elt, tem))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1838 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1839 Lisp_Object cons_to_free = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1840 if (NILP (prev))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1841 list = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1842 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1843 XCDR (prev) = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1844 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1845 free_cons (cons_to_free);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1847 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1848 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1849 prev = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1850 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1851 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1852 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1853 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1854 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1856 DEFUN ("delete*", FdeleteX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1857 Remove all occurrences of ITEM in SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1859 If SEQUENCE is a non-nil list, this modifies the list directly. A non-list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1860 SEQUENCE will not be destructively modified, rather, if ITEM occurs in it, a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1861 new SEQUENCE of the same type without ITEM will be returned.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1862
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1863 See `remove*' for a non-destructive alternative, and for explanation of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1864 keyword arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1865
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1866 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1867 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1868 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1869 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1870 Lisp_Object item = args[0], sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1871 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1872 Elemcount len, ii = 0, encountered = 0, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1873 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1874 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1875
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1876 PARSE_KEYWORDS (FdeleteX, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1877 (test, if_not, if_, test_not, key, start, end, from_end,
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1878 count), (start = Qzero));
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1879
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1880 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1881 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1882 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1883
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1884 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1885 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1886 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1887 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1889
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1890 if (!NILP (count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1891 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1892 CHECK_INTEGER (count);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1893 if (FIXNUMP (count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1894 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1895 counting = XFIXNUM (count);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1896 }
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1897 #ifdef HAVE_BIGNUM
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1898 else
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1899 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1900 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1901 1 + MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM - 1;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1902 }
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1903 #endif
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1904 if (counting < 1)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1905 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1906 return sequence;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1907 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1908
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1909 if (!NILP (from_end))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1910 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1911 /* Sigh, this is inelegant. Force count_with_tail () to ignore
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1912 the count keyword, so we get the actual number of matching
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1913 elements, and can start removing from the beginning for the
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1914 from-end case. */
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1915 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FdeleteX))->min_args;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1916 ii < nargs; ii += 2)
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1917 {
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1918 if (EQ (args[ii], Q_count))
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1919 {
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1920 args[ii + 1] = Qnil;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1921 break;
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1922 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1923 }
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
1924 ii = 0;
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1925 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1926 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1927
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1928 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1929 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1930
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1931 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1932 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1933 Lisp_Object prev_tail_list_elt = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1934 Elemcount list_len = 0, deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1935 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1937 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1938 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1939 /* Both COUNT and FROM-END were specified; we need to traverse the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1940 list twice. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1941 Lisp_Object present = count_with_tail (&ignore, nargs, args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1942 QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1944 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1945 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1946 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1948
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1949 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1951 /* If there are fewer items in the list than we have permission to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1952 delete, we don't need to differentiate between the :from-end
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1953 nil and :from-end t cases. Otherwise, presenting is the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1954 of matching items we need to ignore before we start to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1955 delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1956 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1957 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1958
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1959 GCPRO1 (prev_tail_list_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1960 ii = -1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1961
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1963 GC_EXTERNAL_LIST_LOOP_4 (list_elt, sequence, tail, list_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1964 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1965 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1966
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1967 if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1968 (check_test (test, key, item, list_elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1969 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1970 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1971 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1972 if (NILP (prev_tail_list_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1973 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1974 sequence = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1975 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1976 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1977 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1978 XSETCDR (prev_tail_list_elt, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1979 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1980
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1981 /* Keep tortoise from ever passing hare. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1982 list_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1983 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1984 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1985 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1986 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1987 prev_tail_list_elt = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1988 if (ii >= ending || (!presenting && encountered > counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1989 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1990 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1992 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1993 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1994 END_GC_EXTERNAL_LIST_LOOP (list_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1995 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1996
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1997 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1998
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
1999 if ((ii < starting || (ii < ending && !NILP (end))) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2000 !(presenting ? encountered == presenting : encountered == counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2001 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2002 check_sequence_range (args[1], start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2003 make_fixnum (deleted + XFIXNUM (Flength (args[1]))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2005
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2006 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2007 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2008 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2009 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2010 Ibyte *staging = alloca_ibytes (XSTRING_LENGTH (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2011 Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2012 Ibyte *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2013 Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2014 Lisp_Object character, result = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2016 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2017 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2018 Lisp_Object present = count_with_tail (&character, nargs, args,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2019 QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2020
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2021 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2022 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2023 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2024 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2025
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2026 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2027
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2028 /* If there are fewer items in the list than we have permission to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2029 delete, we don't need to differentiate between the :from-end
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2030 nil and :from-end t cases. Otherwise, presenting is the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2031 of matching items we need to ignore before we start to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2032 delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2033 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2034 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2036 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2037 while (cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2038 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2039 if (ii >= starting && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2040 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2041 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2043 if ((check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2044 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2045 && (presenting ? encountered++ >= presenting :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2046 encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2047 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2048 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2049 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2050 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2051 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2052 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2053 += set_itext_ichar (staging_cursor, XCHAR (character));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2054 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2055
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2056 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2057 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2058 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2059 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2060 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2061 mapping_interaction_error (QdeleteX, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2062 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2063 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2064 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2065 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2066 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2067 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2068
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2069 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2070 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2071 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2072 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2073
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2074 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2075 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2076 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2077 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2078
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2079 if (0 != encountered)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2080 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2081 result = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2082 copy_string_extents (result, sequence, 0, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2083 staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2084 sequence = result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2085 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2086
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2087 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2088 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2089 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2090 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2091 Lisp_Object position0 = Qnil, object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2092 Lisp_Object *staging = NULL, *staging_cursor, *staging_limit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2093 Elemcount positioning;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2094
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2095 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2096
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2097 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2098
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2099 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2100 test_not_unboundp, test, key, start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2101 from_end, Qnil, QdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2102 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2103 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2104 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2105 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2106
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2107 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2108 positioning = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2109 encountered = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2110
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2111 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2112 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2113 staging = alloca_array (Lisp_Object, len - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2114 staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2116 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2117 while (ii < positioning)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2119 *staging_cursor++ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2120 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2121 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2122
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2123 ii = positioning + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2124 while (ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2125 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2126 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2127 if (encountered < counting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2128 && (check_test (test, key, item, object)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2129 == test_not_unboundp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2131 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2132 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2133 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2134 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2135 *staging_cursor++ = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2136 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2137 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2138 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2139
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2140 while (ii < len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2141 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2142 *staging_cursor++ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2143 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2144 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2145 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2146 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2147 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2148 staging = alloca_array (Lisp_Object, len - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2149 staging_cursor = staging_limit = staging + len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2150
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2151 ii = len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2152 while (ii > positioning)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2153 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2154 *--staging_cursor = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2155 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2156 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2157
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2158 ii = positioning - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2159 while (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2161 object = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2162 if (encountered < counting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2163 && (check_test (test, key, item, object) ==
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2164 test_not_unboundp))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2165 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2166 encountered++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2168 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2169 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2170 *--staging_cursor = object;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2171 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2172
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2173 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2174 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2175
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2176 while (ii >= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2177 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2178 *--staging_cursor = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2179 ii--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2180 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2181
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2182 staging = staging_cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2183 staging_cursor = staging_limit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2184 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2185
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2186 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2187 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2188 return Fvector (staging_cursor - staging, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2189 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2190 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2191 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2192 return Fbit_vector (staging_cursor - staging, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2193 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2194
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2195 /* A nil sequence will have given us a nil #'position,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2196 above. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2197 ABORT ();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2199 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2200 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2201 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2202
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2203 DEFUN ("remove*", FremoveX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2204 Remove all occurrences of ITEM in SEQUENCE, non-destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2206 If SEQUENCE is a list, `remove*' makes a copy if that is necessary to avoid
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2207 corrupting the original SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2208
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2209 The keywords :test and :test-not specify two-argument test and negated-test
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2210 predicates, respectively; :test defaults to `eql'. :key specifies a
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2211 one-argument function that transforms elements of SEQUENCE into \"comparison
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2212 keys\" before the test predicate is applied. See `member*' for more
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2213 information on these keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2215 :start and :end, if given, specify indices of a subsequence of SEQUENCE to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2216 be processed. Indices are 0-based and processing involves the subsequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2217 starting at the index given by :start and ending just before the index given
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2218 by :end.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2219
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2220 :count, if given, limits the number of items removed to the number
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2221 specified. :from-end, if given, causes processing to proceed starting from
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2222 the end instead of the beginning; in this case, this matters only if :count
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2223 is given.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2224
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2225 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2226 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2227 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2228 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2229 Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2230 tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2231 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, counting = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2232 Elemcount ii = 0, encountered = 0, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2233 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2234 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2235
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2236 PARSE_KEYWORDS (FremoveX, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2237 (test, if_not, if_, test_not, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2238 count), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2239
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2240 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2241 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2242 return FdeleteX (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2243 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2244
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2245 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2246 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2247
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2248 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2249 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2250 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2251 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2252 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2253
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2254 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2255 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2256 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2257 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2258 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2259 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2261 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2262 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2263 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2264 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2265 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2266 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2267 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2269 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2270 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2271 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2272 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2273
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2274 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2275 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2276 /* Sigh, this is inelegant. Force count_with_tail () to ignore the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2277 count keyword, so we get the actual number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2278 elements, and can start removing from the beginning for the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2279 from-end case. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2280 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FremoveX))->min_args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2281 ii < nargs; ii += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2283 if (EQ (args[ii], Q_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2284 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2285 args[ii + 1] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2286 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2287 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2288 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2289 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2290 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2291 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2293 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2294 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2295
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2296 matched_count = count_with_tail (&tail, nargs, args, QremoveX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2298 if (!ZEROP (matched_count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2299 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2300 Lisp_Object result = Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2301 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2302
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2303 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2304 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2305 presenting = XFIXNUM (matched_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2306
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2307 /* If there are fewer matching elements in the list than we have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2308 permission to delete, we don't need to differentiate between
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2309 the :from-end nil and :from-end t cases. Otherwise, presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2310 is the number of matching items we need to ignore before we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2311 start to delete. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2312 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2313 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2314
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2315 GCPRO2 (result, tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2316 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2317 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2318 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2319 if (EQ (tail, tailing))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2320 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2321 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2322 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2324 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2325 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2326 return XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2327 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2328
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2329 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2330 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2331 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2332 else if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2333 (check_test (test, key, item, elt) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2334 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2335 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2336 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2337 DO_NOTHING;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2338 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2339 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2340 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2341 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2342 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2343 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2344 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2345 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2346 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2347 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2348
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2349 if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2350 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2351 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2352 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2353
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2354 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2355 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2356 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2357 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2358 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2359
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2360 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2361 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2362 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2363 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2364
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2365 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2366 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2367
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2368 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2369 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2370
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2371 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2372 remassoc_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2373 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2374 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2375 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2376 internal_equal (key, XCAR (elt), 0)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2377 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2378 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2379
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2380 /* no quit, no errors; be careful */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2382 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2383 remassq_no_quit (Lisp_Object key, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2384 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2385 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2386 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2387 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2388 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2389 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2390
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2391 /* Like Fremrassq, fast and unsafe; be careful */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2392 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2393 remrassq_no_quit (Lisp_Object value, Lisp_Object alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2395 LIST_LOOP_DELETE_IF (elt, alist,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2396 (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2397 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2398 return alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2399 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2400
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2401 /* Remove duplicate elements between START and END from LIST, a non-nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2402 list; if COPY is zero, do so destructively. Items to delete are selected
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2403 according to the algorithm used when :from-end t is passed to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2404 #'delete-duplicates. Error if LIST is ill-formed or circular.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2405
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2406 TEST and KEY are as in #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2407 reflect them, having been initialised with get_check_match_function() or
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2408 get_check_test_function(). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2409 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2410 list_delete_duplicates_from_end (Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2411 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2412 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2413 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2414 Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2415 Lisp_Object end, Boolint copy)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2416 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2417 Lisp_Object checking = Qnil, result = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2418 Lisp_Object keyed, positioned, position_cons = Qnil, result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2419 Elemcount len = XFIXNUM (Flength (list)), pos, starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2420 Elemcount ending = (NILP (end) ? len : XFIXNUM (end)), greatest_pos_seen = -1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2421 Elemcount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2422 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2423
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2424 /* We can't delete (or remove) as we go, because that breaks START and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2425 END. We could if END were nil, and that would change an ON(N + 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2426 algorithm to an ON^2 algorithm. Here and now it doesn't matter, though,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2427 #'delete-duplicates is relatively expensive no matter what. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2428 struct Lisp_Bit_Vector *deleting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2429 = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2430 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2431 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2432 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2433
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2434 check_sequence_range (list, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2435
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2436 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2437 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2438 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2439
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2440 GCPRO1 (keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2441
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2443 GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2444 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2445 if (!(starting <= ii && ii <= ending) || bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2446 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2447 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2448 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2449 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2450
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2451 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2452 checking = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2453 pos = ii + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2455 while (!NILP ((positioned = list_position_cons_before
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2456 (&position_cons, keyed, checking, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2457 test_not_unboundp, test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2458 make_fixnum (max (starting - pos, 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2459 make_fixnum (ending - pos)))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2460 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2461 pos = XFIXNUM (positioned) + pos;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2462 set_bit_vector_bit (deleting, pos, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2463 greatest_pos_seen = max (greatest_pos_seen, pos);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2464 checking = NILP (position_cons) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2465 XCDR (checking) : XCDR (XCDR (position_cons));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2466 pos += 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2467 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2468 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2469 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2470 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2471 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2472
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2473 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2474
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2475 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2476
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2477 if (greatest_pos_seen > -1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2478 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2479 if (copy)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2480 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2481 result = result_tail = Fcons (XCAR (list), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2482 list = XCDR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2483 ii = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2484
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2485 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2486 EXTERNAL_LIST_LOOP_3 (elt, list, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2487 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2488 if (ii == greatest_pos_seen)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2489 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2490 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2491 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2492 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2493 else if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2494 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2495 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2496 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2497 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2498 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2500 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2501 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2502 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2503 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2504 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2505 bit_vector_bit (deleting, ii++));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2506 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2507 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2508
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2509 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2511
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2512 DEFUN ("delete-duplicates", Fdelete_duplicates, 1, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2513 Remove all duplicate elements from SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2514
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2515 If SEQUENCE is a list and has duplicates, modify and return it. Note that
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2516 SEQUENCE may start with an element to be deleted; because of this, if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2517 modifying a variable, be sure to write `(setq VARIABLE (delete-duplicates
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2518 VARIABLE))' to be certain to have a list without duplicate elements.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2519
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2520 If SEQUENCE is an array and has duplicates, return a newly-allocated array
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2521 of the same type comprising all unique elements of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2522
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2523 If there are no duplicate elements in SEQUENCE, return it unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2524
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2525 See `remove*' for the meaning of the keywords. See `remove-duplicates' for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2526 a non-destructive version of this function.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2527
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2528 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2529 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2530 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2531 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2532 Lisp_Object sequence = args[0], keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2533 Lisp_Object positioned = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2534 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, len, ii = 0, jj = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2535 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2536 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2537 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2538
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2539 PARSE_KEYWORDS (Fdelete_duplicates, nargs, args, 6,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2540 (test, key, test_not, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2541 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2542
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2543 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2544 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2545 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2546
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2547 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2548 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2549 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2550 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2551 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2552
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2553 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2554
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2555 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2556 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2558 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2559 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2560 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2561 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2562 Lisp_Object prev_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2563 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2565 GCPRO2 (keyed, prev_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2566
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2567 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2568 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2569 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2570 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2571 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2572 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2573 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2574 = list_position_cons_before (&ignore, keyed,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2575 XCDR (tail), check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2576 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2577 0, make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2578 - (ii + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2579 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2580 make_fixnum (ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2581 - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2582 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2583 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2584 sequence = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2585 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2586 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2587 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2589 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2590 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2591 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2592 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2593 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2594 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2595 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2596
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2597 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2598 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2599 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2600 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2601 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2602 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2603 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2604 if (!(starting <= ii && ii <= ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2605 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2606 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2607 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2608 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2609 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2610
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2611 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2612 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2613 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2614 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2615 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2616 make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2617 - (ii + 1), 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2618 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2619 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2620 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2621 /* We know this isn't the first iteration of the loop,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2622 because we advanced above to the point where we have at
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2623 least one non-duplicate entry at the head of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2624 list. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2625 XSETCDR (prev_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2626 len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2627 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2628 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2629 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2630 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2631 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2632 if (ii >= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2633 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2634 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2635 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2636 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2637
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2638 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2639 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2640 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2641 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2642
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2643 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2644
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2645 if ((ii < starting || (ii < ending && !NILP (end))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2646 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2647 check_sequence_range (args[0], start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2648 make_fixnum (deleted
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2649 + XFIXNUM (Flength (args[0]))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2650 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2651 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2652 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2653 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2654 sequence = list_delete_duplicates_from_end (sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2655 test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2656 test, key, start, end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2657 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2658 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2659 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2660 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2661 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2662 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2664 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2666 /* We know all the elements will be characters; set check_test to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2667 reflect that. This isn't useful if KEY is not #'identity, since
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2668 it may return non-characters for the elements. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2669 check_test = get_check_test_function (make_char ('a'),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2670 &test, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2671 Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2672 &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2673 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2674
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2675 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2676 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2677 Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2678 Ibyte *staging = alloca_ibytes (byte_len), *staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2679 Ibyte *cursor = XSTRING_DATA (sequence), *startp = cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2680 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2681
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2682 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2683
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2684 while (cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2686 if (starting <= ii && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2687 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2688 Ibyte *cursor0 = cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2689 Bytecount cursor0_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2690 Boolint delete_this = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2691
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2692 elt = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2693 INC_IBYTEPTR (cursor0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2694 cursor0_offset = cursor0 - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2696 for (jj = ii + 1; jj < ending && cursor0_offset < byte_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2697 jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2698 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2699 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2700 make_char (itext_ichar (cursor0)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2701 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2702 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2703 delete_this = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2704 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2705 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2706 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2707
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2708 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2709 cursor0 = startp + cursor0_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2710 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2711 || !valid_ibyteptr_p (cursor0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2712 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2713 mapping_interaction_error (Qdelete_duplicates,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2714 sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2715 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2717 INC_IBYTEPTR (cursor0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2718 cursor0_offset = cursor0 - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2719 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2721 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2722 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2724 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2725 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2726 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2727 mapping_interaction_error (Qdelete_duplicates, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2728 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2729
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2730 if (!delete_this)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2731 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2732 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2733 += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2734
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2735 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2736 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2737 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2738 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2739 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2740 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2742 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2743 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2744 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2745 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2747 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2749 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2750 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2751 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2752 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2754 if (0 != deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2755 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2756 sequence = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2757 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2758 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2759 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2760 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2761 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2762 Ibyte *staging = alloca_ibytes ((len = string_char_length (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2763 * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2764 Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2765 Ibyte *endp = startp + XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2766 struct Lisp_Bit_Vector *deleting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2767 = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2768 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2769 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2770 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2771
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2772 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2774 /* For the from_end t case; transform contents to an array with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2775 elements addressable in constant time, use the same algorithm
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2776 as for vectors. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2777 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2778 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2779 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2780
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2781 while (startp < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2782 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2783 itext_copy_ichar (startp, staging + (ii * MAX_ICHAR_LEN));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2784 INC_IBYTEPTR (startp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2785 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2786 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2787
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2788 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2789
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2790 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2791
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2792 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2793 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2794 elt = KEY (key, make_char (itext_ichar (staging +
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2795 (ii * MAX_ICHAR_LEN))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2796 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2797 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2798 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2799 make_char (itext_ichar
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2800 (staging + (jj * MAX_ICHAR_LEN))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2801 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2802 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2803 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2804 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2805 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2806 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2807 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2808 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2810 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2812 if (0 != deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2813 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2814 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2815
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2816 for (ii = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2817 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2818 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2819 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2820 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2821 += itext_copy_ichar (startp, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2822 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2823
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2824 INC_IBYTEPTR (startp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2825 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2826
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2827 sequence = make_string (staging, staging_cursor - staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2828 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2829 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2830 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2831 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2832 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2833 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2834 Lisp_Object *content = XVECTOR_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2835 struct Lisp_Bit_Vector *deleting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2836 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2837
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2838 len = XVECTOR_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2839 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2840
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2841 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2842 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2843 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2844 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2845 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2846 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2847 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2848
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2849 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2850
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2851 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2852
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2853 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2854 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2855 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2856 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2857 elt = KEY (key, content[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2859 for (jj = ii + 1; jj < ending; jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2860 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2861 if (check_test (test, key, elt, content[jj])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2862 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2863 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2864 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2865 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2866 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2867 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2868 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2869 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2870 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2871 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2872 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2873 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2874 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2875 elt = KEY (key, content[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2876
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2877 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2878 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2879 if (check_test (test, key, elt, content[jj])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2880 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2881 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2882 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2883 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2884 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2885 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2886 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2887 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2888 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2889
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2890 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2891
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2892 if (deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2893 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2894 Lisp_Object res = make_vector (len - deleted, Qnil),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2895 *res_content = XVECTOR_DATA (res);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2897 for (ii = jj = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2898 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2899 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2900 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2901 res_content[jj++] = content[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2902 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2903 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2905 sequence = res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2906 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2907 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2908 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2909 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2910 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2911 Elemcount deleted = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2912 /* I'm a little irritated at this. Basically, the only reasonable
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2913 thing delete-duplicates should do if handed a bit vector is return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2914 something of maximum length two and minimum length 0 (because
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2915 that's the possible number of distinct elements if EQ is regarded
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2916 as identity, which it should be). But to support arbitrary TEST
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2917 and KEY arguments, which may be non-deterministic from our
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2918 perspective, we need the same algorithm as for vectors. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2919 struct Lisp_Bit_Vector *deleting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2920 Lisp_Object elt = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2921
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2922 len = bit_vector_length (bv);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2923
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2924 if (EQ (Qidentity, key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2925 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2926 /* We know all the elements will be bits; set check_test to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2927 reflect that. This isn't useful if KEY is not #'identity, since
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2928 it may return non-bits for the elements. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2929 check_test = get_check_test_function (Qzero, &test, test_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2930 Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2931 &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2932 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2933
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2934 check_sequence_range (sequence, start, end, make_integer (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2935
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2936 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2937 + (sizeof (long)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2938 * (BIT_VECTOR_LONG_STORAGE (len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2939 - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2940 deleting->size = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2941 memset (&(deleting->bits), 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2942 sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2944 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2945
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2946 GCPRO1 (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2947
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2948 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2949 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2950 for (ii = starting; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2951 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2952 elt = KEY (key, make_fixnum (bit_vector_bit (bv, ii)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2954 for (jj = ii + 1; jj < ending; jj++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2955 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2956 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2957 make_fixnum (bit_vector_bit (bv, jj)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2958 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2959 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2960 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2961 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2962 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2963 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2965 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2966 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2967 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2968 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2969 for (ii = ending - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2970 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2971 elt = KEY (key, make_fixnum (bit_vector_bit (bv, ii)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2972
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2973 for (jj = ii - 1; jj >= starting; jj--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2974 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2975 if (check_test (test, key, elt,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2976 make_fixnum (bit_vector_bit (bv, jj)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2977 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2978 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2979 set_bit_vector_bit (deleting, ii, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2980 deleted++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2981 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2982 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2983 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2984 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2985 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2986
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2987 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2988
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2989 if (deleted)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2990 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2991 Lisp_Object res = make_bit_vector (len - deleted, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2992 Lisp_Bit_Vector *resbv = XBIT_VECTOR (res);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2993
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2994 for (ii = jj = 0; ii < len; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2995 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2996 if (!bit_vector_bit (deleting, ii))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2998 set_bit_vector_bit (resbv, jj++, bit_vector_bit (bv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
2999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3000 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3001
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3002 sequence = res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3003 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3005
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3006 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3007 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3008
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3009 DEFUN ("remove-duplicates", Fremove_duplicates, 1, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3010 Remove duplicate elements from SEQUENCE, non-destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3011
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3012 If there are no duplicate elements in SEQUENCE, return it unmodified;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3013 otherwise, return a new object. If SEQUENCE is a list, the new object may
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3014 share list structure with SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3016 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3017
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3018 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3019 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3020 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3021 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3022 Lisp_Object sequence = args[0], keyed, positioned = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3023 Lisp_Object result = sequence, result_tail = result, cursor = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3024 Lisp_Object cons_with_shared_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3025 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3026 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3027 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3028 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3029
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3030 PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3031 (test, key, test_not, start, end, from_end),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3032 (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3033
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3034 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3036 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3037 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3038 return Fdelete_duplicates (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3039 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3041 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3042 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3043
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3044 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3045 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3046 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3047 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3048 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3049
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3050 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3051 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3052 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3053 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3054
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3055 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3056 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3057
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3058 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3059 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3060 Lisp_Object ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3061
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3062 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3063
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3064 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3065 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3066 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3067 if (starting <= ii && ii <= ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3068 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3069 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3070 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3071 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3072 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3073 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3074 make_fixnum (max (starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3075 - (ii + 1), 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3076 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3077 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3078 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3079 sequence = result = result_tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3080 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3081 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3082 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3083 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3084 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3085 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3086 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3087 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3088 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3089 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3090
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3091 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3092 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3093 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3094 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3095
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3096 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3097 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3098 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3099 if (!(starting <= ii && ii <= ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3101 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3102 continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3105 /* For this algorithm, each time we encounter an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3106 removed, copy the output list from the tail beyond the last
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3107 removed cons to this one. Otherwise, the tail of the output list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3108 is shared with the input list, which is OK. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3109
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3110 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3111 positioned
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3112 = list_position_cons_before (&ignore, keyed, XCDR (tail),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3113 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3114 test, key, 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3115 make_fixnum (max (starting - (ii + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3116 0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3117 make_fixnum (ending - (ii + 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3118 if (!NILP (positioned))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3119 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3120 if (EQ (result, sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3121 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3122 result = cons_with_shared_tail
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3123 = Fcons (XCAR (sequence), XCDR (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3124 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3125
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3126 result_tail = cons_with_shared_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3127 cursor = XCDR (cons_with_shared_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3128
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3129 while (!EQ (cursor, tail) && !NILP (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3131 XSETCDR (result_tail, Fcons (XCAR (cursor), Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3132 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3133 cursor = XCDR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3134 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3135
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3136 XSETCDR (result_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3137 cons_with_shared_tail = result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3138 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3139
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3140 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3142 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3143 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3144
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3145 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3146
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3147 if ((ii < starting || (ii < ending && !NILP (end))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3148 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3149 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3150 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3151 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3152 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3153 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3154 result = list_delete_duplicates_from_end (sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3155 test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3156 start, end, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3157 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3158
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3159 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3160 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3161 #undef KEY
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3162
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3163 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3164 Reverse SEQUENCE, destructively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3165
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3166 Return the beginning of the reversed sequence, which will be a distinct Lisp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3167 object if SEQUENCE is a list with length greater than one. See also
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3168 `reverse', the non-destructive version of this function.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3169 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3170 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3172 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3173
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3174 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3175 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3176 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3177 Lisp_Object prev = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3178 Lisp_Object tail = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3179
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3180 /* We gcpro our args; see `nconc' */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3181 GCPRO2 (prev, tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3182 while (!NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3183 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3184 REGISTER Lisp_Object next;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3185 CONCHECK_CONS (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3186 next = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3187 XCDR (tail) = prev;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3188 prev = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3189 tail = next;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3190 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3191 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3192 return prev;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3193 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3194 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3195 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3196 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3197 Elemcount half = length / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3198 Lisp_Object swap = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3199 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3200
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3201 while (ii > half)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3202 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3203 swap = XVECTOR_DATA (sequence) [length - ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3204 XVECTOR_DATA (sequence) [length - ii]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3205 = XVECTOR_DATA (sequence) [ii - 1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3206 XVECTOR_DATA (sequence) [ii - 1] = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3207 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3208 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3209 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3210 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3211 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3212 Elemcount length = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3213 Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3214 Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3215
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3216 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3217 while (cursor < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3218 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3219 staging_end -= itext_ichar_len (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3220 itext_copy_ichar (cursor, staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3221 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3222 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3223
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3224 assert (staging == staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3225
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3226 memcpy (XSTRING_DATA (sequence), staging, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3227 init_string_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3228 bump_string_modiff (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3229 sledgehammer_check_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3230 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3231 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3232 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3233 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3234 Elemcount length = bit_vector_length (bv), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3235 Elemcount half = length / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3236 int swap = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3237
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3238 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3239 while (ii > half)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3240 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3241 swap = bit_vector_bit (bv, length - ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3242 set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3243 set_bit_vector_bit (bv, ii - 1, swap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3244 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3245 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3246 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3247 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3248 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3249 assert (NILP (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3250 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3251
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3252 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3253 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3254
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3255 DEFUN ("reverse", Freverse, 1, 1, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3256 Reverse SEQUENCE, copying. Return the reversed sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3257 See also the function `nreverse', which is used more often.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3258 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3259 (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3260 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3261 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3262
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3263 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3264
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3265 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3266 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3267 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3268 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3269 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3270 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3271 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3272 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3273 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3274 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3275 Lisp_Object *staging = alloca_array (Lisp_Object, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3276
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3277 while (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3278 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3279 staging[length - ii] = XVECTOR_DATA (sequence) [ii - 1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3280 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3281 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3282
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3283 result = Fvector (length, staging);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3284 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3285 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3286 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3287 Elemcount length = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3288 Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3289 Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3290
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3291 while (cursor < endp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3292 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3293 staging_end -= itext_ichar_len (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3294 itext_copy_ichar (cursor, staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3295 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3296 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3298 assert (staging == staging_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3299
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3300 result = make_string (staging, length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3301 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3302 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3303 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3304 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence), *res;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3305 Elemcount length = bit_vector_length (bv), ii = length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3306
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3307 result = make_bit_vector (length, Qzero);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3308 res = XBIT_VECTOR (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3309
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3310 while (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3311 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3312 set_bit_vector_bit (res, length - ii, bit_vector_bit (bv, ii - 1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3313 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3314 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3316 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3317 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3318 assert (NILP (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3319 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3320
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3321 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3322 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3323
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3324 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3325 list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3326 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3327 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3328 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3329 Lisp_Object value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3330 Lisp_Object tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3331 Lisp_Object tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3332 Lisp_Object l1, l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3333 Lisp_Object tortoises[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3334 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3335 int l1_count = 0, l2_count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3336
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3337 l1 = org_l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3338 l2 = org_l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3339 tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3340 value = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3341 tortoises[0] = org_l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3342 tortoises[1] = org_l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3343
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3344 /* It is sufficient to protect org_l1 and org_l2. When l1 and l2 are
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3345 updated, we copy the new values back into the org_ vars. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3346
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3347 GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3348 gcpro5.nvars = 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3349
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3350 while (1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3351 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3352 if (NILP (l1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3353 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3354 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3355 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3356 return l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3357 Fsetcdr (tail, l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3358 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3359 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3360 if (NILP (l2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3361 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3362 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3363 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3364 return l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3365 Fsetcdr (tail, l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3366 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3367 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3369 if (check_merge (predicate, key, Fcar (l2), Fcar (l1)) == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3370 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3371 tem = l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3372 l1 = Fcdr (l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3373 org_l1 = l1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3374
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3375 if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3376 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3377 if (l1_count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3378 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3379 if (!CONSP (tortoises[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3380 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3381 mapping_interaction_error (Qmerge, tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3382 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3383
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3384 tortoises[0] = XCDR (tortoises[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3385 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3387 if (EQ (org_l1, tortoises[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3388 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3389 signal_circular_list_error (org_l1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3390 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3391 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3393 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3394 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3395 tem = l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3396 l2 = Fcdr (l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3397 org_l2 = l2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3398
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3399 if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3400 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3401 if (l2_count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3402 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3403 if (!CONSP (tortoises[1]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3404 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3405 mapping_interaction_error (Qmerge, tortoises[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3406 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3407
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3408 tortoises[1] = XCDR (tortoises[1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3409 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3410
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3411 if (EQ (org_l2, tortoises[1]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3412 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3413 signal_circular_list_error (org_l2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3414 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3416 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3417
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3418 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3419 value = tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3420 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3421 Fsetcdr (tail, tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3422
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3423 tail = tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3424 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3425 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3426
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3427 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3428 array_merge (Lisp_Object *dest, Elemcount dest_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3429 Lisp_Object *front, Elemcount front_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3430 Lisp_Object *back, Elemcount back_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3431 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3432 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3433 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3434 Elemcount ii, fronting, backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3435 Lisp_Object *front_staging = front;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3436 Lisp_Object *back_staging = back;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3437 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3438
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3439 assert (dest_len == (back_len + front_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3441 if (0 == dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3443 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3444 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3445
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3446 if (front >= dest && front < (dest + dest_len))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3447 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3448 front_staging = alloca_array (Lisp_Object, front_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3449
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3450 for (ii = 0; ii < front_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3451 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3452 front_staging[ii] = front[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3453 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3454 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3455
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3456 if (back >= dest && back < (dest + dest_len))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3457 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3458 back_staging = alloca_array (Lisp_Object, back_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3459
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3460 for (ii = 0; ii < back_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3461 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3462 back_staging[ii] = back[ii];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3463 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3464 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3465
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3466 GCPRO2 (front_staging[0], back_staging[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3467 gcpro1.nvars = front_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3468 gcpro2.nvars = back_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3470 for (ii = fronting = backing = 0; ii < dest_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3471 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3472 if (fronting >= front_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3473 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3474 while (ii < dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3475 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3476 dest[ii] = back_staging[backing];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3477 ++ii, ++backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3478 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3479 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3480 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3481 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3482
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3483 if (backing >= back_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3484 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3485 while (ii < dest_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3486 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3487 dest[ii] = front_staging[fronting];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3488 ++ii, ++fronting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3489 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3490 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3491 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3492 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3493
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3494 if (check_merge (predicate, key, back_staging[backing],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3495 front_staging[fronting]) == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3496 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3497 dest[ii] = front_staging[fronting];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3498 ++fronting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3499 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3500 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3501 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3502 dest[ii] = back_staging[backing];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3503 ++backing;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3504 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3505 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3506
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3507 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3508 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3509
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3510 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3511 list_array_merge_into_list (Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3512 Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3513 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3514 Lisp_Object predicate, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3515 Boolint reverse_order)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3516 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3517 Lisp_Object tail = Qnil, value = Qnil, tortoise = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3518 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3519 Elemcount array_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3520 int looped = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3521
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3522 GCPRO4 (list, tail, value, tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3523
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3524 while (1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3525 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3526 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3527 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3528 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3529
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3530 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3531 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3532 return Flist (array_len, array);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3533 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3534
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3535 Fsetcdr (tail, Flist (array_len - array_index, array + array_index));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3536 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3537 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3538
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3539 if (array_index >= array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3540 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3541 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3542 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3543 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3544 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3545 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3546
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3547 Fsetcdr (tail, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3548 return value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3549 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3550
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3551
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3552 if (reverse_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3553 check_merge (predicate, key, Fcar (list), array [array_index])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3554 : !check_merge (predicate, key, array [array_index], Fcar (list)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3555 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3556 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3557 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3558 value = tail = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3559 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3560 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3561 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3562 Fsetcdr (tail, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3563 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3564 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3565
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3566 list = Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3567 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3568 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3569 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3570 if (NILP (tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3571 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3572 value = tail = Fcons (array [array_index], Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3573 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3574 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3575 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3576 Fsetcdr (tail, Fcons (array [array_index], tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3577 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3578 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3579 ++array_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3580 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3581
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3582 if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3583 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3584 if (looped & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3585 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3586 tortoise = XCDR (tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3587 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3589 if (EQ (list, tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3590 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3591 signal_circular_list_error (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3592 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3593 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3594 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3595 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3596
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3597 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3598 list_list_merge_into_array (Lisp_Object *output, Elemcount output_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3599 Lisp_Object list_one, Lisp_Object list_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3600 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3601 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3602 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3603 Elemcount output_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3604
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3605 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3606 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3607 if (NILP (list_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3609 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3610 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3611 output [output_index] = Fcar (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3612 list_two = Fcdr (list_two), ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3613 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3614 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3615 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3616
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3617 if (NILP (list_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3618 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3619 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3620 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3621 output [output_index] = Fcar (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3622 list_one = Fcdr (list_one), ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3623 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3624 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3627 if (check_merge (predicate, key, Fcar (list_two), Fcar (list_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3628 == 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3629 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3630 output [output_index] = XCAR (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3631 list_one = XCDR (list_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3632 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3633 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3634 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3635 output [output_index] = XCAR (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3636 list_two = XCDR (list_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3637 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3638
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3639 ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3640
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3641 /* No need to check for circularity. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3643 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3644
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3645 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3646 list_array_merge_into_array (Lisp_Object *output, Elemcount output_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3647 Lisp_Object list,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3648 Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3649 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3650 Lisp_Object predicate, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3651 Boolint reverse_order)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3653 Elemcount output_index = 0, array_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3654
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3655 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3656 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3657 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3658 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3659 if (array_len - array_index != output_len - output_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3660 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3661 mapping_interaction_error (Qmerge, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3662 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3663
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3664 while (array_index < array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3666 output [output_index++] = array [array_index++];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3667 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3668
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3669 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3670 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3671
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3672 if (array_index >= array_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3673 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3674 while (output_index < output_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3675 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3676 output [output_index++] = Fcar (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3677 list = Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3678 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3679
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3680 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3681 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3682
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3683 if (reverse_order ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3684 check_merge (predicate, key, Fcar (list), array [array_index]) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3685 !check_merge (predicate, key, array [array_index], Fcar (list)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3686 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3687 output [output_index] = XCAR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3688 list = XCDR (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3689 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3690 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3691 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3692 output [output_index] = array [array_index];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3693 ++array_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3694 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3695
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3696 ++output_index;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3697 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3698 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3699
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3700 #define STRING_DATA_TO_OBJECT_ARRAY(strdata, c_array, counter, len) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3701 do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3702 c_array = alloca_array (Lisp_Object, len); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3703 for (counter = 0; counter < len; ++counter) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3704 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3705 c_array[counter] = make_char (itext_ichar (strdata)); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3706 INC_IBYTEPTR (strdata); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3707 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3708 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3709
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3710 #define BIT_VECTOR_TO_OBJECT_ARRAY(v, c_array, counter, len) do { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3711 c_array = alloca_array (Lisp_Object, len); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3712 for (counter = 0; counter < len; ++counter) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3713 { \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3714 c_array[counter] = make_fixnum (bit_vector_bit (v, counter)); \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3715 } \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3716 } while (0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3718 DEFUN ("merge", Fmerge, 4, MANY, 0, /*
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
3719 Destructively merge SEQUENCE1 and SEQUENCE2, producing a new sequence.
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3720
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3721 TYPE is the type of sequence to return. PREDICATE is a `less-than'
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3722 predicate on the elements.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3724 Optional keyword argument KEY is a function used to extract an object to be
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
3725 used for comparison from each element of SEQUENCE1 and SEQUENCE2.
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
3726
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
3727 arguments: (TYPE SEQUENCE1 SEQUENCE2 PREDICATE &key (KEY #'IDENTITY))
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3728 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3729 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3730 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3731 Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3732 predicate = args[3], result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3733 check_test_func_t check_merge = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3734
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3735 PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3736
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3737 CHECK_SEQUENCE (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3738 CHECK_SEQUENCE (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3739
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3740 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3742 check_merge = get_merge_predicate (predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3743
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3744 if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3745 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3746 if (NILP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3747 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3748 result = Fappend (2, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3749 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3750 else if (NILP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3751 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3752 args[3] = Qnil; /* Overwriting PREDICATE, and losing its GC
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3753 protection, but that doesn't matter. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3754 result = Fappend (2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3755 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3756 else if (CONSP (sequence_one) && CONSP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3757 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3758 result = list_merge (sequence_one, sequence_two, check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3759 predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3760 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3761 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3762 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3763 Lisp_Object *array_storage, swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3764 Elemcount array_length, i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3765 Boolint reverse_order = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3767 if (!CONSP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3768 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3769 /* Make sequence_one the cons, sequence_two the array: */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3770 swap = sequence_one;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3771 sequence_one = sequence_two;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3772 sequence_two = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3773 reverse_order = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3774 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3775
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3776 if (VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3777 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3778 array_storage = XVECTOR_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3779 array_length = XVECTOR_LENGTH (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3780 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3781 else if (STRINGP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3782 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3783 Ibyte *strdata = XSTRING_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3784 array_length = string_char_length (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3785 /* No need to GCPRO, characters are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3786 STRING_DATA_TO_OBJECT_ARRAY (strdata, array_storage, i,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3787 array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3788
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3789 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3790 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3791 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3792 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3793 array_length = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3794 /* No need to GCPRO, fixnums are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3795 BIT_VECTOR_TO_OBJECT_ARRAY (v, array_storage, i, array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3796 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3797
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3798 result = list_array_merge_into_list (sequence_one,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3799 array_storage, array_length,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3800 check_merge, predicate, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3801 reverse_order);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3802 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3804 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3805 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3806 Elemcount sequence_one_len = XFIXNUM (Flength (sequence_one)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3807 sequence_two_len = XFIXNUM (Flength (sequence_two)), i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3808 Elemcount output_len = 1 + sequence_one_len + sequence_two_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3809 Lisp_Object *output = alloca_array (Lisp_Object, output_len),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3810 *sequence_one_storage = NULL, *sequence_two_storage = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3811 Boolint do_coerce = !(EQ (type, Qvector) || EQ (type, Qstring)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3812 || EQ (type, Qbit_vector) || EQ (type, Qlist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3813 Ibyte *strdata = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3814 Lisp_Bit_Vector *v = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3815 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3816
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3817 output[0] = do_coerce ? Qlist : type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3818 for (i = 1; i < output_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3819 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3820 output[i] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3821 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3822
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3823 GCPRO1 (output[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3824 gcpro1.nvars = output_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3825
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3826 if (VECTORP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3827 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3828 sequence_one_storage = XVECTOR_DATA (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3829 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3830 else if (STRINGP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3831 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3832 strdata = XSTRING_DATA (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3833 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3834 i, sequence_one_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3835 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3836 else if (BIT_VECTORP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3837 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3838 v = XBIT_VECTOR (sequence_one);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3839 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3840 i, sequence_one_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3841 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3842
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3843 if (VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3845 sequence_two_storage = XVECTOR_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3847 else if (STRINGP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3848 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3849 strdata = XSTRING_DATA (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3850 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3851 i, sequence_two_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3852 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3853 else if (BIT_VECTORP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3854 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3855 v = XBIT_VECTOR (sequence_two);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3856 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3857 i, sequence_two_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3858 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3859
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3860 if (LISTP (sequence_one) && LISTP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3861 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3862 list_list_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3863 sequence_one, sequence_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3864 check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3865 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3866 else if (LISTP (sequence_one))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3867 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3868 list_array_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3869 sequence_one,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3870 sequence_two_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3871 sequence_two_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3872 check_merge, predicate, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3873 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3874 else if (LISTP (sequence_two))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3875 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3876 list_array_merge_into_array (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3877 sequence_two,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3878 sequence_one_storage,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3879 sequence_one_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3880 check_merge, predicate, key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3881 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3882 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3883 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3884 array_merge (output + 1, output_len - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3885 sequence_one_storage, sequence_one_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3886 sequence_two_storage, sequence_two_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3887 check_merge, predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3888 key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3889 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3890
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3891 result = Ffuncall (output_len, output);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3892
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3893 if (do_coerce)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3894 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3895 result = call2 (Qcoerce, result, type);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3896 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3897
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3898 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3899 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3900
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3901 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3902 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3903
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3904 Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3905 list_sort (Lisp_Object list, check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3906 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3907 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3908 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3909 Lisp_Object back, tem;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3910 Lisp_Object front = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3911 Lisp_Object len = Flength (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3912
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3913 if (XFIXNUM (len) < 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3914 return list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3915
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3916 len = make_fixnum (XFIXNUM (len) / 2 - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3917 tem = Fnthcdr (len, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3918 back = Fcdr (tem);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3919 Fsetcdr (tem, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3920
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3921 GCPRO4 (front, back, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3922 front = list_sort (front, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3923 back = list_sort (back, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3924
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3925 RETURN_UNGCPRO (list_merge (front, back, check_merge, predicate, key));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3926 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3927
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3928 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3929 array_sort (Lisp_Object *array, Elemcount array_len,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3930 check_test_func_t check_merge,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3931 Lisp_Object predicate, Lisp_Object key)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3932 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3933 Elemcount split;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3934
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3935 if (array_len < 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3936 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3937
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3938 split = array_len / 2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3939
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3940 array_sort (array, split, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3941 array_sort (array + split, array_len - split, check_merge, predicate,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3942 key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3943 array_merge (array, array_len, array, split, array + split,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3944 array_len - split, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3945 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3947 DEFUN ("sort*", FsortX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3948 Sort SEQUENCE, comparing elements using PREDICATE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3949 Returns the sorted sequence. SEQUENCE is modified by side effect.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3950
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3951 PREDICATE is called with two elements of SEQUENCE, and should return t if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3952 the first element is `less' than the second.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3954 Optional keyword argument KEY is a function used to extract an object to be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3955 used for comparison from each element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3956
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3957 In this implementation, sorting is always stable; but call `stable-sort' if
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3958 this stability is important to you, other implementations may not make the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3959 same guarantees.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3961 arguments: (SEQUENCE PREDICATE &key (KEY #'IDENTITY))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3962 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3963 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3964 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3965 Lisp_Object sequence = args[0], predicate = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3966 Lisp_Object *sequence_carray;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3967 check_test_func_t check_merge = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3968 Elemcount sequence_len, i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3969
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3970 PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3972 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3973
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3974 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3975
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3976 check_merge = get_merge_predicate (predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3977
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3978 if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3979 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3980 sequence = list_sort (sequence, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3981 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3982 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3983 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3984 array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3985 check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3986 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3987 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3988 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3989 Ibyte *strdata = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3990
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3991 sequence_len = string_char_length (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3992
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3993 STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3994
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3995 /* No GCPRO necessary, characters are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3996 array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3997
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3998 strdata = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
3999
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4000 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4001 for (i = 0; i < sequence_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4002 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4003 strdata += set_itext_ichar (strdata, XCHAR (sequence_carray[i]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4005
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4006 init_string_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4007 bump_string_modiff (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4008 sledgehammer_check_ascii_begin (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4009 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4010 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4011 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4012 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4013 sequence_len = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4014
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4015 BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4017 /* No GCPRO necessary, bits are immediate. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4018 array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4019
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4020 for (i = 0; i < sequence_len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4021 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4022 set_bit_vector_bit (v, i, XFIXNUM (sequence_carray [i]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4023 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4024 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4025
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4026 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4027 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4028
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4029
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4030 static Lisp_Object replace_string_range_1 (Lisp_Object dest,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4031 Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4032 Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4033 const Ibyte *source,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4034 const Ibyte *source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4035 Lisp_Object item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4036
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4037 /* Fill the substring of DEST beginning at START and ending before END with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4038 the character ITEM. If DEST does not have sufficient space for END -
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4039 START characters at START, write as many as is possible without changing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4040 the character length of DEST. Update the string modification flag and do
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4041 any sledgehammer checks we have turned on.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4042
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4043 START must be a Lisp integer. END can be nil, indicating the length of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4044 string, or a Lisp integer. The condition (<= 0 START END (length DEST))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4045 must hold, or fill_string_range() will signal an error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4046 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4047 fill_string_range (Lisp_Object dest, Lisp_Object item, Lisp_Object start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4048 Lisp_Object end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4049 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4050 return replace_string_range_1 (dest, start, end, NULL, NULL, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4051 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4052
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4053 DEFUN ("fill", Ffill, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4054 Destructively modify SEQUENCE by replacing each element with ITEM.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4055 SEQUENCE is a list, vector, bit vector, or string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4056
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4057 Optional keyword START is the index of the first element of SEQUENCE
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4058 to be modified, and defaults to zero. Optional keyword END is the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4059 exclusive upper bound on the elements of SEQUENCE to be modified, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4060 defaults to the length of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4061
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4062 arguments: (SEQUENCE ITEM &key (START 0) (END (length SEQUENCE)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4063 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4064 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4065 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4066 Lisp_Object sequence = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4067 Lisp_Object item = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4068 Elemcount starting, ending = MOST_POSITIVE_FIXNUM + 1, ii, len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4069
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4070 PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4071
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4072 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4073 starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4074
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4075 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4076 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4077 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4078 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4080
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4081 retry:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4082 if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4083 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4084 CHECK_CHAR_COERCE_INT (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4085 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4086
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4087 fill_string_range (sequence, item, start, end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4088 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4089 else if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4090 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4091 Lisp_Object *p = XVECTOR_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4092
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4093 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4094 len = XVECTOR_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4095
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4096 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4097 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4098
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4099 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4101 p[ii] = item;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4102 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4104 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4105 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4106 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4107 int bit;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4108
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4109 CHECK_BIT (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4110 bit = XFIXNUM (item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4111 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4112 len = bit_vector_length (v);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4113
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4114 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4115 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4116
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4117 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4119 set_bit_vector_bit (v, ii, bit);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4120 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4121 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4122 else if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4123 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4124 Elemcount counting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4125
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4127 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4128 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4129 if (counting >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4130 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4131 if (counting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4132 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4133 XSETCAR (tail, item);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4134 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4135 else if (counting == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4136 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4137 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4138 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4139 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4140 ++counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4142 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4143
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4144 if (counting < starting || (counting != ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4145 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4146 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4148 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4149 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4150 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4151 sequence = wrong_type_argument (Qsequencep, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4152 goto retry;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4153 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4154 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4155 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4156
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4157
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4158 /* Replace the substring of DEST beginning at START and ending before END
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4159 with the text at SOURCE, which is END - START characters long and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4160 SOURCE_LIMIT - SOURCE octets long. If DEST does not have sufficient
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4161 space for END - START characters at START, write as many as is possible
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4162 without changing the length of DEST. Update the string modification flag
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4163 and do any sledgehammer checks we have turned on in this build.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4164
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4165 START must be a Lisp integer. END can be nil, indicating the length of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4166 string, or a Lisp integer. The condition (<= 0 START END (length DEST))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4167 must hold, or replace_string_range() will signal an error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4168 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4169 replace_string_range (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4170 const Ibyte *source, const Ibyte *source_limit)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4171 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4172 return replace_string_range_1 (dest, start, end, source, source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4173 Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4174 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4175
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4176 /* This is the guts of several mapping functions.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4177
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4178 Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4179 taking the elements from SEQUENCES. If VALS is non-NULL, store the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4180 results into VALS, a C array of Lisp_Objects; else, if LISP_VALS is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4181 non-nil, store the results into LISP_VALS, a sequence with sufficient
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4182 room for CALL_COUNT results (but see the documentation of SOME_OR_EVERY.)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4183 Else, do not accumulate any result.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4184
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4185 If VALS is non-NULL, NSEQUENCES is one, and SEQUENCES[0] is a cons,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4186 mapcarX will store the elements of SEQUENCES[0] in stack and GCPRO them,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4187 so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4188 mapcarX.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4189
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4190 Otherwise, mapcarX signals an invalid state error (see
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4191 mapping_interaction_error(), above) if it encounters a non-cons,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4192 non-array when traversing SEQUENCES. Common Lisp specifies in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4193 MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4194 destructively modifies SEQUENCES in a way that might affect the ongoing
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4195 traversal operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4196
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4197 CALLER is a symbol describing the Lisp-visible function that was called,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4198 and any errors thrown because SEQUENCES was modified will reflect it.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4199
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4200 If CALLER is Qsome, return the (possibly multiple) values given by
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4201 FUNCTION the first time it is non-nil, and abandon the iterations.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4202 LISP_VALS must be the result of calling STORE_VOID_IN_LISP on the address
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4203 of a Lisp object, and the return value will be stored at that address.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4204 If CALLER is Qevery, LISP_VALS must also reflect a pointer to a Lisp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4205 object, and Qnil will be stored at that address if FUNCTION gives nil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4206 otherwise it will be left alone. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4207
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4208 static void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4209 mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4210 Lisp_Object function, int nsequences, Lisp_Object *sequences,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4211 Lisp_Object caller)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4212 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4213 Lisp_Object called, *args;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4214 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4215 Ibyte *lisp_vals_staging = NULL, *cursor = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4216 int i, j;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4217
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4218 assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4219
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4220 args = alloca_array (Lisp_Object, nsequences + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4221 args[0] = function;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4222 for (i = 1; i <= nsequences; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4223 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4224 args[i] = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4225 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4226
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4227 if (vals != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4228 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4229 GCPRO2 (args[0], vals[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4230 gcpro1.nvars = nsequences + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4231 gcpro2.nvars = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4232 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4233 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4234 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4235 GCPRO1 (args[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4236 gcpro1.nvars = nsequences + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4237 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4238
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4239 /* Be extra nice in the event that we've been handed one list and one
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4240 only; make it possible for FUNCTION to set cdrs not yet processed to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4241 non-cons, non-nil objects without ill-effect, if we have been handed
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4242 the stack space to do that. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4243 if (vals != NULL && 1 == nsequences && CONSP (sequences[0]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4244 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4245 Lisp_Object lst = sequences[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4246 Lisp_Object *val = vals;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4247 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4248 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4249 *val++ = XCAR (lst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4250 lst = XCDR (lst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4251 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4252 gcpro2.nvars = call_count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4253
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4254 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4255 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4256 args[1] = vals[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4257 vals[i] = IGNORE_MULTIPLE_VALUES (Ffuncall (nsequences + 1, args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4258 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4259 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4260 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4261 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4262 enum lrecord_type lisp_vals_type = lrecord_type_symbol;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4263 Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4264 for (j = 0; j < nsequences; ++j)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4266 sequence_types[j] = XRECORD_LHEADER (sequences[j])->type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4267 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4269 if (!EQ (caller, Qsome) && !EQ (caller, Qevery))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4270 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4271 assert (LRECORDP (lisp_vals));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4272
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4273 lisp_vals_type
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4274 = (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4275
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4276 if (lrecord_type_string == lisp_vals_type)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4277 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4278 lisp_vals_staging = cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4279 = alloca_ibytes (call_count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4280 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4281 else if (ARRAYP (lisp_vals))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4282 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4283 CHECK_LISP_WRITEABLE (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4284 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4285 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4286
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4287 for (i = 0; i < call_count; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4288 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4289 for (j = 0; j < nsequences; ++j)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4290 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4291 switch (sequence_types[j])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4292 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4293 case lrecord_type_cons:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4294 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4295 if (!CONSP (sequences[j]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4296 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4297 /* This means FUNCTION has messed around with a cons
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4298 in one of the sequences, since we checked the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4299 type (CHECK_SEQUENCE()) and the length and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4300 structure (with Flength()) correctly in our
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4301 callers. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4302 mapping_interaction_error (caller, sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4303 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4304 args[j + 1] = XCAR (sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4305 sequences[j] = XCDR (sequences[j]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4306 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4307 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4308 case lrecord_type_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4309 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4310 args[j + 1] = XVECTOR_DATA (sequences[j])[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4311 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4312 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4313 case lrecord_type_string:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4314 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4315 args[j + 1] = make_char (string_ichar (sequences[j], i));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4316 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4317 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4318 case lrecord_type_bit_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4319 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4320 args[j + 1]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4321 = make_fixnum (bit_vector_bit (XBIT_VECTOR (sequences[j]),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4322 i));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4323 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4324 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4325 default:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4326 ABORT();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4327 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4328 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4329 called = Ffuncall (nsequences + 1, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4330 if (vals != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4331 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4332 vals[i] = IGNORE_MULTIPLE_VALUES (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4333 gcpro2.nvars += 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4334 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4335 else if (EQ (Qsome, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4336 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4337 if (!NILP (IGNORE_MULTIPLE_VALUES (called)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4338 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4339 Lisp_Object *result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4340 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4341 *result = called;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4342 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4343 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4344 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4345 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4346 else if (EQ (Qevery, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4347 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4348 if (NILP (IGNORE_MULTIPLE_VALUES (called)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4349 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4350 Lisp_Object *result
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4351 = (Lisp_Object *) GET_VOID_FROM_LISP (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4352 *result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4353 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4354 return;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4355 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4356 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4357 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4359 called = IGNORE_MULTIPLE_VALUES (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4360 switch (lisp_vals_type)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4361 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4362 case lrecord_type_symbol:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4363 /* Discard the result of funcall. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4364 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4365 case lrecord_type_cons:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4366 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4367 if (!CONSP (lisp_vals))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4368 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4369 /* If FUNCTION has inserted a non-cons non-nil
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4370 cdr into the list before we've processed the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4371 relevant part, error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4372 mapping_interaction_error (caller, lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4373 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4374 XSETCAR (lisp_vals, called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4375 lisp_vals = XCDR (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4376 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4377 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4378 case lrecord_type_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4379 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4380 i < XVECTOR_LENGTH (lisp_vals) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4381 (XVECTOR_DATA (lisp_vals)[i] = called) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4382 /* Let #'aset error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4383 Faset (lisp_vals, make_fixnum (i), called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4384 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4385 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4386 case lrecord_type_string:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4387 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4388 CHECK_CHAR_COERCE_INT (called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4389 cursor += set_itext_ichar (cursor, XCHAR (called));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4390 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4391 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4392 case lrecord_type_bit_vector:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4393 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4394 (BITP (called) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4395 i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4396 set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4397 XFIXNUM (called)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4398 (void) Faset (lisp_vals, make_fixnum (i), called);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4399 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4400 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4401 default:
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4402 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4403 ABORT();
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4404 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4405 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4406 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4407 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4408 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4409
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4410 if (lisp_vals_staging != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4411 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4412 CHECK_LISP_WRITEABLE (lisp_vals);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4413 replace_string_range (lisp_vals, Qzero, make_fixnum (call_count),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4414 lisp_vals_staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4415 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4416 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4417
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4418 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4419 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4420
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4421 /* Given NSEQUENCES objects at the address pointed to by SEQUENCES, return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4422 the length of the shortest sequence. Error if all are circular, or if any
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4423 one of them is not a sequence. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4424 static Elemcount
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4425 shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4426 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4427 Elemcount len = 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4428 Lisp_Object length = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4429 int i;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4430
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4431 for (i = 0; i < nsequences; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4432 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4433 if (CONSP (sequences[i]))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4434 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4435 length = Flist_length (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4436 if (!NILP (length))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4437 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4438 len = min (len, XFIXNUM (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4439 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4440 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4441 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4443 CHECK_SEQUENCE (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4444 length = Flength (sequences[i]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4445 len = min (len, XFIXNUM (length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4446 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4447 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4448
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4449 if (len == 1 + MOST_POSITIVE_FIXNUM)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4450 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4451 signal_circular_list_error (sequences[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4452 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4453
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4454 return len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4455 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4456
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4457 DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4458 Call FUNCTION on each element of SEQUENCE, and concat results to a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4459 Between each pair of results, insert SEPARATOR.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4461 Each result, and SEPARATOR, should be strings. Thus, using " " as SEPARATOR
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4462 results in spaces between the values returned by FUNCTION. SEQUENCE itself
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4463 may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4465 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4466 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4467 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4468 `mapconcat' will give up once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4470 arguments: (FUNCTION SEQUENCE SEPARATOR &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4471 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4472 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4473 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4474 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4475 Lisp_Object sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4476 Lisp_Object separator = args[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4477 Elemcount len = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4478 Lisp_Object *args0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4479 EMACS_INT i, nargs0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4480
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4481 args[2] = sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4482 args[1] = separator;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4484 len = shortest_length_among_sequences (nargs - 2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4485
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4486 if (len == 0) return build_ascstring ("");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4487
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4488 nargs0 = len + len - 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4489 args0 = alloca_array (Lisp_Object, nargs0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4490
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4491 /* Special-case this, it's very common and doesn't require any
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4492 funcalls. Upside of doing it here, instead of cl-macs.el: no consing,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4493 apart from the final string, we allocate everything on the stack. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4494 if (EQ (function, Qidentity) && 3 == nargs && CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4495 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4496 for (i = 0; i < len; ++i)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4497 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4498 args0[i] = XCAR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4499 sequence = XCDR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4500 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4501 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4502 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4503 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4504 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4505 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4506
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4507 for (i = len - 1; i >= 0; i--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4508 args0[i + i] = args0[i];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4509
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4510 for (i = 1; i < nargs0; i += 2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4511 args0[i] = separator;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4512
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4513 return Fconcat (nargs0, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4514 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4515
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4516 DEFUN ("mapcar*", FmapcarX, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4517 Call FUNCTION on each element of SEQUENCE; return a list of the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4518 The result is a list of the same length as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4519 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4520
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4521 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4522 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4523 from each sequence will be used each time FUNCTION is called, and `mapcar'
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4524 stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4525
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4526 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4527 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4528 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4529 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4530 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4531 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4532 Lisp_Object *args0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4533
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4534 args0 = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4535 mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4536
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4537 return Flist ((int) len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4538 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4539
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4540 DEFUN ("mapvector", Fmapvector, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4541 Call FUNCTION on each element of SEQUENCE; return a vector of the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4542 The result is a vector of the same length as SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4543 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4545 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4546 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4547 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4548 `mapvector' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4549
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4550 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4551 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4552 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4553 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4554 Lisp_Object function = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4555 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4556 Lisp_Object result = make_vector (len, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4558 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4559 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4560 /* Don't pass result as the lisp_object argument, we want mapcarX to protect
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4561 a single list argument's elements from being garbage-collected. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4562 mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4563 Qmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4564 RETURN_UNGCPRO (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4565 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4566
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4567 DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4568 Call FUNCTION on each element of SEQUENCE; chain the results together.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4569
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4570 FUNCTION must normally return a list; the results will be concatenated
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4571 together using `nconc'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4572
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4573 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4574 there are SEQUENCES, plus one for the element from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4575 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4576 `mapcan' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4577
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4578 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4579 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4580 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4581 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4582 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4583 Lisp_Object function = args[0], *result = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4584
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4585 mapcarX (len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4586
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4587 /* #'nconc GCPROs its args in case of signals and error. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4588 return Fnconc (len, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4589 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4590
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4591 DEFUN ("mapc", Fmapc, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4592 Call FUNCTION on each element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4593
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4594 SEQUENCE may be a list, a vector, a bit vector, or a string.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4595 This function is like `mapcar' but does not accumulate the results,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4596 which is more efficient if you do not use the results.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4597
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4598 With optional SEQUENCES, call FUNCTION each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4599 there are SEQUENCES, plus one for the elements from SEQUENCE. One element
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4600 from each sequence will be used each time FUNCTION is called, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4601 `mapc' stops calling FUNCTION once the shortest sequence is exhausted.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4602
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4603 Return SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4604
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4605 arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4606 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4607 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4609 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4610 Lisp_Object sequence = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4611 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4612 /* We need to GCPRO sequence, because mapcarX will modify the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4613 elements of the args array handed to it, and this may involve
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4614 elements of sequence getting garbage collected. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4615 GCPRO1 (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4616 mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1, Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4617 RETURN_UNGCPRO (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4618 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4619
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4620 DEFUN ("map", Fmap, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4621 Map FUNCTION across one or more sequences, returning a sequence.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4622
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4623 TYPE is the sequence type to return, FUNCTION is the function, SEQUENCE is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4624 the first argument sequence, SEQUENCES are the other argument sequences.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4625
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4626 FUNCTION will be called with (1+ (length SEQUENCES)) arguments, and must be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4627 capable of accepting this number of arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4628
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4629 Certain TYPEs are recognised internally by `map', but others are not, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4630 `coerce' may throw an error on an attempt to convert to a TYPE it does not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4631 understand. A null TYPE means do not accumulate any values.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4632
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4633 arguments: (TYPE FUNCTION SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4634 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4635 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4636 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4637 Lisp_Object type = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4638 Lisp_Object function = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4639 Lisp_Object result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4640 Lisp_Object *args0 = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4641 Elemcount len = shortest_length_among_sequences (nargs - 2, args + 2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4642 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4643
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4644 if (!NILP (type))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4645 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4646 args0 = alloca_array (Lisp_Object, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4647 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4648
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4649 mapcarX (len, args0, Qnil, function, nargs - 2, args + 2, Qmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4651 if (EQ (type, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4652 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4653 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4654 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4655
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4656 if (EQ (type, Qvector) || EQ (type, Qarray))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4657 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4658 result = Fvector (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4659 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4660 else if (EQ (type, Qstring))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4661 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4662 result = Fstring (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4663 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4664 else if (EQ (type, Qlist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4665 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4666 result = Flist (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4667 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4668 else if (EQ (type, Qbit_vector))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4669 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4670 result = Fbit_vector (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4671 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4672 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4673 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4674 result = Flist (len, args0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4675 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4676 result = call2 (Qcoerce, result, type);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4677 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4678 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4679
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4680 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4681 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4682
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4683 DEFUN ("map-into", Fmap_into, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4684 Modify RESULT-SEQUENCE using the return values of FUNCTION on SEQUENCES.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4685
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4686 RESULT-SEQUENCE and SEQUENCES can be lists or arrays.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4687
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4688 FUNCTION must accept at least as many arguments as there are SEQUENCES
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4689 \(possibly zero). If RESULT-SEQUENCE and the elements of SEQUENCES are not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4690 the same length, stop when the shortest is exhausted; any elements of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4691 RESULT-SEQUENCE beyond that are unmodified.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4692
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4693 Return RESULT-SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4695 arguments: (RESULT-SEQUENCE FUNCTION &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4696 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4697 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4698 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4699 Elemcount len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4700 Lisp_Object result_sequence = args[0];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4701 Lisp_Object function = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4702
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4703 args[0] = function;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4704 args[1] = result_sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4705
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4706 len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4707
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4708 mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4709 Qmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4710
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4711 return result_sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4713
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4714 DEFUN ("some", Fsome, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4715 Return true if PREDICATE gives non-nil for an element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4717 If so, return the value (possibly multiple) given by PREDICATE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4718
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4719 With optional SEQUENCES, call PREDICATE each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4720 there are SEQUENCES (plus one for the element from SEQUENCE).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4721
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4722 See also `find-if', which returns the corresponding element of SEQUENCE,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4723 rather than the value given by PREDICATE, and accepts bounding index
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4724 keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4725
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4726 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4727 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4728 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4729 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4730 Lisp_Object result = Qnil,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4731 result_ptr = STORE_VOID_IN_LISP ((void *) &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4732 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4733
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4734 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4735
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4736 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4738
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4739 DEFUN ("every", Fevery, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4740 Return true if PREDICATE is true of every element of SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4741
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4742 With optional SEQUENCES, call PREDICATE each time with as many arguments as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4743 there are SEQUENCES (plus one for the element from SEQUENCE).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4744
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4745 In contrast to `some', `every' never returns multiple values.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4746
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4747 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4748 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4749 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4750 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4751 Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4752 Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4753
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4754 mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4755
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4756 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4757 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4758
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4760 DEFUN ("reduce", Freduce, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4761 Combine the elements of SEQUENCE using FUNCTION, a binary operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4763 For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4764 SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4765 in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4766
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4767 Keywords supported: :start :end :from-end :initial-value :key
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4768 See `remove*' for the meaning of :start, :end, :from-end and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4769
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4770 :initial-value specifies an element (typically an identity element, such as
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4771 0) that is conceptually prepended to the sequence (or appended, when
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4772 :from-end is given).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4774 If the sequence has one element, that element is returned directly.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4775 If the sequence has no elements, :initial-value is returned if given;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4776 otherwise, FUNCTION is called with no arguments, and its result returned.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4777
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4778 arguments: (FUNCTION SEQUENCE &key (START 0) (END (length SEQUENCE)) FROM-END INITIAL-VALUE (KEY #'identity))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4779 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4780 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4781 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4782 Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4783 Elemcount starting, ending = MOST_POSITIVE_FIXNUM + 1, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4785 PARSE_KEYWORDS (Freduce, nargs, args, 5,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4786 (start, end, from_end, initial_value, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4787 (start = Qzero, initial_value = Qunbound));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4788
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4789 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4790 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4791 starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4792 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4793
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4794 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4795 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4796 #define CALL2(function, accum, item) \
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4797 IGNORE_MULTIPLE_VALUES (call2 (function, accum, item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4798
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4799 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4800 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4801 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4802 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4803 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4804
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4805 if (VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4806 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4807 Lisp_Vector *vv = XVECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4808 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4810 check_sequence_range (sequence, start, end, make_fixnum (vv->size));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4812 ending = min (ending, vv->size);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4813
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4814 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4815
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4816 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4817 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4818 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4819 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4820 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4821 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4822 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4823 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4824 accum = KEY (key, vv->contents[starting]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4825 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4827 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4829 accum = KEY (key, vv->contents[ending - 1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4830 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4831 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4832 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4833
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4834 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4835 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4836 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4837 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4838 accum = CALL2 (function, accum, KEY (key, vv->contents[ii]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4839 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4840 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4841 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4842 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4843 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4844 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4845 accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4846 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4847 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4848
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4849 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4850 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4851 else if (BIT_VECTORP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4852 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4853 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4854 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4856 check_sequence_range (sequence, start, end, make_fixnum (bv->size));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4857 ending = min (ending, bv->size);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4859 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4860
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4861 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4862 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4863 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4864 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4865 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4866 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4867 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4868 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4869 accum = KEY (key, make_fixnum (bit_vector_bit (bv, starting)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4870 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4871 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4872 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4873 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4874 accum = KEY (key, make_fixnum (bit_vector_bit (bv, ending - 1)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4875 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4876 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4877 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4878
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4879 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4881 for (ii = starting; ii < ending; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4882 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4883 accum = CALL2 (function, accum,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4884 KEY (key, make_fixnum (bit_vector_bit (bv, ii))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4885 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4886 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4887 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4888 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4889 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4890 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4891 accum = CALL2 (function, KEY (key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4892 make_fixnum (bit_vector_bit (bv,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4893 ii))),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4894 accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4895 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4896 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4897
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4898 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4899
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4900 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4901 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4902 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4903 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4904
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4905 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4906
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4907 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4908 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4909 Bytecount byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4910 Bytecount cursor_offset = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4911 const Ibyte *startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4912 const Ibyte *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4913
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4914 for (ii = 0; ii != starting && cursor_offset < byte_len; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4915 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4916 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4917 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4918 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4919
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4920 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4921 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4922 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4923 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4924 else if (ending - starting && cursor_offset < byte_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4925 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4926 accum = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4927 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4928 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4929 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4930
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4931 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4932 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4933 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4934 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4935 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4937 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4938 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4939 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4940 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4941
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4942 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4944 accum = CALL2 (function, accum,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4945 KEY (key, make_char (itext_ichar (cursor))));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4946
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4947 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4948 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4949
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4950 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4951 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4952 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4953 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4954 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4955
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4956 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4957 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4958 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4959 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4961 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4963 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4965 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4966 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4967 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4968 Elemcount len = string_char_length (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4969 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4970 const Ibyte *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4972 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4973 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4974 starting = XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4975
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4976 cursor = string_char_addr (sequence, ending - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4977 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4978
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4979 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4981 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4982 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4983 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4984 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4985 accum = KEY (key, make_char (itext_ichar (cursor)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4986 ending--;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4987 if (ending > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4988 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4989 cursor = XSTRING_DATA (sequence) + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4990
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4991 if (!valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4992 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4993 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4994 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4995
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4996 DEC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4997 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4998 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
4999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5000
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5001 for (ii = ending - 1; ii >= starting; --ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5002 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5003 accum = CALL2 (function, KEY (key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5004 make_char (itext_ichar (cursor))),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5005 accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5006 if (ii > 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5007 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5008 cursor = XSTRING_DATA (sequence) + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5009
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5010 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5011 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5012 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5013 mapping_interaction_error (Qreduce, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5014 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5015
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5016 DEC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5017 cursor_offset = cursor - XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5018 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5019 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5020 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5021
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5022 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5023 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5024 else if (LISTP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5025 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5026 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5027 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5028 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5029
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5030 GCPRO1 (accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5031
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5032 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5033 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5034 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5035 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5036 else if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5037 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5038 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5039 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5040 if (ii == starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5041 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5042 accum = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5043 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5044 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5045 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5046 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5047 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5048 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5049 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5050
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5051 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5052
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5053 if (ending - starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5054 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5055 GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5056 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5057 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5058 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5059 if (ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5060 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5061 accum = CALL2 (function, accum, KEY (key, elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5062 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5063 else if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5064 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5065 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5066 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5067 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5068 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5070 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5071 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5072
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5073 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5074
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5075 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5076 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5077 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5078 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5080 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5081 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5082 Boolint need_accum = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5083 Lisp_Object *subsequence = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5084 Elemcount counting = 0, len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5085 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5086
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5087 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5088 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5089 ending = min (ending, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5090
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5091 /* :from-end with a list; make an alloca copy of the relevant list
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5092 data, attempting to go backwards isn't worth the trouble. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5093 if (!UNBOUNDP (initial_value))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5094 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5095 accum = initial_value;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5096 if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5097 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5098 subsequence = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5099 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5100 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5101 else if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5102 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5103 subsequence = alloca_array (Lisp_Object, ending - starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5104 need_accum = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5105 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5106
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5107 if (ending - starting && starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5108 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5109 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5111 if (counting >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5112 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5113 if (counting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5114 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5115 subsequence[ii++] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5116 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5117 else if (counting == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5119 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5120 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5121 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5122 ++counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5123 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5124 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5125
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5126 if (subsequence != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5127 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5128 len = ending - starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5129 /* If we could be sure that neither FUNCTION nor KEY modify
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5130 SEQUENCE, this wouldn't be necessary, since all the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5131 elements of SUBSEQUENCE would definitely always be
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5132 reachable via SEQUENCE. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5133 GCPRO1 (subsequence[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5134 gcpro1.nvars = len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5135 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5136
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5137 if (need_accum)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5138 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5139 accum = KEY (key, subsequence[len - 1]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5140 --len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5141 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5142
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5143 for (ii = len; ii != 0;)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5144 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5145 --ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5146 accum = CALL2 (function, KEY (key, subsequence[ii]), accum);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5148
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5149 if (subsequence != NULL)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5150 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5151 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5152 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5153 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5155
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5156 /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5157 need to return the result of calling FUNCTION with zero
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5158 arguments. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5159 if (UNBOUNDP (accum))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5161 accum = IGNORE_MULTIPLE_VALUES (call0 (function));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5162 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5163
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5164 return accum;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5165 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5166
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5167 /* This function is the implementation of fill_string_range() and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5168 replace_string_range(); see the comments for those functions. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5169 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5170 replace_string_range_1 (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5171 const Ibyte *source, const Ibyte *source_limit,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5172 Lisp_Object item)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5173 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5174 Ibyte *destp = XSTRING_DATA (dest), *p = destp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5175 *pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5176 Bytecount prefix_bytecount, source_len = source_limit - source;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5177 Charcount ii = 0, ending, len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5178 Charcount starting = BIGNUMP (start) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5179 Elemcount delta;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5180
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5181 while (ii < starting && p < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5182 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5183 INC_IBYTEPTR (p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5184 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5185 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5186
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5187 pcursor = p;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5188
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5189 if (NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5190 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5191 while (pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5192 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5193 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5194 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5195 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5196
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5197 ending = len = ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5198 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5199 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5200 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5201 ending = BIGNUMP (end) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5202 while (ii < ending && pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5203 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5204 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5205 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5206 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5207 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5208
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5209 if (pcursor == pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5210 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5211 /* We have the length, check it for our callers. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5212 check_sequence_range (dest, start, end, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5213 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5215 if (!(p == pend || p == pcursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5216 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5217 prefix_bytecount = p - destp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5218
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5219 if (!NILP (item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5220 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5221 assert (source == NULL && source_limit == NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5222 source_len = set_itext_ichar (item_buf, XCHAR (item));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5223 delta = (source_len * (ending - starting)) - (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5224 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5225 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5226 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5227 assert (source != NULL && source_limit != NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5228 delta = source_len - (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5229 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5230
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5231 if (delta)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5232 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5233 resize_string (dest, prefix_bytecount, delta);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5234 destp = XSTRING_DATA (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5235 pcursor = destp + prefix_bytecount + (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5236 p = destp + prefix_bytecount;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5237 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5238
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5239 if (CHARP (item))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5240 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5241 while (starting < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5242 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5243 memcpy (p, item_buf, source_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5244 p += source_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5245 starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5246 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5247 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5248 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5249 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5250 while (starting < ending && source < source_limit)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5251 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5252 source_len = itext_copy_ichar (source, p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5253 p += source_len, source += source_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5254 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5255 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5256
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5257 init_string_ascii_begin (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5258 bump_string_modiff (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5259 sledgehammer_check_ascii_begin (dest);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5260 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5261
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5262 return dest;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5263 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5264
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5265 DEFUN ("replace", Freplace, 2, MANY, 0, /*
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5266 Replace the elements of SEQUENCE1 with the elements of SEQUENCE2.
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5267
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5268 SEQUENCE1 is destructively modified, and returned. Its length is not
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5269 changed.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5270
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5271 Keywords :start1 and :end1 specify a subsequence of SEQUENCE1, and
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5272 :start2 and :end2 a subsequence of SEQUENCE2. See `search' for more
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5273 information.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5274
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
5275 arguments: (SEQUENCE1 SEQUENCE2 &key (START1 0) (END1 (length SEQUENCE1)) (START2 0) (END2 (length SEQUENCE2)))
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5276 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5277 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5278 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5279 Lisp_Object sequence1 = args[0], sequence2 = args[1],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5280 result = sequence1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5281 Elemcount starting1, ending1 = MOST_POSITIVE_FIXNUM + 1, starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5282 Elemcount ending2 = MOST_POSITIVE_FIXNUM + 1, counting = 0, startcounting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5283 Boolint sequence1_listp, sequence2_listp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5284 overwriting = EQ (sequence1, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5285
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5286 PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5287 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5288
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5289 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5290 CHECK_LISP_WRITEABLE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5291
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5292 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5293
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5294 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5295 starting1 = BIGNUMP (start1) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5296 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5297 starting2 = BIGNUMP (start2) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5298
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5299 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5300 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5301 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5302 ending1 = BIGNUMP (end1) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5303 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5304
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5305 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5306 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5307 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5308 ending2 = BIGNUMP (end2) ? MOST_POSITIVE_FIXNUM + 1 : XFIXNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5309 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5310
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5311 sequence1_listp = LISTP (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5312 sequence2_listp = LISTP (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5314 overwriting = overwriting && starting2 <= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5315
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5316 if (sequence1_listp && !ZEROP (start1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5317 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5318 sequence1 = Fnthcdr (start1, sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5319
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5320 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5321 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5322 check_sequence_range (args[0], start1, end1, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5323 /* Give up early here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5324 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5325 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5327 ending1 -= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5328 starting1 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5329 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5330
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5331 if (sequence2_listp && !ZEROP (start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5332 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5333 sequence2 = Fnthcdr (start2, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5334
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5335 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5336 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5337 check_sequence_range (args[1], start1, end1, Flength (args[1]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5338 /* Nothing available to replace sequence1's contents. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5339 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5340 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5341
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5342 ending2 -= starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5343 starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5344 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5345
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5346 if (overwriting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5347 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5348 if (EQ (start1, start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5349 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5350 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5351 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5352
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5353 /* Our ranges may overlap. Save the data that might be overwritten. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5354
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5355 if (CONSP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5356 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5357 Elemcount len = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5358 Lisp_Object *subsequence
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5359 = alloca_array (Lisp_Object, min (ending2, len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5360 Elemcount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5361
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5362 LIST_LOOP_2 (elt, sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5363 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5364 if (counting == ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5365 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5366 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5367 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5368
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5369 subsequence[ii++] = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5370 counting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5371 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5372
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5373 check_sequence_range (sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5374 /* The XFIXNUM (start2) is intentional here; we
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5375 called #'length after doing (nthcdr
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5376 start2 sequence2). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5377 make_fixnum (XFIXNUM (start2) + len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5378 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5379 make_fixnum (XFIXNUM (start2) + len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5380
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5381 while (starting1 < ending1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5382 && starting2 < ending2 && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5384 XSETCAR (sequence1, subsequence[starting2]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5385 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5386 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5387 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5388 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5389 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5390 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5391 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5392 Ibyte *p = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5393 *pend = p + XSTRING_LENGTH (sequence2), *pcursor,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5394 *staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5395 Bytecount ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5396
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5397 while (ii < starting2 && p < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5398 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5399 INC_IBYTEPTR (p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5400 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5401 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5402
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5403 pcursor = p;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5404
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5405 while (ii < ending2 && starting1 < ending1 && pcursor < pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5406 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5407 INC_IBYTEPTR (pcursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5408 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5409 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5410 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5411
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5412 if (pcursor == pend)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5413 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5414 check_sequence_range (sequence1, start1, end1, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5415 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5416 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5417 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5418 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5419 assert ((pcursor - p) > 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5420 staging = alloca_ibytes (pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5421 memcpy (staging, p, pcursor - p);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5422 replace_string_range (result, start1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5423 make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5424 staging, staging + (pcursor - p));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5425 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5426 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5427 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5428 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5429 Elemcount seq_len = XFIXNUM (Flength (sequence2)), ii = 0,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5430 subseq_len = min (min (ending1 - starting1, seq_len - starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5431 min (ending2 - starting2, seq_len - starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5432 Lisp_Object *subsequence = alloca_array (Lisp_Object, subseq_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5433
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5434 check_sequence_range (sequence1, start1, end1, make_fixnum (seq_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5435 check_sequence_range (sequence2, start2, end2, make_fixnum (seq_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5436
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5437 while (starting2 < ending2 && ii < seq_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5438 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5439 subsequence[ii] = Faref (sequence2, make_fixnum (starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5440 ii++, starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5441 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5442
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5443 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5444
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5445 while (starting1 < ending1 && ii < seq_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5446 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5447 Faset (sequence1, make_fixnum (starting1), subsequence[ii]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5448 ii++, starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5449 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5450 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5452 else if (sequence1_listp && sequence2_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5453 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5454 Lisp_Object sequence1_tortoise = sequence1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5455 sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5456 Elemcount shortest_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5457
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5458 counting = startcounting = min (ending1, ending2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5459
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5460 while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5461 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5462 XSETCAR (sequence1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5463 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5464 : Fcar (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5465 sequence1 = CONSP (sequence1) ? XCDR (sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5466 : Fcdr (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5467 sequence2 = CONSP (sequence2) ? XCDR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5468 : Fcdr (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5469
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5470 shortest_len++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5471
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5472 if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5473 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5474 if (counting & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5475 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5476 sequence1_tortoise = XCDR (sequence1_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5477 sequence2_tortoise = XCDR (sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5478 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5479
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5480 if (EQ (sequence1, sequence1_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5481 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5482 signal_circular_list_error (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5483 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5484
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5485 if (EQ (sequence2, sequence2_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5486 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5487 signal_circular_list_error (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5488 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5489 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5490 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5492 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5493 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5494 check_sequence_range (args[0], start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5495 make_fixnum (XFIXNUM (start1) + shortest_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5496 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5497 else if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5498 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5499 check_sequence_range (args[1], start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5500 make_fixnum (XFIXNUM (start2) + shortest_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5501 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5502 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5503 else if (sequence1_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5504 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5505 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5506 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5507 Ibyte *s2_data = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5508 *s2_end = s2_data + XSTRING_LENGTH (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5509 Elemcount char_count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5510 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5511
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5512 while (char_count < starting2 && s2_data < s2_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5513 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5514 INC_IBYTEPTR (s2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5515 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5516 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5518 while (starting1 < ending1 && starting2 < ending2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5519 && s2_data < s2_end && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5520 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5521 character = make_char (itext_ichar (s2_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5522 CONSP (sequence1) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5523 XSETCAR (sequence1, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5524 : Fsetcar (sequence1, character);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5525 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5526 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5527 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5528 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5529 INC_IBYTEPTR (s2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5530 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5531
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5532 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5533 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5534 check_sequence_range (sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5535 make_fixnum (XFIXNUM (start1) + starting1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5536 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5537
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5538 if (s2_data == s2_end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5539 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5540 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5541 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5542 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5543 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5544 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5545 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5546 Elemcount len2 = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5547 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5548
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5549 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5550 while (starting2 < ending2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5551 && starting1 < ending1 && !NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5552 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5553 CHECK_CONS (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5554 XSETCAR (sequence1, Faref (sequence2, make_fixnum (starting2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5555 sequence1 = XCDR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5556 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5557 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5558 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5559
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5560 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5561 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5562 check_sequence_range (args[0], start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5563 make_fixnum (XFIXNUM (start1) + starting1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5564 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5565 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5566 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5567 else if (sequence2_listp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5568 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5569 if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5570 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5571 Elemcount ii = 0, count, len = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5572 Ibyte *staging, *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5573 Lisp_Object obj;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5574
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5575 check_sequence_range (sequence1, start1, end1, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5576 ending1 = min (ending1, len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5577 count = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5578 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5580 while (ii < count && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5581 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5582 obj = CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5583 : Fcar (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5584
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5585 CHECK_CHAR_COERCE_INT (obj);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5586 cursor += set_itext_ichar (cursor, XCHAR (obj));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5587 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5588 sequence2 = XCDR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5589 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5590
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5591 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5592 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5593 check_sequence_range (sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5594 make_fixnum (XFIXNUM (start2) + ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5595 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5596
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5597 replace_string_range (result, start1, make_fixnum (XFIXNUM (start1) + ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5598 staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5599 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5600 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5601 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5602 Elemcount len = XFIXNUM (Flength (sequence1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5604 check_sequence_range (sequence1, start2, end1, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5605 ending1 = min (ending2, min (ending1, len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5606
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5607 while (starting1 < ending1 && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5608 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5609 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5610 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5611 : Fcar (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5612 sequence2 = XCDR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5613 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5614 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5615 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5616
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5617 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5618 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5619 check_sequence_range (args[1], start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5620 make_fixnum (XFIXNUM (start2) + starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5621 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5622 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5623 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5624 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5625 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5626 if (STRINGP (sequence1) && STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5628 Ibyte *p2 = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5629 *p2end = p2 + XSTRING_LENGTH (sequence2), *p2cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5630 Charcount ii = 0, len1 = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5631
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5632 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5633
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5634 while (ii < starting2 && p2 < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5635 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5636 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5637 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5638 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5639
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5640 p2cursor = p2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5641 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5642
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5643 while (ii < ending2 && starting1 < ending1 && p2cursor < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5644 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5645 INC_IBYTEPTR (p2cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5646 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5647 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5648 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5649
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5650 if (p2cursor == p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5651 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5652 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5653 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5654
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5655 /* This isn't great; any error message won't necessarily reflect
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5656 the END1 that was supplied to #'replace. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5657 replace_string_range (result, start1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5658 p2, p2cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5659 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5660 else if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5661 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5662 Ibyte *staging, *cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5663 Elemcount count, len1 = string_char_length (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5664 Elemcount len2 = XFIXNUM (Flength (sequence2)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5665 Lisp_Object obj;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5666
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5667 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5668 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5669
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5670 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5671 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5672 count = min (ending1 - starting1, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5673 staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5674
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5675 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5676 while (ii < count)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5677 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5678 obj = Faref (sequence2, make_fixnum (starting2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5679
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5680 CHECK_CHAR_COERCE_INT (obj);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5681 cursor += set_itext_ichar (cursor, XCHAR (obj));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5682 starting2++, ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5683 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5684
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5685 replace_string_range (result, start1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5686 make_fixnum (XFIXNUM (start1) + count),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5687 staging, cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5688 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5689 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5690 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5691 Ibyte *p2 = XSTRING_DATA (sequence2),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5692 *p2end = p2 + XSTRING_LENGTH (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5693 Elemcount len1 = XFIXNUM (Flength (sequence1)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5694
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5695 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5696 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5697
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5698 while (ii < starting2 && p2 < p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5699 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5700 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5701 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5703
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5704 while (p2 < p2end && starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5705 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5706 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5707 make_char (itext_ichar (p2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5708 INC_IBYTEPTR (p2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5709 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5710 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5711 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5713
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5714 if (p2 == p2end)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5715 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5716 check_sequence_range (sequence2, start2, end2, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5717 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5718 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5719 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5720 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5721 Elemcount len1 = XFIXNUM (Flength (sequence1)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5722 len2 = XFIXNUM (Flength (sequence2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5723
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5724 check_sequence_range (sequence1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5725 check_sequence_range (sequence2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5726
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5727 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5728 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5729
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5730 while (starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5731 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5732 Faset (sequence1, make_fixnum (starting1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5733 Faref (sequence2, make_fixnum (starting2)));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5734 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5735 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5736 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5737 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5738 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5739
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5740 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5741 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5742
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5743 DEFUN ("nsubstitute", Fnsubstitute, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5744 Substitute NEW for OLD in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5746 This is a destructive function; it reuses the storage of SEQUENCE whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5747 possible. See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5748
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5749 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5750 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5751 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5752 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5753 Lisp_Object new_ = args[0], item = args[1], sequence = args[2];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5754 Lisp_Object object_, position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5755 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5756 Elemcount len, ii = 0, counting = MOST_POSITIVE_FIXNUM, presenting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5757 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5758 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5760 PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5761 (test, if_, if_not, test_not, key, start, end, count,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5762 from_end), (start = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5763
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5764 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5765 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5766 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5767
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5768 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5769 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5770 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5771 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5772 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5773
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5774 if (!NILP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5775 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5776 CHECK_INTEGER (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5777 if (FIXNUMP (count))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5778 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5779 counting = XFIXNUM (count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5780 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5781 #ifdef HAVE_BIGNUM
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5782 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5783 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5784 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5785 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5786 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5787 #endif
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5788
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5789 if (counting <= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5790 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5791 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5792 }
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5793
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5794 if (!NILP (from_end))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5795 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5796 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (Fnsubstitute))->min_args;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5797 ii < nargs; ii += 2)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5798 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5799 if (EQ (args[ii], Q_count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5800 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5801 args[ii + 1] = Qnil;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5802 break;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5803 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5804 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5805 ii = 0;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
5806 }
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5807 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5808
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5809 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5810 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5811
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5812 if (CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5813 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5814 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5815 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5816 Lisp_Object present = count_with_tail (&object_, nargs - 1, args + 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5817 Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5818
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5819 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5820 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5821 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5822 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5823
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5824 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5825 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5826 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5827
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5829 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5831 if (!(ii < ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5832 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5833 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5834 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5835
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5836 if (starting <= ii &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5837 check_test (test, key, item, elt) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5838 && (presenting ? encountered++ >= presenting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5839 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5840 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5841 CHECK_LISP_WRITEABLE (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5842 XSETCAR (tail, new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5843 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5844 else if (!presenting && encountered >= counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5845 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5846 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5847 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5848
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5849 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5850 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5851 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5852 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5853
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5854 if ((ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5855 && encountered < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5856 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5857 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5858 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5859 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5860 else if (STRINGP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5861 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5862 Ibyte *staging, new_bytes[MAX_ICHAR_LEN], *staging_cursor;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5863 Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5864 Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5865 Bytecount new_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5866 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5867
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5868 CHECK_CHAR_COERCE_INT (new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5869
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5870 new_len = set_itext_ichar (new_bytes, XCHAR (new_));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5871
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5872 /* Worst case scenario; new char is four octets long, all the old ones
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5873 were one octet long, all the old ones match. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5874 staging = alloca_ibytes (XSTRING_LENGTH (sequence) * new_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5875 staging_cursor = staging;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5876
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5877 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5878 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5879 Lisp_Object present = count_with_tail (&character, nargs - 1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5880 args + 1, Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5881
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5882 if (ZEROP (present))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5883 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5884 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5885 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5886
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5887 presenting = XFIXNUM (present);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5888
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5889 /* If there are fewer items in the string than we have
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5890 permission to change, we don't need to differentiate
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5891 between the :from-end nil and :from-end t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5892 cases. Otherwise, presenting is the number of matching
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5893 items we need to ignore before we start to change. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5894 presenting = presenting <= counting ? 0 : presenting - counting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5895 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5897 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5898 while (cursor_offset < byte_len && ii < ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5899 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5900 if (ii >= starting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5901 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5902 character = make_char (itext_ichar (cursor));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5903
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5904 if ((check_test (test, key, item, character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5905 == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5906 && (presenting ? encountered++ >= presenting :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5907 encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5908 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5909 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5910 += itext_copy_ichar (new_bytes, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5911 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5912 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5913 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5914 staging_cursor
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5915 += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5916 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5917
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5918 startp = XSTRING_DATA (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5919 cursor = startp + cursor_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5920
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5921 if (byte_len != XSTRING_LENGTH (sequence)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5922 || !valid_ibyteptr_p (cursor))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5923 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5924 mapping_interaction_error (Qnsubstitute, sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5925 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5926 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5927 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5928 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5929 staging_cursor += itext_copy_ichar (cursor, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5930 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5931
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5932 INC_IBYTEPTR (cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5933 cursor_offset = cursor - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5934 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5935 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5937 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5938 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5939 check_sequence_range (sequence, start, end, Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5940 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5941
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5942 if (0 != encountered)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5943 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5944 CHECK_LISP_WRITEABLE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5945 replace_string_range (sequence, Qzero, make_fixnum (ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5946 staging, staging_cursor);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5948 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5949 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5950 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5951 Elemcount positioning;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5952 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5954 len = XFIXNUM (Flength (sequence));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5955 check_sequence_range (sequence, start, end, make_fixnum (len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5956
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5957 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5958 test_not_unboundp, test, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5959 Qnil, Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5960
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5961 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5962 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5963 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5964 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5965
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5966 positioning = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5967 ending = min (len, ending);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5968
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5969 Faset (sequence, position0, new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5970 encountered = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5971
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5972 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5973 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5974 for (ii = positioning + 1; ii < ending; ii++)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5975 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5976 object_ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5977
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5978 if (check_test (test, key, item, object_) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5979 && encountered++ < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5981 Faset (sequence, make_fixnum (ii), new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5982 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5983 else if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5984 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5985 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5986 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5987 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5988 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5989 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5990 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5991 for (ii = positioning - 1; ii >= starting; ii--)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5992 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5993 object_ = Faref (sequence, make_fixnum (ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5994
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5995 if (check_test (test, key, item, object_) == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5996 && encountered++ < counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5998 Faset (sequence, make_fixnum (ii), new_);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
5999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6000 else if (encountered == counting)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6001 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6002 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6003 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6005 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6007
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6008 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6009 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6010
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6011 DEFUN ("substitute", Fsubstitute, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6012 Substitute NEW for OLD in SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6013
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6014 This is a non-destructive function; it makes a copy of SEQUENCE if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6015 to avoid corrupting the original SEQUENCE.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6017 See `remove*' for the meaning of the keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6018
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6019 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) COUNT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6020 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6021 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6022 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6023 Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6024 Lisp_Object result = Qnil, result_tail = Qnil;
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6025 Lisp_Object object, position0, matched;
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6026 Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0;
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6027 Elemcount ii = 0, counting = MOST_POSITIVE_FIXNUM, skipping = 0;
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6028 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6029 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6030 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6031
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6032 PARSE_KEYWORDS (Fsubstitute, nargs, args, 9,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6033 (test, if_, if_not, test_not, key, start, end, count,
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6034 from_end), (start = Qzero));
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6035
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6036 CHECK_SEQUENCE (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6037
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6038 CHECK_NATNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6039 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6041 if (!NILP (end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6042 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6043 CHECK_NATNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6044 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6045 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6046
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6047 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6048 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6049
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6050 if (!CONSP (sequence))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6051 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6052 position0 = position (&object, item, sequence, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6053 test_not_unboundp, test, key, start, end, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6054 Qnil, Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6055
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6056 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6057 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6058 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6059 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6060 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6061 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6062 args[2] = Fcopy_sequence (sequence);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6063 return Fnsubstitute (nargs, args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6064 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6065 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6066
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6067 if (!NILP (count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6068 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6069 CHECK_INTEGER (count);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6070 if (FIXNUMP (count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6071 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6072 counting = XFIXNUM (count);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6073 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6074 #ifdef HAVE_BIGNUM
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6075 else
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6076 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6077 counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6078 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6079 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6080 #endif
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6081
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6082 if (counting <= 0)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6083 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6084 return sequence;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6085 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6086
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6087 /* Sigh, this is inelegant. Force count_with_tail () to ignore the count
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6088 keyword, so we get the actual number of matching elements, and can
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6089 start removing from the beginning for the from-end case. */
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6090 if (!NILP (from_end))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6091 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6092 for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (Fsubstitute))->min_args;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6093 ii < nargs; ii += 2)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6094 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6095 if (EQ (args[ii], Q_count))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6096 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6097 args[ii + 1] = Qnil;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6098 break;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6099 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6100 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6101 ii = 0;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6102 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6103 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6104
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6105 matched = count_with_tail (&tail, nargs - 1, args + 1, Qsubstitute);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6106
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6107 if (ZEROP (matched))
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6108 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6109 return sequence;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6110 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6111
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6112 if (!NILP (count) && !NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6113 {
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6114 Elemcount matching = XFIXNUM (matched);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6115 if (matching > counting)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6116 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6117 /* skipping is the number of elements to be skipped before we start
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6118 substituting. It is for those cases where both :count and
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6119 :from-end are specified, and the number of elements present is
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6120 greater than that limit specified with :count. */
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6121 skipping = matching - counting;
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6122 }
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6123 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6124
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6125 GCPRO1 (result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6127 GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6128 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6129 if (EQ (tail, tailing))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6130 {
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6131 /* No need to do check_test, we're sure that this element matches
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6132 because its cons is what count_with_tail returned as the
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6133 tail. */
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6134 if (skipping ? encountered >= skipping : encountered < counting)
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6135 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6136 if (NILP (result))
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6137 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6138 result = Fcons (new_, XCDR (tail));
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6139 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6140 else
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6141 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6142 XSETCDR (result_tail, Fcons (new_, XCDR (tail)));
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6143 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6144 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6145 else
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6146 {
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6147 XSETCDR (result_tail, tail);
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6148 }
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6149
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6150 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6151 UNGCPRO;
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6152 return result;
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6153 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6154 else if (starting <= ii && ii < ending &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6155 (check_test (test, key, item, elt) == test_not_unboundp)
5852
e9bb3688e654 Fix some bugs in #'substitute, #'nsubstitute.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5772
diff changeset
6156 && (skipping ? encountered++ >= skipping
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6157 : encountered++ < counting))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6158 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6159 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6160 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6161 result = result_tail = Fcons (new_, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6162 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6163 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6164 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6165 XSETCDR (result_tail, Fcons (new_, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6166 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6167 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6168 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6169 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6170 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6171 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6172 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6173 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6174 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6175 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6176 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6177 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6178
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6179 if (ii == ending)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6180 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6181 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6182 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6183
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6184 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6185 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6186 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6187 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6188 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6189
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6190 if (ii < starting || (ii < ending && !NILP (end)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6191 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6192 check_sequence_range (args[0], start, end, Flength (args[0]));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6193 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6194
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6195 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6196 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6197
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6198 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6199 subst (Lisp_Object new_, Lisp_Object old, Lisp_Object tree, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6200 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6201 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6202 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6203 stack_overflow ("Stack overflow in subst", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6204 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6206 if (EQ (tree, old))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6207 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6208 return new_;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6209 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6210 else if (CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6211 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6212 Lisp_Object aa = subst (new_, old, XCAR (tree), depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6213 Lisp_Object dd = subst (new_, old, XCDR (tree), depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6214
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6215 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6216 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6217 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6218 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6219 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6220 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6221 return Fcons (aa, dd);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6222 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6223 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6224 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6225 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6226 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6227 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6228 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6229
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6230 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6231 sublis (Lisp_Object alist, Lisp_Object tree,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6232 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6233 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6234 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6235 Lisp_Object keyed = KEY (key, tree), aa, dd;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6236
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6237 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6238 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6239 stack_overflow ("Stack overflow in sublis", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6240 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6241
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6242 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6243 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6244 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6245 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6246 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6247 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6248 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6249 return XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6250 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6251 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6252 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6253 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6254
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6255 if (!CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6256 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6257 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6258 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6259
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6260 aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6261 depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6262 dd = sublis (alist, XCDR (tree), check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6263 depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6264
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6265 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6266 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6267 return tree;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6268 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6269
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6270 return Fcons (aa, dd);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6271 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6272
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6273 DEFUN ("sublis", Fsublis, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6274 Perform substitutions indicated by ALIST in TREE (non-destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6275 Return a copy of TREE with all matching elements replaced.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6276
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6277 Each dotted pair in ALIST describes a map from an old value (the car) to be
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6278 replaced by a new value (the cdr).
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6279
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6280 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6281
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6282 arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6283 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6284 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6285 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6286 Lisp_Object alist = args[0], tree = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6287 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6288 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6289
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6290 PARSE_KEYWORDS (Fsublis, nargs, args, 5, (test, if_, test_not, if_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6291 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6293 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6294 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6295 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6296 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6297
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6298 get_check_match_function (&test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6299 /* sublis() is going to apply the key, don't ask
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6300 for a match function that will do it for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6301 us. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6302 Qidentity, &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6303
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6304 if (CONSP (alist) && NILP (XCDR (alist)) && CONSP (XCAR (alist))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6305 && EQ (key, Qidentity) && 1 == test_not_unboundp
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6306 && (check_eq_nokey == check_test ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6307 (check_eql_nokey == check_test &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6308 !NON_FIXNUM_NUMBER_P (XCAR (XCAR (alist))))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6309 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6310 /* #'subst with #'eq is very cheap indeed; call it. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6311 return subst (XCDR (XCAR (alist)), XCAR (XCAR (alist)), tree, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6312 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6313
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6314 return sublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6315 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6316
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6317 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6318 nsublis (Lisp_Object alist, Lisp_Object tree,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6319 check_test_func_t check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6320 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6321 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6322 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6323 Lisp_Object tree_saved = tree, tortoise = tree, keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6324 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6325 int count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6327 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6328 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6329 stack_overflow ("Stack overflow in nsublis", tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6330 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6331
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6332 GCPRO2 (tree_saved, keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6333
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6334 while (CONSP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6335 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6336 Boolint replaced = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6337 keyed = KEY (key, XCAR (tree));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6338
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6339 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6340 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6341 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6342 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6343 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6344 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6345 CHECK_LISP_WRITEABLE (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6346 /* See comment in sublis() on using elt_cdr. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6347 XSETCAR (tree, XCDR (elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6348 replaced = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6349 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6350 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6351 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6352 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6353 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6354
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6355 if (!replaced)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6356 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6357 if (CONSP (XCAR (tree)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6358 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6359 nsublis (alist, XCAR (tree), check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6360 test, key, depth + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6361 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6363
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6364 keyed = KEY (key, XCDR (tree));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6365 replaced = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6366
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6367 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6368 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6369 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6370 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6371 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6372 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6373 CHECK_LISP_WRITEABLE (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6374 XSETCDR (tree, XCDR (elt));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6375 tree = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6376 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6377 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6378 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6379 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6380 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6382 if (!NILP (tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6383 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6384 tree = XCDR (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6385 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6386
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6387 if (++count > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6388 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6389 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6390 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6391 tortoise = XCDR (tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6394 if (EQ (tortoise, tree))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6395 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6396 signal_circular_list_error (tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6397 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6398 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6399 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6400
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6401 RETURN_UNGCPRO (tree_saved);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6402 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6403
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6404 DEFUN ("nsublis", Fnsublis, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6405 Perform substitutions indicated by ALIST in TREE (destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6406 Any matching element of TREE is changed via a call to `setcar'.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6407
5752
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6408 Each dotted pair in ALIST describes a map from an old value (the car) to be
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6409 replaced by a new value (the cdr).
70a3f4ff8da8 Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 5700
diff changeset
6410
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6411 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6412
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6413 arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6414 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6415 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6416 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6417 Lisp_Object alist = args[0], tree = args[1], tailed = Qnil, keyed = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6418 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6419 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6420 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6421
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6422 PARSE_KEYWORDS (Fnsublis, nargs, args, 5, (test, if_, test_not, if_not, key),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6423 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6424
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6425 if (NILP (key))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6426 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6427 key = Qidentity;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6428 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6429
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6430 get_check_match_function (&test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6431 /* nsublis() is going to apply the key, don't ask
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6432 for a match function that will do it for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6433 us. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6434 Qidentity, &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6435
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6436 GCPRO2 (tailed, keyed);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6437
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6438 keyed = KEY (key, tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6439
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6440 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6441 /* nsublis() won't attempt to replace a cons handed to it, do that
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6442 ourselves. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6443 GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6444 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6445 if (CONSP (elt) &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6446 check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6447 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6448 XUNGCPRO (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6449 return XCDR (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6450 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6451 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6452 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6453 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6454
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6455 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6456
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6457 return nsublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6458 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6459
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6460 DEFUN ("subst", Fsubst, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6461 Substitute NEW for OLD everywhere in TREE (non-destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6462
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6463 Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6464
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6465 See `member*' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6467 arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6468 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6469 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6470 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6471 Lisp_Object result, alist = noseeum_cons (noseeum_cons (args[1], args[0]),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6472 Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6473 args[1] = alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6474 result = Fsublis (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6475 free_cons (XCAR (alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6476 free_cons (alist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6477
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6478 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6479 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6480
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6481 DEFUN ("nsubst", Fnsubst, 3, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6482 Substitute NEW for OLD everywhere in TREE (destructively).
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6483
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6484 Any element of TREE which is `eql' to OLD is changed to NEW (via a call to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6485 `setcar').
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6486
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6487 See `member*' for the meaning of the keywords. The keyword
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6488 :descend-structures, not specified by Common Lisp, allows callers to specify
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6489 that non-cons objects (vectors and range tables, among others) should also
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6490 undergo substitution.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6491
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6492 arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT DESCEND-STRUCTURES)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6493 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6494 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6495 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6496 Lisp_Object new_ = args[0], old = args[1], tree = args[2], result, alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6497 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6498 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6499
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6500 PARSE_KEYWORDS (Fnsubst, nargs, args, 6, (test, if_, test_not, if_not, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6501 descend_structures), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6502 if (!NILP (descend_structures))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6503 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6504 check_test = get_check_test_function (old, &test, test_not, if_, if_not,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6505 key, &test_not_unboundp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6506
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6507 return nsubst_structures (new_, old, tree, check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6508 test, key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6509
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6510 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6511
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6512 alist = noseeum_cons (noseeum_cons (old, new_), Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6513 args[1] = alist;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6514 result = Fnsublis (nargs - 1, args + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6515 free_cons (XCAR (alist));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6516 free_cons (alist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6517
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6518 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6519 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6520
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6521 static Boolint
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6522 tree_equal (Lisp_Object tree1, Lisp_Object tree2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6523 check_test_func_t check_test, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6524 Lisp_Object test, Lisp_Object key, int depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6525 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6526 Lisp_Object tortoise1 = tree1, tortoise2 = tree2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6527 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6528 int count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6529 Boolint result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6530
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6531 if (depth + lisp_eval_depth > max_lisp_eval_depth)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6532 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6533 stack_overflow ("Stack overflow in tree-equal", tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6534 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6535
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6536 GCPRO2 (tree1, tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6537
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6538 while (CONSP (tree1) && CONSP (tree2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6539 && tree_equal (XCAR (tree1), XCAR (tree2), check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6540 test_not_unboundp, test, key, depth + 1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6541 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6542 tree1 = XCDR (tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6543 tree2 = XCDR (tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6544
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6545 if (++count > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6546 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6547 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6548 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6549 tortoise1 = XCDR (tortoise1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6550 tortoise2 = XCDR (tortoise2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6551 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6552
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6553 if (EQ (tortoise1, tree1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6554 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6555 signal_circular_list_error (tree1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6556 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6557
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6558 if (EQ (tortoise2, tree2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6559 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6560 signal_circular_list_error (tree2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6561 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6562 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6563 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6564
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6565 if (CONSP (tree1) || CONSP (tree2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6566 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6567 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6568 return 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6569 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6570
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6571 result = check_test (test, key, tree1, tree2) == test_not_unboundp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6572 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6573
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6574 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6575 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6576
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6577 DEFUN ("tree-equal", Ftree_equal, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6578 Return t if TREE1 and TREE2 have `eql' leaves.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6580 Atoms are compared by `eql', unless another test is specified using
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6581 :test; cons cells are compared recursively.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6582
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6583 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6584
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6585 arguments: (TREE1 TREE2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6586 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6587 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6588 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6589 Lisp_Object tree1 = args[0], tree2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6590 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6591 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6592
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6593 PARSE_KEYWORDS (Ftree_equal, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6594 (key = Qidentity));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6595
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6596 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6597 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6598
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6599 return tree_equal (tree1, tree2, check_test, test_not_unboundp, test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6600 0) ? Qt : Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6601 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6602
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6603 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6604 mismatch_from_end (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6605 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6606 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6607 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6608 Boolint UNUSED (return_sequence1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6609 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6610 Elemcount sequence1_len = XFIXNUM (Flength (sequence1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6611 Elemcount sequence2_len = XFIXNUM (Flength (sequence2)), ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6612 Elemcount starting1, ending1, starting2, ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6613 Lisp_Object *sequence1_storage = NULL, *sequence2_storage = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6614 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6615
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6616 check_sequence_range (sequence1, start1, end1, make_fixnum (sequence1_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6617 starting1 = XFIXNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6618 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6619 ending1 = min (ending1, sequence1_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6620
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6621 check_sequence_range (sequence2, start2, end2, make_fixnum (sequence2_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6622 starting2 = XFIXNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6623 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6624 ending2 = min (ending2, sequence2_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6625
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6626 if (LISTP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6627 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6628 Lisp_Object *saving;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6629 sequence1_storage = saving
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6630 = alloca_array (Lisp_Object, ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6631
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6632 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6633 EXTERNAL_LIST_LOOP_2 (elt, sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6634 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6635 if (starting1 <= ii && ii < ending1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6636 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6637 *saving++ = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6638 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6639 else if (ii == ending1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6640 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6641 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6642 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6643
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6644 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6645 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6646 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6647 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6648 else if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6649 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6650 const Ibyte *cursor = string_char_addr (sequence1, starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6651
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6652 STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence1_storage, ii,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6653 ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6654
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6655 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6656 else if (BIT_VECTORP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6657 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6658 Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6659 sequence1_storage = alloca_array (Lisp_Object, ending1 - starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6660 for (ii = starting1; ii < ending1; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6661 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6662 sequence1_storage[ii - starting1]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6663 = make_fixnum (bit_vector_bit (vv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6664 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6665 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6666 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6667 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6668 sequence1_storage = XVECTOR_DATA (sequence1) + starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6669 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6670
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6671 ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6672
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6673 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6674 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6675 Lisp_Object *saving;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6676 sequence2_storage = saving
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6677 = alloca_array (Lisp_Object, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6678
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6679 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6680 EXTERNAL_LIST_LOOP_2 (elt, sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6681 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6682 if (starting2 <= ii && ii < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6683 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6684 *saving++ = elt;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6685 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6686 else if (ii == ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6687 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6688 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6689 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6690
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6691 ++ii;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6692 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6693 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6694 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6695 else if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6696 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6697 const Ibyte *cursor = string_char_addr (sequence2, starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6698
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6699 STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence2_storage, ii,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6700 ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6701
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6703 else if (BIT_VECTORP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6704 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6705 Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6706 sequence2_storage = alloca_array (Lisp_Object, ending2 - starting2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6707 for (ii = starting2; ii < ending2; ++ii)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6708 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6709 sequence2_storage[ii - starting2]
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6710 = make_fixnum (bit_vector_bit (vv, ii));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6711 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6713 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6714 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6715 sequence2_storage = XVECTOR_DATA (sequence2) + starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6716 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6717
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6718 GCPRO2 (sequence1_storage[0], sequence2_storage[0]);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6719 gcpro1.nvars = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6720 gcpro2.nvars = ending2 - starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6721
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6722 while (ending1 > starting1 && ending2 > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6723 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6724 --ending1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6725 --ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6726
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6727 if (check_match (test, key, sequence1_storage[ending1 - starting1],
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6728 sequence2_storage[ending2 - starting2])
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6729 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6730 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6731 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6732 return make_integer (ending1 + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6733 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6734 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6735
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6736 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6737
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6738 if (ending1 > starting1 || ending2 > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6739 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6740 return make_integer (ending1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6741 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6742
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6743 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6744 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6745
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6746 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6747 mismatch_list_list (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6748 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6749 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6750 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6751 Boolint UNUSED (return_list_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6752 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6753 Lisp_Object sequence1_tortoise = sequence1, sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6754 Lisp_Object orig_sequence1 = sequence1, orig_sequence2 = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6755 Elemcount ending1 = MOST_POSITIVE_FIXNUM, ending2 = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6756 Elemcount starting1, starting2, counting, startcounting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6757 Elemcount shortest_len = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6758 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6759
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6760 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6761 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6762
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6763 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6764 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6765 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6766 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6767
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6768 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6769 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6770 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6771 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6772
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6773 if (!ZEROP (start1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6774 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6775 sequence1 = Fnthcdr (start1, sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6776
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6777 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6778 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6779 check_sequence_range (sequence1_tortoise, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6780 Flength (sequence1_tortoise));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6781 /* Give up early here. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6782 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6783 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6785 ending1 -= starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6786 starting1 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6787 sequence1_tortoise = sequence1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6788 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6789
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6790 if (!ZEROP (start2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6791 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6792 sequence2 = Fnthcdr (start2, sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6793
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6794 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6795 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6796 check_sequence_range (sequence2_tortoise, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6797 Flength (sequence2_tortoise));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6798 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6799 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6800
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6801 ending2 -= starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6802 starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6803 sequence2_tortoise = sequence2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6804 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6805
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6806 GCPRO4 (sequence1, sequence2, sequence1_tortoise, sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6807
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6808 counting = startcounting = min (ending1, ending2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6810 while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6811 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6812 if (check_match (test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6813 CONSP (sequence1) ? XCAR (sequence1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6814 : Fcar (sequence1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6815 CONSP (sequence2) ? XCAR (sequence2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6816 : Fcar (sequence2) ) != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6817 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6818 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6819 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6820 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6821
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6822 sequence1 = CONSP (sequence1) ? XCDR (sequence1) : Fcdr (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6823 sequence2 = CONSP (sequence2) ? XCDR (sequence2) : Fcdr (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6824
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6825 shortest_len++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6826
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6827 if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6828 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6829 if (counting & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6830 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6831 sequence1_tortoise = XCDR (sequence1_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6832 sequence2_tortoise = XCDR (sequence2_tortoise);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6833 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6834
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6835 if (EQ (sequence1, sequence1_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6836 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6837 signal_circular_list_error (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6838 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6839
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6840 if (EQ (sequence2, sequence2_tortoise))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6841 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6842 signal_circular_list_error (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6843 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6844 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6845 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6846
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6847 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6848
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6849 if (NILP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6850 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6851 Lisp_Object args[] = { start1, make_fixnum (shortest_len) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6852 check_sequence_range (orig_sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6853 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6854 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6855
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6856 if (NILP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6857 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6858 Lisp_Object args[] = { start2, make_fixnum (shortest_len) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6859 check_sequence_range (orig_sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6860 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6861 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6862
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6863 if ((!NILP (end1) && shortest_len != ending1 - starting1) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6864 (!NILP (end2) && shortest_len != ending2 - starting2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6865 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6866 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6867 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6868
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6869 if ((NILP (end1) && CONSP (sequence1)) || (NILP (end2) && CONSP (sequence2)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6870 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6871 return make_integer (XFIXNUM (start1) + shortest_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6872 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6873
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6874 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6875 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6876
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6877 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6878 mismatch_list_string (Lisp_Object list, Lisp_Object list_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6879 Lisp_Object list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6880 Lisp_Object string, Lisp_Object string_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6881 Lisp_Object string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6882 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6883 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6884 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6885 Boolint return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6886 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6887 Ibyte *string_data = XSTRING_DATA (string), *startp = string_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6888 Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6889 Elemcount char_count = 0, list_starting, list_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6890 Elemcount string_starting, string_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6891 Lisp_Object character, orig_list = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6892 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6893
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6894 list_ending = FIXNUMP (list_end) ? XFIXNUM (list_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6895 list_starting = FIXNUMP (list_start) ? XFIXNUM (list_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6896
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6897 string_ending = FIXNUMP (string_end) ? XFIXNUM (string_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6898 string_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6899 = FIXNUMP (string_start) ? XFIXNUM (string_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6900
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6901 while (char_count < string_starting && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6902 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6903 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6904 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6905 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6906 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6907
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6908 if (!ZEROP (list_start))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6909 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6910 list = Fnthcdr (list_start, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6911 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6912 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6913 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6914 Flength (orig_list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6915 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6916 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6917
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6918 list_ending -= list_starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6919 list_starting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6920 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6921
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6922 GCPRO1 (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6923
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6924 while (list_starting < list_ending && string_starting < string_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6925 && string_offset < string_len && !NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6926 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6927 character = make_char (itext_ichar (string_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6928
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6929 if (return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6930 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6931 if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6932 character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6933 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6934 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6935 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6936 return make_integer (XFIXNUM (list_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6937 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6938 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6939 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6941 if (check_match (test, key, character,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6942 CONSP (list) ? XCAR (list) : Fcar (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6943 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6944 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6945 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6946 return make_integer (char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6948 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6949
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6950 list = CONSP (list) ? XCDR (list) : Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6951
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6952 startp = XSTRING_DATA (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6953 string_data = startp + string_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6954 if (string_len != XSTRING_LENGTH (string)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6955 || !valid_ibyteptr_p (string_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6956 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6957 mapping_interaction_error (Qmismatch, string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6958 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6959
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6960 list_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6961 string_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6962 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6963 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6964 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6965 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6966
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6967 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6968
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6969 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6970 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6971 Lisp_Object args[] = { list_start, make_fixnum (char_count) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6972 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6973 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6974 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6975
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6976 if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6977 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6978 check_sequence_range (string, string_start, string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6979 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6980 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6981
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6982 if ((NILP (string_end) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6983 string_offset < string_len : string_starting < string_ending) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6984 (NILP (list_end) ? !NILP (list) : list_starting < list_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6985 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6986 return make_integer (return_list_index ? XFIXNUM (list_start) + char_count :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6987 char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6988 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6989
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6990 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6991 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6992
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6993 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6994 mismatch_list_array (Lisp_Object list, Lisp_Object list_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6995 Lisp_Object list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6996 Lisp_Object array, Lisp_Object array_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6997 Lisp_Object array_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6998 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
6999 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7000 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7001 Boolint return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7002 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7003 Elemcount ii = 0, list_starting, list_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7004 Elemcount array_starting, array_ending, array_len;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7005 Lisp_Object orig_list = list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7006 struct gcpro gcpro1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7007
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7008 list_ending = FIXNUMP (list_end) ? XFIXNUM (list_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7009 list_starting = FIXNUMP (list_start) ? XFIXNUM (list_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7010
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7011 array_ending = FIXNUMP (array_end) ? XFIXNUM (array_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7012 array_starting = FIXNUMP (array_start) ? XFIXNUM (array_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7013 array_len = XFIXNUM (Flength (array));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7014
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7015 array_ending = min (array_ending, array_len);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7016
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7017 check_sequence_range (array, array_start, array_end, make_fixnum (array_len));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7018
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7019 if (!ZEROP (list_start))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7020 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7021 list = Fnthcdr (list_start, list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7022 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7023 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7024 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7025 Flength (orig_list));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7026 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7027 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7028
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7029 list_ending -= list_starting;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7030 list_starting = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7031 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7032
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7033 GCPRO1 (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7034
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7035 while (list_starting < list_ending && array_starting < array_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7036 && !NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7037 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7038 if (return_list_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7039 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7040 if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7041 Faref (array, make_fixnum (array_starting)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7042 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7043 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7044 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7045 return make_integer (XFIXNUM (list_start) + ii);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7046 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7047 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7048 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7049 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7050 if (check_match (test, key, Faref (array, make_fixnum (array_starting)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7051 CONSP (list) ? XCAR (list) : Fcar (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7052 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7053 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7054 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7055 return make_integer (array_starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7056 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7057 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7058
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7059 list = CONSP (list) ? XCDR (list) : Fcdr (list);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7060 list_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7061 array_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7062 ii++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7063 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7064
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7065 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7066
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7067 if (NILP (list))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7068 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7069 Lisp_Object args[] = { list_start, make_fixnum (ii) };
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7070 check_sequence_range (orig_list, list_start, list_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7071 Fplus (countof (args), args));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7072 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7073
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7074 if (array_starting < array_ending ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7075 (NILP (list_end) ? !NILP (list) : list_starting < list_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7076 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7077 return make_integer (return_list_index ? XFIXNUM (list_start) + ii :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7078 array_starting);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7080
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7081 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7082 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7083
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7084 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7085 mismatch_string_array (Lisp_Object string, Lisp_Object string_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7086 Lisp_Object string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7087 Lisp_Object array, Lisp_Object array_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7088 Lisp_Object array_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7089 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7090 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7091 Boolint return_string_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7092 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7093 Ibyte *string_data = XSTRING_DATA (string), *startp = string_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7094 Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7095 Elemcount char_count = 0, array_starting, array_ending, array_length;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7096 Elemcount string_starting, string_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7097 Lisp_Object character;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7098
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7099 array_starting = FIXNUMP (array_start) ? XFIXNUM (array_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7100 array_ending = FIXNUMP (array_end) ? XFIXNUM (array_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7101 array_length = XFIXNUM (Flength (array));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7102 check_sequence_range (array, array_start, array_end, make_fixnum (array_length));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7103 array_ending = min (array_ending, array_length);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7104
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7105 string_ending = FIXNUMP (string_end) ? XFIXNUM (string_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7106 string_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7107 = FIXNUMP (string_start) ? XFIXNUM (string_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7108
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7109 while (char_count < string_starting && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7110 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7111 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7112 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7113 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7114 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7115
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7116 while (array_starting < array_ending && string_starting < string_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7117 && string_offset < string_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7118 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7119 character = make_char (itext_ichar (string_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7120
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7121 if (return_string_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7122 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7123 if (check_match (test, key, character,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7124 Faref (array, make_fixnum (array_starting)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7125 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7127 return make_integer (char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7128 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7129 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7130 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7131 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7132 if (check_match (test, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7133 Faref (array, make_fixnum (array_starting)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7134 character)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7135 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7136 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7137 return make_integer (XFIXNUM (array_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7138 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7139 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7140
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7141 startp = XSTRING_DATA (string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7142 string_data = startp + string_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7143 if (string_len != XSTRING_LENGTH (string)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7144 || !valid_ibyteptr_p (string_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7145 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7146 mapping_interaction_error (Qmismatch, string);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7147 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7148
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7149 array_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7150 string_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7151 char_count++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7152 INC_IBYTEPTR (string_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7153 string_offset = string_data - startp;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7154 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7155
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7156 if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7158 check_sequence_range (string, string_start, string_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7159 make_fixnum (char_count));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7160 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7161
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7162 if ((NILP (string_end) ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7163 string_offset < string_len : string_starting < string_ending) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7164 (NILP (array_end) ? !NILP (array) : array_starting < array_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7165 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7166 return make_integer (return_string_index ? char_count :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7167 XFIXNUM (array_start) + char_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7168 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7169
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7170 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7171 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7172
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7173 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7174 mismatch_string_string (Lisp_Object string1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7175 Lisp_Object string1_start, Lisp_Object string1_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7176 Lisp_Object string2, Lisp_Object string2_start,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7177 Lisp_Object string2_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7178 check_test_func_t check_match,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7179 Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7180 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7181 Boolint UNUSED (return_string1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7182 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7183 Ibyte *string1_data = XSTRING_DATA (string1), *startp1 = string1_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7184 Bytecount string1_offset = 0, string1_len = XSTRING_LENGTH (string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7185 Ibyte *string2_data = XSTRING_DATA (string2), *startp2 = string2_data;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7186 Bytecount string2_offset = 0, string2_len = XSTRING_LENGTH (string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7187 Elemcount char_count1 = 0, string1_starting, string1_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7188 Elemcount char_count2 = 0, string2_starting, string2_ending;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7189 Lisp_Object character1, character2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7190
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7191 string1_ending = FIXNUMP (string1_end) ? XFIXNUM (string1_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7192 string1_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7193 = FIXNUMP (string1_start) ? XFIXNUM (string1_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7194
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7195 string2_starting
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7196 = FIXNUMP (string2_start) ? XFIXNUM (string2_start) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7197 string2_ending = FIXNUMP (string2_end) ? XFIXNUM (string2_end) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7198
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7199 while (char_count1 < string1_starting && string1_offset < string1_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7200 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7201 INC_IBYTEPTR (string1_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7202 string1_offset = string1_data - startp1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7203 char_count1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7204 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7205
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7206 while (char_count2 < string2_starting && string2_offset < string2_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7207 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7208 INC_IBYTEPTR (string2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7209 string2_offset = string2_data - startp2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7210 char_count2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7211 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7212
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7213 while (string2_starting < string2_ending && string1_starting < string1_ending
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7214 && string1_offset < string1_len && string2_offset < string2_len)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7215 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7216 character1 = make_char (itext_ichar (string1_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7217 character2 = make_char (itext_ichar (string2_data));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7218
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7219 if (check_match (test, key, character1, character2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7220 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7221 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7222 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7223 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7224
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7225 startp1 = XSTRING_DATA (string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7226 string1_data = startp1 + string1_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7227 if (string1_len != XSTRING_LENGTH (string1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7228 || !valid_ibyteptr_p (string1_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7229 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7230 mapping_interaction_error (Qmismatch, string1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7231 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7232
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7233 startp2 = XSTRING_DATA (string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7234 string2_data = startp2 + string2_offset;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7235 if (string2_len != XSTRING_LENGTH (string2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7236 || !valid_ibyteptr_p (string2_data))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7237 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7238 mapping_interaction_error (Qmismatch, string2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7239 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7240
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7241 string2_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7242 string1_starting++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7243 char_count1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7244 char_count2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7245 INC_IBYTEPTR (string1_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7246 string1_offset = string1_data - startp1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7247 INC_IBYTEPTR (string2_data);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7248 string2_offset = string2_data - startp2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7249 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7250
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7251 if (string1_data == XSTRING_DATA (string1) + XSTRING_LENGTH (string1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7252 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7253 check_sequence_range (string1, string1_start, string1_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7254 make_fixnum (char_count1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7255 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7256
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7257 if (string2_data == XSTRING_DATA (string2) + XSTRING_LENGTH (string2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7258 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7259 check_sequence_range (string2, string2_start, string2_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7260 make_fixnum (char_count2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7261 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7262
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7263 if ((!NILP (string1_end) && string1_starting < string1_ending) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7264 (!NILP (string2_end) && string2_starting < string2_ending))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7265 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7266 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7267 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7268
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7269 if ((NILP (string1_end) && string1_data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7270 < (XSTRING_DATA (string1) + XSTRING_LENGTH (string1))) ||
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7271 (NILP (string2_end) && string2_data
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7272 < (XSTRING_DATA (string2) + XSTRING_LENGTH (string2))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7273 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7274 return make_integer (char_count1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7275 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7276
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7277 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7278 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7279
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7280 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7281 mismatch_array_array (Lisp_Object array1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7282 Lisp_Object array2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7283 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7284 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7285 Boolint UNUSED (return_array1_index))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7286 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7287 Elemcount len1 = XFIXNUM (Flength (array1)), len2 = XFIXNUM (Flength (array2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7288 Elemcount ending1 = MOST_POSITIVE_FIXNUM, ending2 = MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7289 Elemcount starting1, starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7290
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7291 check_sequence_range (array1, start1, end1, make_fixnum (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7292 check_sequence_range (array2, start2, end2, make_fixnum (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7293
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7294 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7295 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7296
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7297 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7298 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7299 ending1 = FIXNUMP (end1) ? XFIXNUM (end1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7300 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7301
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7302 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7303 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7304 ending2 = FIXNUMP (end2) ? XFIXNUM (end2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7305 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7306
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7307 ending1 = min (ending1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7308 ending2 = min (ending2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7309
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7310 while (starting1 < ending1 && starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7311 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7312 if (check_match (test, key, Faref (array1, make_fixnum (starting1)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7313 Faref (array2, make_fixnum (starting2)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7314 != test_not_unboundp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7315 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7316 return make_integer (starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7317 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7318 starting1++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7319 starting2++;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7320 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7321
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7322 if (starting1 < ending1 || starting2 < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7323 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7324 return make_integer (starting1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7325 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7326
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7327 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7328 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7329
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7330 typedef Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7331 (*mismatch_func_t) (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7332 Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7333 check_test_func_t check_match, Boolint test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7334 Lisp_Object test, Lisp_Object key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7335 Boolint return_list_index);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7336
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7337 static mismatch_func_t
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7338 get_mismatch_func (Lisp_Object sequence1, Lisp_Object sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7339 Lisp_Object from_end, Boolint *return_sequence1_index_out)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7340 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7341 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7342 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7343
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7344 if (!NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7345 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7346 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7347 return mismatch_from_end;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7348 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7349
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7350 if (LISTP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7351 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7352 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7353 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7354 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7355 return mismatch_list_list;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7356 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7357
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7358 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7359 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7360 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7361 return mismatch_list_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7362 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7363
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7364 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7365 return mismatch_list_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7366 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7367
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7368 if (STRINGP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7369 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7370 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7371 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7372 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7373 return mismatch_string_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7374 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7375
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7376 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7377 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7378 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7379 return mismatch_list_string;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7380 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7381
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7382 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7383 return mismatch_string_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7384 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7385
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7386 if (ARRAYP (sequence1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7387 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7388 if (STRINGP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7389 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7390 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7391 return mismatch_string_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7392 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7393
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7394 if (LISTP (sequence2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7395 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7396 *return_sequence1_index_out = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7397 return mismatch_list_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7398 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7399
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7400 *return_sequence1_index_out = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7401 return mismatch_array_array;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7402 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7403
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7404 RETURN_NOT_REACHED (NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7405 return NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7406 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7407
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7408 DEFUN ("mismatch", Fmismatch, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7409 Compare SEQUENCE1 with SEQUENCE2, return index of first mismatching element.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7410
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7411 Return nil if the sequences match. If one sequence is a prefix of the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7412 other, the return value indicates the end of the shorter sequence. A
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7413 non-nil return value always reflects an index into SEQUENCE1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7414
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7415 See `search' for the meaning of the keywords."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7416
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7417 arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7418 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7419 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7420 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7421 Lisp_Object sequence1 = args[0], sequence2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7422 Boolint test_not_unboundp = 1, return_first_index = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7423 check_test_func_t check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7424 mismatch_func_t mismatch = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7425
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7426 PARSE_KEYWORDS (Fmismatch, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7427 (test, key, from_end, start1, end1, start2, end2, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7428 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7429
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7430 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7431 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7432
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7433 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7434 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7435
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7436 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7437 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7438 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7439 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7440
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7441 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7442 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7443 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7444 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7445
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7446 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7447 &test_not_unboundp, NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7448 mismatch = get_mismatch_func (sequence1, sequence2, from_end,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7449 &return_first_index);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7450
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7451 if (return_first_index)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7452 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7453 return mismatch (sequence1, start1, end1, sequence2, start2, end2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7454 check_match, test_not_unboundp, test, key, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7455 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7456
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7457 return mismatch (sequence2, start2, end2, sequence1, start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7458 check_match, test_not_unboundp, test, key, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7459 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7460
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7461 DEFUN ("search", Fsearch, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7462 Search for SEQUENCE1 as a subsequence of SEQUENCE2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7463
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7464 Return the index of the leftmost element of the first match found; return
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7465 nil if there are no matches.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7466
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7467 In this function, :start1 and :end1 specify a subsequence of SEQUENCE1, and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7468 :start2 and :end2 specify a subsequence of SEQUENCE2. See `remove*' for
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7469 details of the other keywords.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7470
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7471 arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7472 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7473 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7474 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7475 Lisp_Object sequence1 = args[0], sequence2 = args[1], position0 = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7476 Boolint test_not_unboundp = 1, return_first = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7477 check_test_func_t check_test = NULL, check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7478 mismatch_func_t mismatch = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7479 Elemcount starting1 = 0, ending1 = 1 + MOST_POSITIVE_FIXNUM, starting2 = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7480 Elemcount ending2 = 1 + MOST_POSITIVE_FIXNUM, ii = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7481 Elemcount length1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7482 Lisp_Object object = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7483 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7484
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7485 PARSE_KEYWORDS (Fsearch, nargs, args, 8,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7486 (test, key, from_end, start1, end1, start2, end2, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7487 (start1 = start2 = Qzero));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7488
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7489 CHECK_SEQUENCE (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7490 CHECK_SEQUENCE (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7491 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7492
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7493 CHECK_NATNUM (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7494 starting1 = FIXNUMP (start1) ? XFIXNUM (start1) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7495 CHECK_NATNUM (start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7496 starting2 = FIXNUMP (start2) ? XFIXNUM (start2) : 1 + MOST_POSITIVE_FIXNUM;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7497
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7498 if (!NILP (end1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7499 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7500 Lisp_Object len1 = Flength (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7501
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7502 CHECK_NATNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7503 check_sequence_range (sequence1, start1, end1, len1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7504 ending1 = min (XFIXNUM (end1), XFIXNUM (len1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7505 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7506 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7507 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7508 end1 = Flength (sequence1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7509 check_sequence_range (sequence1, start1, end1, end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7510 ending1 = XFIXNUM (end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7511 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7512
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7513 length1 = ending1 - starting1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7514
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7515 if (!NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7516 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7517 Lisp_Object len2 = Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7518
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7519 CHECK_NATNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7520 check_sequence_range (sequence2, start2, end2, len2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7521 ending2 = min (XFIXNUM (end2), XFIXNUM (len2));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7522 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7523 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7524 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7525 end2 = Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7526 check_sequence_range (sequence2, start2, end2, end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7527 ending2 = XFIXNUM (end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7528 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7529
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7530 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7531 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7532 mismatch = get_mismatch_func (sequence1, sequence2, from_end, &return_first);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7533
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7534 if (bytecode_arithcompare (start1, make_integer (ending1)) >= 0)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7535 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7536 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7537 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7538 return start2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7539 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7540
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7541 if (NILP (end2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7542 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7543 return Flength (sequence2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7544 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7545
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7546 return end2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7547 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7548
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7549 if (NILP (from_end))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7550 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7551 Lisp_Object mismatch_start1 = Fadd1 (start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7552 Lisp_Object first = KEY (key, Felt (sequence1, start1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7553 GCPRO2 (first, mismatch_start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7554
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7555 ii = starting2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7556 while (ii < ending2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7557 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7558 position0 = position (&object, first, sequence2, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7559 test_not_unboundp, test, key, make_fixnum (ii),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7560 end2, Qnil, Qnil, Qsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7561 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7562 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7563 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7564 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7565 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7566
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7567 if (length1 + XFIXNUM (position0) <= ending2 &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7568 (return_first ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7569 NILP (mismatch (sequence1, mismatch_start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7570 sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7571 make_fixnum (1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7572 make_fixnum (length1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7573 check_match, test_not_unboundp, test, key, 1)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7574 NILP (mismatch (sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7575 make_fixnum (1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7576 make_fixnum (length1 + XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7577 sequence1, mismatch_start1, end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7578 check_match, test_not_unboundp, test, key, 0))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7579
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7580
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7581 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7582 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7583 return position0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7584 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7585
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7586 ii = XFIXNUM (position0) + 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7587 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7588
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7589 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7590 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7591 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7592 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7593 Lisp_Object mismatch_end1 = make_integer (ending1 - 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7594 Lisp_Object last = KEY (key, Felt (sequence1, mismatch_end1));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7595 GCPRO2 (last, mismatch_end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7596
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7597 ii = ending2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7598 while (ii > starting2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7599 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7600 position0 = position (&object, last, sequence2, check_test,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7601 test_not_unboundp, test, key, start2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7602 make_fixnum (ii), Qt, Qnil, Qsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7603
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7604 if (NILP (position0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7605 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7606 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7607 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7608 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7609
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7610 if (XFIXNUM (position0) - length1 + 1 >= starting2 &&
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7611 (return_first ?
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7612 NILP (mismatch (sequence1, start1, mismatch_end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7613 sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7614 make_fixnum (XFIXNUM (position0) - length1 + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7615 make_fixnum (XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7616 check_match, test_not_unboundp, test, key, 1)) :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7617 NILP (mismatch (sequence2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7618 make_fixnum (XFIXNUM (position0) - length1 + 1),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7619 make_fixnum (XFIXNUM (position0)),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7620 sequence1, start1, mismatch_end1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7621 check_match, test_not_unboundp, test, key, 0))))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7622 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7623 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7624 return make_fixnum (XFIXNUM (position0) - length1 + 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7625 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7626
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7627 ii = XFIXNUM (position0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7628 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7629
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7630 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7631 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7632
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7633 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7634 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7635
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7636 /* These two functions do set operations, those that can be visualised with
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7637 Venn diagrams. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7638 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7639 venn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7640 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7641 Lisp_Object liszt1 = args[0], liszt2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7642 Lisp_Object result = EQ (caller, Qsubsetp) ? Qt : Qnil, result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7643 Lisp_Object keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7644 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7645 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7646 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7647
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7648 PARSE_KEYWORDS_8 (caller, nargs, args, 4, (test, key, test_not, stable),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7649 NULL, 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7650
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7651 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7652 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7653
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7654 CHECK_KEY_ARGUMENT (key);
5700
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7655
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7656 /* #### Consider refactoring these tests into callers, and/or optimizing
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7657 tests. */
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7658 if (EQ (caller, Qsubsetp))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7659 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7660 if (NILP (liszt1))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7661 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7662 return Qt;
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7663 }
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7664 if (NILP (liszt2))
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7665 {
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7666 return Qnil;
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7667 }
37479d841681 Fix subsetp based on patch by Benson and Steven Mitchell.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5607
diff changeset
7668 }
5607
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7669
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7670 if (NILP (liszt1) && intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7671 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7672 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7673 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7674
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7675 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7676 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7677 return intersectionp ? Qnil : liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7678 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7679
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7680 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7681 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7682
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7683 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7684
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7685 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7686 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7687 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7688 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7689 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7690 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7691 test, key, 0, Qzero, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7692 != intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7693 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7694 if (EQ (Qsubsetp, caller))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7695 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7696 result = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7697 break;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7698 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7699 else if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7700 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7701 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7702 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7703 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7704 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7705 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7706 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7707 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7708 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7709 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7710 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7711 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7712 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7713 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7714 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7715 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7716
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7717 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7718
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7719 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7720 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7721
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7722 static Lisp_Object
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7723 nvenn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7724 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7725 Lisp_Object liszt1 = args[0], liszt2 = args[1], tortoise_elt, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7726 Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, prev_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7727 Elemcount count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7728 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7729 check_test_func_t check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7730 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7731
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7732 PARSE_KEYWORDS_8 (caller, nargs, args, 3, (test, key, test_not),
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7733 NULL, 2, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7734
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7735 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7736 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7737
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7738 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7739
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7740 if (NILP (liszt1) && intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7741 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7742 return Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7743 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7744
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7745 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7746 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7747 return intersectionp ? Qnil : liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7748 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7749
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7750 get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7751 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7752
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7753 tortoise_elt = tail = liszt1, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7754
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7755 GCPRO4 (tail, keyed, liszt1, tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7756
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7757 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7758 (signal_malformed_list_error (liszt1), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7759 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7760 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7761 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7762 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7763 test, key, 0, Qzero, Qnil))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7764 == intersectionp)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7765 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7766 if (NILP (prev_tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7767 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7768 liszt1 = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7769 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7770 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7771 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7772 XSETCDR (prev_tail, XCDR (tail));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7773 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7774
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7775 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7776 /* List is definitely not circular now! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7777 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7778 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7779 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7780 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7781 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7782 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7783 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7784
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7785 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7786
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7787 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7788 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7789 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7790 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7791
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7792 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7793 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7794 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7795 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7796 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7797
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7798 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7799
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7800 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7801 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7802
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7803 DEFUN ("intersection", Fintersection, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7804 Combine LIST1 and LIST2 using a set-intersection operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7805
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7806 The result list contains all items that appear in both LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7807 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7808 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7809
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7810 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7811 return the items in the order they appear in LIST1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7812
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7813 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7814
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7815 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7816 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7817 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7818 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7819 return venn (Qintersection, nargs, args, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7820 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7821
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7822 DEFUN ("nintersection", Fnintersection, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7823 Combine LIST1 and LIST2 using a set-intersection operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7824
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7825 The result list contains all items that appear in both LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7826 This is a destructive function; it reuses the storage of LIST1 whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7827 possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7828
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7829 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7830
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7831 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7832 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7833 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7834 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7835 return nvenn (Qnintersection, nargs, args, 1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7836 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7837
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7838 DEFUN ("subsetp", Fsubsetp, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7839 Return non-nil if every element of LIST1 also appears in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7840
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7841 See `union' for the meaning of the keyword arguments.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7842
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7843 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7844 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7845 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7846 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7847 return venn (Qsubsetp, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7848 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7849
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7850 DEFUN ("set-difference", Fset_difference, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7851 Combine LIST1 and LIST2 using a set-difference operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7852
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7853 The result list contains all items that appear in LIST1 but not LIST2. This
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7854 is a non-destructive function; it makes a copy of the data if necessary to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7855 avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7856
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7857 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7858
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7859 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7860 return the items in the order they appear in LIST1.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7861
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7862 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7863 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7864 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7865 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7866 return venn (Qset_difference, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7867 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7868
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7869 DEFUN ("nset-difference", Fnset_difference, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7870 Combine LIST1 and LIST2 using a set-difference operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7871
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7872 The result list contains all items that appear in LIST1 but not LIST2. This
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7873 is a destructive function; it reuses the storage of LIST1 whenever possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7874
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7875 See `union' for the meaning of :test, :test-not and :key."
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7876
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7877 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7878 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7879 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7880 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7881 return nvenn (Qnset_difference, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7882 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7883
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7884 DEFUN ("nunion", Fnunion, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7885 Combine LIST1 and LIST2 using a set-union operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7886 The result list contains all items that appear in either LIST1 or LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7887
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7888 This is a destructive function, it reuses the storage of LIST1 whenever
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7889 possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7890
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7891 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7892
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7893 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7894 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7895 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7896 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7897 args[0] = nvenn (Qnunion, nargs, args, 0);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7898 return bytecode_nconc2 (args);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7899 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7900
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7901 DEFUN ("union", Funion, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7902 Combine LIST1 and LIST2 using a set-union operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7903 The result list contains all items that appear in either LIST1 or LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7904 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7905 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7906
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7907 The keywords :test and :test-not specify two-argument test and negated-test
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7908 predicates, respectively; :test defaults to `eql'. See `member*' for more
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7909 information.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7910
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7911 :key specifies a one-argument function that transforms elements of LIST1
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7912 and LIST2 into \"comparison keys\" before the test predicate is applied.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7913 For example, if :key is #'car, then the car of elements from LIST1 is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7914 compared with the car of elements from LIST2. The :key function, however,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7915 does not affect the elements in the returned list, which are taken directly
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7916 from the elements in LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7917
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7918 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7919 return the items of LIST1 in order, followed by the remaining items of LIST2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7920 in the order they occur in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7921
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7922 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7923 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7924 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7925 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7926 Lisp_Object liszt1 = args[0], liszt2 = args[1], ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7927 Lisp_Object keyed = Qnil, result, result_tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7928 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7929 check_test_func_t check_test = NULL, check_match = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7930 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7931
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7932 PARSE_KEYWORDS (Funion, nargs, args, 4, (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7933
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7934 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7935 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7936
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7937 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7938
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7939 if (NILP (liszt1))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7940 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7941 return liszt2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7942 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7943
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7944 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7945 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7946 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7947 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7948
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7949 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7950 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7951
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7952 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7953
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7954 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7955 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7956 result = liszt2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7957 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7958 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7959 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7960 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7961 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7962 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7963 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7964 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7965 /* The Lisp version of #'union used to check which list was
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7966 longer, and use that as the tail of the constructed
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7967 list. That fails when the order of arguments to TEST is
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7968 specified, as is the case for these functions. We could
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7969 pass the reverse_check argument to
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7970 list_position_cons_before, but that means any key argument
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7971 is called an awful lot more, so it's a space win but not
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7972 a time win. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7973 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7974 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7975 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7976 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7977 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7978 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7979 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7980 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7981 result = result_tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7982
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7983 /* The standard `union' doesn't produce a "stable" union -- it
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7984 iterates over the second list instead of the first one, and returns
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7985 the values in backwards order. According to the CLTL2
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7986 documentation, `union' is not required to preserve the ordering of
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7987 elements in any fashion; providing the functionality for a stable
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7988 union is an XEmacs extension. */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7989 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7990 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7991 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7992 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7993 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7994 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7995 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7996 if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7997 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7998 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
7999 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8000 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8001 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8002 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8003 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8004 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8005 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8006 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8007 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8008 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8009
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8010 result = NILP (result) ? liszt1 : nconc2 (Fcopy_list (liszt1), result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8011 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8012
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8013 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8014
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8015 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8016 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8017
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8018 DEFUN ("set-exclusive-or", Fset_exclusive_or, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8019 Combine LIST1 and LIST2 using a set-exclusive-or operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8020
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8021 The result list contains all items that appear in exactly one of LIST1, LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8022 This is a non-destructive function; it makes a copy of the data if necessary
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8023 to avoid corrupting the original LIST1 and LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8024
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8025 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8026
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8027 A non-nil value for the :stable keyword, not specified by Common Lisp, means
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8028 return the items in the order they appear in LIST1, followed by the
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8029 remaining items in the order they appear in LIST2.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8030
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8031 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8032 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8033 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8034 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8035 Lisp_Object liszt1 = args[0], liszt2 = args[1];
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8036 Lisp_Object result = Qnil, result_tail = Qnil, keyed = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8037 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8038 check_test_func_t check_match = NULL, check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8039 struct gcpro gcpro1, gcpro2;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8040
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8041 PARSE_KEYWORDS (Fset_exclusive_or, nargs, args, 4,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8042 (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8043
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8044 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8045 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8046
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8047 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8048
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8049 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8050 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8051 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8052 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8053
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8054 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8055 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8056
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8057 GCPRO2 (keyed, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8058 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8059 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8060 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8061 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8062 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8063 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8064 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8065 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8066 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8067 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8068 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8069 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8070 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8071 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8072 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8073 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8074 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8075 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8076 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8077 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8078 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8079 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8080 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8081 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8082 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8083
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8084 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8085 GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8086 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8087 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8088 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8089 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8090 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8091 if (NILP (stable))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8092 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8093 result = Fcons (elt, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8094 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8095 else if (NILP (result))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8096 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8097 result = result_tail = Fcons (elt, Qnil);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8098 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8099 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8100 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8101 XSETCDR (result_tail, Fcons (elt, Qnil));
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8102 result_tail = XCDR (result_tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8103 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8104 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8105 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8106 END_GC_EXTERNAL_LIST_LOOP (elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8107 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8108
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8109 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8110
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8111 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8112 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8113
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8114 DEFUN ("nset-exclusive-or", Fnset_exclusive_or, 2, MANY, 0, /*
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8115 Combine LIST1 and LIST2 using a set-exclusive-or operation.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8116
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8117 The result list contains all items that appear in exactly one of LIST1 and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8118 LIST2. This is a destructive function; it reuses the storage of LIST1 and
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8119 LIST2 whenever possible.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8120
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8121 See `union' for the meaning of :test, :test-not and :key.
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8122
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8123 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8124 */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8125 (int nargs, Lisp_Object *args))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8126 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8127 Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8128 Lisp_Object result = Qnil, tortoise_elt = Qnil, keyed = Qnil, swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8129 Lisp_Object prev_tail = Qnil, ignore = Qnil;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8130 Elemcount count;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8131 Boolint test_not_unboundp = 1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8132 check_test_func_t check_match = NULL, check_test = NULL;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8133 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8134
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8135 PARSE_KEYWORDS (Fnset_exclusive_or, nargs, args, 4,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8136 (test, key, test_not, stable), NULL);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8137
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8138 CHECK_LIST (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8139 CHECK_LIST (liszt2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8140
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8141 CHECK_KEY_ARGUMENT (key);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8142
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8143 if (NILP (liszt2))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8144 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8145 return liszt1;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8146 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8147
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8148 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8149 &test_not_unboundp, &check_test);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8150
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8151 tortoise_elt = tail = liszt1, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8152
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8153 GCPRO4 (tail, keyed, result, tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8154
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8155 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8156 (signal_malformed_list_error (liszt1), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8157 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8158 keyed = KEY (key, elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8159 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8160 check_test, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8161 test, key, 0, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8162 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8163 swap = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8164
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8165 if (NILP (prev_tail))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8166 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8167 liszt1 = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8168 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8169 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8170 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8171 XSETCDR (prev_tail, swap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8172 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8173
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8174 XSETCDR (tail, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8175 result = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8176 tail = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8177
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8178 /* List is definitely not circular now! */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8179 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8180 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8181 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8182 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8183 prev_tail = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8184 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8185 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8186
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8187 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8188
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8189 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8190 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8191 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8192 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8193
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8194 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8195 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8196 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8197 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8198 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8199
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8200 tortoise_elt = tail = liszt2, count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8201
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8202 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8203 (signal_malformed_list_error (liszt2), 0))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8204 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8205 /* Need to leave the key calculation to list_position_cons_before(). */
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8206 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8207 check_match, test_not_unboundp,
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8208 test, key, 1, Qzero, Qnil)))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8209 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8210 swap = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8211 XSETCDR (tail, result);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8212 result = tail;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8213 tail = swap;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8214 count = 0;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8215 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8216 else
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8217 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8218 tail = XCDR (tail);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8219 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8220
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8221 if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8222
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8223 if (count & 1)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8224 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8225 tortoise_elt = XCDR (tortoise_elt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8226 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8227
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8228 if (EQ (elt, tortoise_elt))
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8229 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8230 signal_circular_list_error (liszt1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8231 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8232 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8233
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8234 UNGCPRO;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8235
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8236 return result;
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8237 }
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8238
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8239 void
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8240 syms_of_sequence (void)
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8241 {
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8242 DEFSYMBOL (Qstring_lessp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8243 DEFSYMBOL (Qmerge);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8244 DEFSYMBOL (Qfill);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8245 DEFSYMBOL (Qidentity);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8246 DEFSYMBOL (Qvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8247 DEFSYMBOL (Qarray);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8248 DEFSYMBOL (Qstring);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8249 DEFSYMBOL (Qlist);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8250 DEFSYMBOL (Qbit_vector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8251 defsymbol (&QsortX, "sort*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8252 DEFSYMBOL (Qreduce);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8253 DEFSYMBOL (Qreplace);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8254 DEFSYMBOL (Qposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8255 DEFSYMBOL (Qfind);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8256 defsymbol (&QdeleteX, "delete*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8257 defsymbol (&QremoveX, "remove*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8258
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8259 DEFSYMBOL (Qmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8260 defsymbol (&QmapcarX, "mapcar*");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8261 DEFSYMBOL (Qmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8262 DEFSYMBOL (Qmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8263 DEFSYMBOL (Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8264 DEFSYMBOL (Qmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8265 DEFSYMBOL (Qmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8266 DEFSYMBOL (Qsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8267 DEFSYMBOL (Qevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8268 DEFSYMBOL (Qnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8269 DEFSYMBOL (Qdelete_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8270 DEFSYMBOL (Qsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8271 DEFSYMBOL (Qmismatch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8272 DEFSYMBOL (Qintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8273 DEFSYMBOL (Qnintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8274 DEFSYMBOL (Qsubsetp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8275 DEFSYMBOL (Qcar_less_than_car);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8276 DEFSYMBOL (Qset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8277 DEFSYMBOL (Qnset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8278 DEFSYMBOL (Qnunion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8279
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8280 DEFKEYWORD (Q_from_end);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8281 DEFKEYWORD (Q_initial_value);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8282 DEFKEYWORD (Q_start1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8283 DEFKEYWORD (Q_start2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8284 DEFKEYWORD (Q_end1);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8285 DEFKEYWORD (Q_end2);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8286 defkeyword (&Q_if_, ":if");
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8287 DEFKEYWORD (Q_if_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8288 DEFKEYWORD (Q_test_not);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8289 DEFKEYWORD (Q_count);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8290 DEFKEYWORD (Q_stable);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8291 DEFKEYWORD (Q_descend_structures);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8292
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8293 DEFSUBR (Flength);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8294 DEFSUBR (Fcount);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8295 DEFSUBR (Fsubseq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8296 DEFSUBR (Felt);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8297 DEFSUBR (Fcopy_tree);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8298 DEFSUBR (Fmember);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8299 DEFSUBR (Fmemq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8300 DEFSUBR (FmemberX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8301 DEFSUBR (Fadjoin);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8302 DEFSUBR (Fassoc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8303 DEFSUBR (Fassq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8304 DEFSUBR (FassocX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8305 DEFSUBR (Frassoc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8306 DEFSUBR (Frassq);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8307 DEFSUBR (FrassocX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8308 DEFSUBR (Fposition);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8309 DEFSUBR (Ffind);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8310 DEFSUBR (FdeleteX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8311 DEFSUBR (FremoveX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8312 DEFSUBR (Fdelete_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8313 DEFSUBR (Fremove_duplicates);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8314 DEFSUBR (Fnreverse);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8315 DEFSUBR (Freverse);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8316 DEFSUBR (Fmerge);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8317 DEFSUBR (FsortX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8318 DEFSUBR (Ffill);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8319 DEFSUBR (Fmapconcat);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8320 DEFSUBR (FmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8321 DEFSUBR (Fmapvector);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8322 DEFSUBR (Fmapcan);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8323 DEFSUBR (Fmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8324 Ffset (intern ("mapc-internal"), Qmapc);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8325 Ffset (intern ("mapcar"), QmapcarX);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8326 DEFSUBR (Fmap);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8327 DEFSUBR (Fmap_into);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8328 DEFSUBR (Fsome);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8329 DEFSUBR (Fevery);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8330 DEFSUBR (Freduce);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8331 DEFSUBR (Freplace);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8332 DEFSUBR (Fnsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8333 DEFSUBR (Fsubstitute);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8334 DEFSUBR (Fsublis);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8335 DEFSUBR (Fnsublis);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8336 DEFSUBR (Fsubst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8337 DEFSUBR (Fnsubst);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8338 DEFSUBR (Ftree_equal);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8339 DEFSUBR (Fmismatch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8340 DEFSUBR (Fsearch);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8341 DEFSUBR (Fintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8342 DEFSUBR (Fnintersection);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8343 DEFSUBR (Fsubsetp);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8344 DEFSUBR (Fset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8345 DEFSUBR (Fnset_difference);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8346 DEFSUBR (Fnunion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8347 DEFSUBR (Funion);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8348 DEFSUBR (Fset_exclusive_or);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8349 DEFSUBR (Fnset_exclusive_or);
1a507c4c6c42 Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
diff changeset
8350 }